diff --git a/src/Text/Pandoc/Arbitrary.hs b/src/Text/Pandoc/Arbitrary.hs index 0114875..8a743a3 100644 --- a/src/Text/Pandoc/Arbitrary.hs +++ b/src/Text/Pandoc/Arbitrary.hs @@ -86,6 +86,7 @@ instance Arbitrary Blocks where flattenTableHead hd <> concatMap flattenTableBody bd <> flattenTableFoot ft + flattenBlock (Figure _ capt blks) = flattenCaption capt <> blks flattenBlock (Div _ blks) = blks flattenBlock Null = [] @@ -204,6 +205,10 @@ instance Arbitrary Block where [Table attr capt specs thead tbody' tfoot | tbody' <- shrink tbody] ++ [Table attr capt specs thead tbody tfoot' | tfoot' <- shrink tfoot] ++ [Table attr capt' specs thead tbody tfoot | capt' <- shrink capt] + shrink (Figure attr capt blks) = + [Figure attr capt blks' | blks' <- shrinkBlockList blks] ++ + [Figure attr capt' blks | capt' <- shrink capt] ++ + [Figure attr' capt blks | attr' <- shrinkAttr attr] shrink (Div attr blks) = (Div attr <$> shrinkBlockList blks) ++ (flip Div blks <$> shrinkAttr attr) shrink Null = [] @@ -246,6 +251,9 @@ arbBlock n = frequency $ [ (10, Plain <$> arbInlines (n-1)) <*> arbTableHead (n-1) <*> vectorOf bs (arbTableBody (n-1)) <*> arbTableFoot (n-1)) + , (2, Figure <$> arbAttr + <*> arbitrary + <*> listOf1 (arbBlock (n-1))) ] arbRow :: Int -> Gen Row diff --git a/src/Text/Pandoc/Builder.hs b/src/Text/Pandoc/Builder.hs index ce61ef8..1bf6a1a 100644 --- a/src/Text/Pandoc/Builder.hs +++ b/src/Text/Pandoc/Builder.hs @@ -168,6 +168,8 @@ module Text.Pandoc.Builder ( module Text.Pandoc.Definition , table , simpleTable , tableWith + , figure + , figureWith , caption , simpleCaption , emptyCaption @@ -560,6 +562,12 @@ simpleTable headers rows = tb = TableBody nullAttr 0 [] $ map toRow rows tf = TableFoot nullAttr [] +figure :: Caption -> Blocks -> Blocks +figure = figureWith nullAttr + +figureWith :: Attr -> Caption -> Blocks -> Blocks +figureWith attr capt = singleton . Figure attr capt . toList + caption :: Maybe ShortCaption -> Blocks -> Caption caption x = Caption x . toList @@ -569,9 +577,13 @@ simpleCaption = caption Nothing emptyCaption :: Caption emptyCaption = simpleCaption mempty +-- | Creates a simple figure from attributes, a figure caption, an image +-- path and image title. The attributes are used as the image +-- attributes. simpleFigureWith :: Attr -> Inlines -> Text -> Text -> Blocks simpleFigureWith attr figureCaption url title = - para $ imageWith attr url ("fig:" <> title) figureCaption + figure (simpleCaption (plain figureCaption)) . plain $ + imageWith attr url title mempty simpleFigure :: Inlines -> Text -> Text -> Blocks simpleFigure = simpleFigureWith nullAttr diff --git a/src/Text/Pandoc/Definition.hs b/src/Text/Pandoc/Definition.hs index 1ca1ce1..ce55bb4 100644 --- a/src/Text/Pandoc/Definition.hs +++ b/src/Text/Pandoc/Definition.hs @@ -254,7 +254,7 @@ data TableFoot = TableFoot Attr [Row] -- | A short caption, for use in, for instance, lists of figures. type ShortCaption = [Inline] --- | The caption of a table, with an optional short caption. +-- | The caption of a table or figure, with optional short caption. data Caption = Caption (Maybe ShortCaption) [Block] deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) @@ -301,6 +301,8 @@ data Block -- column alignments and widths (required), table head, table -- bodies, and table foot | Table Attr Caption [ColSpec] TableHead [TableBody] TableFoot + -- | Figure, with attributes, caption, and content (list of blocks) + | Figure Attr Caption [Block] -- | Generic block container with attributes | Div Attr [Block] -- | Nothing diff --git a/src/Text/Pandoc/Walk.hs b/src/Text/Pandoc/Walk.hs index 3dba0dd..a6333fe 100644 --- a/src/Text/Pandoc/Walk.hs +++ b/src/Text/Pandoc/Walk.hs @@ -492,6 +492,10 @@ walkBlockM f (Table attr capt as hs bs fs) bs' <- walkM f bs fs' <- walkM f fs return $ Table attr capt' as hs' bs' fs' +walkBlockM f (Figure attr capt blks) + = do capt' <- walkM f capt + blks' <- walkM f blks + return $ Figure attr capt' blks' -- | Perform a query on elements nested below a @'Block'@ element by -- querying all directly nested lists of @Inline@s or @Block@s. @@ -515,6 +519,9 @@ queryBlock f (Table _ capt _ hs bs fs) query f hs <> query f bs <> query f fs +queryBlock f (Figure _ capt blks) + = query f capt <> + query f blks queryBlock f (Div _ bs) = query f bs queryBlock _ Null = mempty diff --git a/test/test-pandoc-types.hs b/test/test-pandoc-types.hs index ff8875d..a1d79a0 100644 --- a/test/test-pandoc-types.hs +++ b/test/test-pandoc-types.hs @@ -451,6 +451,14 @@ t_table = ( Table tCell' i = Cell ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) AlignDefault 1 1 [Plain i] tRow = Row ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) +t_figure :: (Block, ByteString) +t_figure = (Figure + ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) + (Caption (Just [Str "hello"]) [Para [Str "cap content"]]) + [Para [Str "fig content"]] + ,[s|{"t":"Figure","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[{"t":"Str","c":"hello"}],[{"t":"Para","c":[{"t":"Str","c":"cap content"}]}]],[{"t":"Para","c":[{"t":"Str","c":"fig content"}]}]]}|] + ) + t_div :: (Block, ByteString) t_div = ( Div ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) [Para [Str "Hello"]] , [s|{"t":"Div","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],[{"t":"Para","c":[{"t":"Str","c":"Hello"}]}]]}|] @@ -658,15 +666,17 @@ t_tableNormExample = testCase "table normalization example" assertion generated = table emptyCaption spec (th initialHeads) [initialTB] (tf initialHeads) p_figureRepresentation :: Property -p_figureRepresentation = forAll (arbitrary :: Gen [Inline]) (\figureCaption -> +p_figureRepresentation = forAll (arbitrary :: Gen [Inline]) $ \figureCaption -> simpleFigureWith - ("", [], []) + ("test", [], []) (Builder.fromList figureCaption) "url" "title" == Builder.fromList - [Para [Image ("", [], []) figureCaption ("url", "fig:title") ]] - ) + [Figure + nullAttr + (Caption Nothing [Plain figureCaption | not (null figureCaption)]) + [Plain [Image ("test", [], []) mempty ("url", "title") ]]] tests :: [Test] tests = @@ -745,6 +755,7 @@ tests = , testEncodeDecode "DefinitionList" t_definitionlist , testEncodeDecode "Header" t_header , testEncodeDecode "Table" t_table + , testEncodeDecode "Figure" t_figure , testEncodeDecode "Div" t_div , testEncodeDecode "Null" t_null ]