diff --git a/src/Text/Pandoc/Arbitrary.hs b/src/Text/Pandoc/Arbitrary.hs index 10172fb..00c78e6 100644 --- a/src/Text/Pandoc/Arbitrary.hs +++ b/src/Text/Pandoc/Arbitrary.hs @@ -82,15 +82,15 @@ instance Arbitrary Blocks where flattenBlock (DefinitionList defs) = concat [Para ils:concat blks | (ils, blks) <- defs] flattenBlock (Header _ _ ils) = [Para ils] flattenBlock HorizontalRule = [] - flattenBlock (Table _ capt _ hd bd ft) = flattenCaption capt <> - flattenTableHead hd <> - concatMap flattenTableBody bd <> - flattenTableFoot ft + flattenBlock (Table _ _ hd bd ft) = flattenTableHead hd <> + concatMap flattenTableBody bd <> + flattenTableFoot ft + flattenBlock (Figure _ _ capt blks) = flattenCaption capt <> blks flattenBlock (Div _ blks) = blks flattenBlock Null = [] - flattenCaption (Caption Nothing body) = body - flattenCaption (Caption (Just ils) body) = Para ils : body + flattenCaption (Caption _ Nothing body) = body + flattenCaption (Caption _ (Just ils) body) = Para ils : body flattenTableHead (TableHead _ body) = flattenRows body flattenTableBody (TableBody _ _ hd bd) = flattenRows hd <> flattenRows bd @@ -197,13 +197,16 @@ instance Arbitrary Block where shrink (Header n attr ils) = (Header n attr <$> shrinkInlineList ils) ++ (flip (Header n) ils <$> shrinkAttr attr) shrink HorizontalRule = [] - shrink (Table attr capt specs thead tbody tfoot) = + shrink (Table attr specs thead tbody tfoot) = -- TODO: shrink number of columns - [Table attr' capt specs thead tbody tfoot | attr' <- shrinkAttr attr] ++ - [Table attr capt specs thead' tbody tfoot | thead' <- shrink thead] ++ - [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] + [Table attr' specs thead tbody tfoot | attr' <- shrinkAttr attr] ++ + [Table attr specs thead' tbody tfoot | thead' <- shrink thead] ++ + [Table attr specs thead tbody' tfoot | tbody' <- shrink tbody] ++ + [Table attr specs thead tbody tfoot' | tfoot' <- shrink tfoot] + shrink (Figure attr cp capt blks) = + [Figure attr cp capt blks' | blks' <- shrinkBlockList blks] ++ + [Figure attr cp capt' blks | capt' <- shrink capt] ++ + [Figure attr' cp capt blks | attr' <- shrinkAttr attr] shrink (Div attr blks) = (Div attr <$> shrinkBlockList blks) ++ (flip Div blks <$> shrinkAttr attr) shrink Null = [] @@ -238,7 +241,6 @@ arbBlock n = frequency $ [ (10, Plain <$> arbInlines (n-1)) , (2, do cs <- choose (1 :: Int, 6) bs <- choose (0 :: Int, 2) Table <$> arbAttr - <*> arbitrary <*> vectorOf cs ((,) <$> arbitrary <*> elements [ ColWidthDefault , ColWidth (1/3) @@ -246,6 +248,10 @@ arbBlock n = frequency $ [ (10, Plain <$> arbInlines (n-1)) <*> arbTableHead (n-1) <*> vectorOf bs (arbTableBody (n-1)) <*> arbTableFoot (n-1)) + , (2, Figure <$> arbAttr + <*> arbitrary + <*> arbitrary + <*> listOf1 (arbBlock (n-1))) ] arbRow :: Int -> Gen Row @@ -335,10 +341,15 @@ instance Arbitrary Cell where [Cell attr malign' h w body | malign' <- shrink malign] instance Arbitrary Caption where - arbitrary = Caption <$> arbitrary <*> arbitrary - shrink (Caption mshort body) - = [Caption mshort' body | mshort' <- shrink mshort] ++ - [Caption mshort body' | body' <- shrinkBlockList body] + arbitrary = Caption <$> arbAttr <*> arbitrary <*> arbitrary + shrink (Caption attr mshort body) + = [Caption attr mshort' body | mshort' <- shrink mshort] ++ + [Caption attr mshort body' | body' <- shrinkBlockList body] ++ + [Caption attr' mshort body | attr' <- shrinkAttr attr] + +instance Arbitrary CaptionPos where + arbitrary + = arbitraryBoundedEnum instance Arbitrary MathType where arbitrary diff --git a/src/Text/Pandoc/Builder.hs b/src/Text/Pandoc/Builder.hs index 77af1f3..4397bd7 100644 --- a/src/Text/Pandoc/Builder.hs +++ b/src/Text/Pandoc/Builder.hs @@ -167,6 +167,8 @@ module Text.Pandoc.Builder ( module Text.Pandoc.Definition , table , simpleTable , tableWith + , figure + , figureWith , caption , simpleCaption , emptyCaption @@ -518,8 +520,7 @@ emptyCell = simpleCell mempty -- | Table builder. Performs normalization with 'normalizeTableHead', -- 'normalizeTableBody', and 'normalizeTableFoot'. The number of table -- columns is given by the length of @['ColSpec']@. -table :: Caption - -> [ColSpec] +table :: [ColSpec] -> TableHead -> [TableBody] -> TableFoot @@ -527,14 +528,13 @@ table :: Caption table = tableWith nullAttr tableWith :: Attr - -> Caption -> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks -tableWith attr capt specs th tbs tf - = singleton $ Table attr capt specs th' tbs' tf' +tableWith attr specs th tbs tf + = singleton $ Table attr specs th' tbs' tf' where twidth = length specs th' = normalizeTableHead twidth th @@ -546,7 +546,7 @@ simpleTable :: [Blocks] -- ^ Headers -> [[Blocks]] -- ^ Rows -> Blocks simpleTable headers rows = - table emptyCaption (replicate numcols defaults) th [tb] tf + table (replicate numcols defaults) th [tb] tf where defaults = (AlignDefault, ColWidthDefault) numcols = maximum (map length (headers:rows)) toRow = Row nullAttr . map simpleCell @@ -557,8 +557,17 @@ simpleTable headers rows = tb = TableBody nullAttr 0 [] $ map toRow rows tf = TableFoot nullAttr [] +figure :: CaptionPos -> Caption -> Blocks -> Blocks +figure = figureWith nullAttr + +figureWith :: Attr -> CaptionPos -> Caption -> Blocks -> Blocks +figureWith attr capt cp = singleton . Figure attr capt cp . toList + caption :: Maybe ShortCaption -> Blocks -> Caption -caption x = Caption x . toList +caption = captionWith nullAttr + +captionWith :: Attr -> Maybe ShortCaption -> Blocks -> Caption +captionWith x y = Caption x y . toList simpleCaption :: Blocks -> Caption simpleCaption = caption Nothing diff --git a/src/Text/Pandoc/Definition.hs b/src/Text/Pandoc/Definition.hs index 5a0fed2..717ad92 100644 --- a/src/Text/Pandoc/Definition.hs +++ b/src/Text/Pandoc/Definition.hs @@ -66,6 +66,7 @@ module Text.Pandoc.Definition ( Pandoc(..) , nullAttr , Caption(..) , ShortCaption + , CaptionPos(..) , RowHeadColumns(..) , Alignment(..) , ColWidth(..) @@ -253,8 +254,8 @@ 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. -data Caption = Caption (Maybe ShortCaption) [Block] +-- | The caption of a figure, with optional short caption. +data Caption = Caption Attr (Maybe ShortCaption) [Block] deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) -- | A table cell. @@ -269,6 +270,10 @@ newtype RowSpan = RowSpan Int newtype ColSpan = ColSpan Int deriving (Eq, Ord, Show, Read, Typeable, Data, Generic, Num, Enum, ToJSON, FromJSON) +-- | The position of a caption relative to the content of a figure. +data CaptionPos = CaptionBefore | CaptionAfter + deriving (Eq, Ord, Show, Read, Typeable, Data, Generic, Enum, Bounded) + -- | Block element. data Block -- | Plain text, not a paragraph @@ -296,10 +301,12 @@ data Block | Header Int Attr [Inline] -- | Horizontal rule | HorizontalRule - -- | Table, with attributes, caption, optional short caption, - -- column alignments and widths (required), table head, table - -- bodies, and table foot - | Table Attr Caption [ColSpec] TableHead [TableBody] TableFoot + -- | Table, with attributes, column alignments and widths + -- (required), table head, table bodies, and table foot + | Table Attr [ColSpec] TableHead [TableBody] TableFoot + -- | Figure, with attributes, caption and caption position, width + -- (optional), and content (list of blocks) + | Figure Attr CaptionPos Caption [Block] -- | Generic block container with attributes | Div Attr [Block] -- | Nothing @@ -374,6 +381,7 @@ $(let jsonOpts = defaultOptions , ''ColWidth , ''Row , ''Caption + , ''CaptionPos , ''TableHead , ''TableBody , ''TableFoot @@ -440,6 +448,7 @@ instance NFData ListNumberDelim instance NFData ListNumberStyle instance NFData ColWidth instance NFData RowHeadColumns +instance NFData CaptionPos instance NFData Block instance NFData Pandoc diff --git a/src/Text/Pandoc/Walk.hs b/src/Text/Pandoc/Walk.hs index a71d848..e8df5e8 100644 --- a/src/Text/Pandoc/Walk.hs +++ b/src/Text/Pandoc/Walk.hs @@ -466,12 +466,15 @@ walkBlockM _ x@CodeBlock {} = return x walkBlockM _ x@RawBlock {} = return x walkBlockM _ HorizontalRule = return HorizontalRule walkBlockM _ Null = return Null -walkBlockM f (Table attr capt as hs bs fs) - = do capt' <- walkM f capt - hs' <- walkM f hs +walkBlockM f (Table attr as hs bs fs) + = do hs' <- walkM f hs bs' <- walkM f bs fs' <- walkM f fs - return $ Table attr capt' as hs' bs' fs' + return $ Table attr as hs' bs' fs' +walkBlockM f (Figure attr cp capt blks) + = do capt' <- walkM f capt + blks' <- walkM f blks + return $ Figure attr cp capt' blks' -- | Perform a query on elements nested below a @'Block'@ element by -- querying all directly nested lists of @Inline@s or @Block@s. @@ -490,11 +493,13 @@ queryBlock f (BulletList cs) = query f cs queryBlock f (DefinitionList xs) = query f xs queryBlock f (Header _ _ xs) = query f xs queryBlock _ HorizontalRule = mempty -queryBlock f (Table _ capt _ hs bs fs) - = query f capt <> - query f hs <> +queryBlock f (Table _ _ 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 @@ -605,12 +610,12 @@ queryCell f (Cell _ _ _ _ content) = query f content -- nodes. walkCaptionM :: (Walkable a [Block], Walkable a [Inline], Monad m, Walkable a ShortCaption) => (a -> m a) -> Caption -> m Caption -walkCaptionM f (Caption mshort body) = Caption <$> walkM f mshort <*> walkM f body +walkCaptionM f (Caption attr mshort body) = Caption attr <$> walkM f mshort <*> walkM f body -- | Query the elements below a 'Cell' element. queryCaption :: (Walkable a [Block], Walkable a [Inline], Walkable a ShortCaption, Monoid c) => (a -> c) -> Caption -> c -queryCaption f (Caption mshort body) = query f mshort <> query f body +queryCaption f (Caption _ mshort body) = query f mshort <> query f body -- | Helper method to walk the components of a Pandoc element. walkPandocM :: (Walkable a Meta, Walkable a [Block], Monad m, diff --git a/test/test-pandoc-types.hs b/test/test-pandoc-types.hs index f450d19..a36f21d 100644 --- a/test/test-pandoc-types.hs +++ b/test/test-pandoc-types.hs @@ -4,8 +4,7 @@ import Text.Pandoc.Arbitrary () import Text.Pandoc.Definition import Text.Pandoc.Walk import Text.Pandoc.Builder (singleton, plain, text, simpleTable, table, emptyCell, - normalizeTableHead, normalizeTableBody, normalizeTableFoot, - emptyCaption) + normalizeTableHead, normalizeTableBody, normalizeTableFoot) import Data.Generics import Data.List (tails) import Test.HUnit (Assertion, assertEqual, assertFailure) @@ -335,8 +334,9 @@ t_row = (Row ("id",["kls"],[("k1", "v1"), ("k2", "v2")]) ,[s|[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["",[],[]],{"t":"AlignRight"},2,3,[{"t":"Para","c":[{"t":"Str","c":"bar"}]}]]]]|]) t_caption :: (Caption, ByteString) -t_caption = (Caption (Just [Str "foo"]) [Para [Str "bar"]] - ,[s|[[{"t":"Str","c":"foo"}],[{"t":"Para","c":[{"t":"Str","c":"bar"}]}]]|]) +t_caption = (Caption ("id",["kls"],[("k1", "v1"), ("k2", "v2")]) + (Just [Str "foo"]) [Para [Str "bar"]] + ,[s|[["id",["kls"],[["k1","v1"],["k2","v2"]]],[{"t":"Str","c":"foo"}],[{"t":"Para","c":[{"t":"Str","c":"bar"}]}]]|]) t_tablehead :: (TableHead, ByteString) t_tablehead = (TableHead ("id",["kls"],[("k1", "v1"), ("k2", "v2")]) @@ -374,17 +374,6 @@ t_colspan = (1 t_table :: (Block, ByteString) t_table = ( Table ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) - (Caption - (Just [Str "short"]) - [Para [Str "Demonstration" - ,Space - ,Str "of" - ,Space - ,Str "simple" - ,Space - ,Str "table" - ,Space - ,Str "syntax."]]) [(AlignDefault,ColWidthDefault) ,(AlignRight,ColWidthDefault) ,(AlignLeft,ColWidthDefault) @@ -429,13 +418,22 @@ t_table = ( Table ,tCell [Str "footleft"] ,tCell [Str "footcenter"] ,tCell [Str "footdefault"]]]) - ,[s|{"t":"Table","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[{"t":"Str","c":"short"}],[{"t":"Para","c":[{"t":"Str","c":"Demonstration"},{"t":"Space"},{"t":"Str","c":"of"},{"t":"Space"},{"t":"Str","c":"simple"},{"t":"Space"},{"t":"Str","c":"table"},{"t":"Space"},{"t":"Str","c":"syntax."}]}]],[[{"t":"AlignDefault"},{"t":"ColWidthDefault"}],[{"t":"AlignRight"},{"t":"ColWidthDefault"}],[{"t":"AlignLeft"},{"t":"ColWidthDefault"}],[{"t":"AlignCenter"},{"t":"ColWidthDefault"}],[{"t":"AlignDefault"},{"t":"ColWidthDefault"}]],[["idh",["klsh"],[["k1h","v1h"],["k2h","v2h"]]],[[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"Head"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"Right"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"Left"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"Center"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"Default"}]}]]]]]],[[["idb",["klsb"],[["k1b","v1b"],["k2b","v2b"]]],1,[[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"ihead12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"i12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"i12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"i12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"i12"}]}]]]]],[[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"head12"}]}]],[["id",["kls"],[["k1","v1"],["k2","v2"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"12"}]}]],[["id",["kls"],[["k1","v1"],["k2","v2"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"12"}]}]]]],[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"head123"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"123"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"123"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"123"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"123"}]}]]]],[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"head1"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"1"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"1"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"1"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"1"}]}]]]]]]],[["idf",["klsf"],[["k1f","v1f"],["k2f","v2f"]]],[[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"foot"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"footright"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"footleft"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"footcenter"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"footdefault"}]}]]]]]]]}|] + ,[s|{"t":"Table","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[{"t":"AlignDefault"},{"t":"ColWidthDefault"}],[{"t":"AlignRight"},{"t":"ColWidthDefault"}],[{"t":"AlignLeft"},{"t":"ColWidthDefault"}],[{"t":"AlignCenter"},{"t":"ColWidthDefault"}],[{"t":"AlignDefault"},{"t":"ColWidthDefault"}]],[["idh",["klsh"],[["k1h","v1h"],["k2h","v2h"]]],[[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"Head"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"Right"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"Left"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"Center"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"Default"}]}]]]]]],[[["idb",["klsb"],[["k1b","v1b"],["k2b","v2b"]]],1,[[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"ihead12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"i12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"i12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"i12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"i12"}]}]]]]],[[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"head12"}]}]],[["id",["kls"],[["k1","v1"],["k2","v2"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"12"}]}]],[["id",["kls"],[["k1","v1"],["k2","v2"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"12"}]}]]]],[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"head123"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"123"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"123"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"123"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"123"}]}]]]],[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"head1"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"1"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"1"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"1"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"1"}]}]]]]]]],[["idf",["klsf"],[["k1f","v1f"],["k2f","v2f"]]],[[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"foot"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"footright"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"footleft"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"footcenter"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"footdefault"}]}]]]]]]]}|] ) where tCell i = Cell ("a", ["b"], [("c", "d"), ("e", "f")]) AlignDefault 1 1 [Plain i] 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")]) + CaptionBefore + (Caption nullAttr (Just [Str "hello"]) [Para [Str "cap content"]]) + [Para [Str "fig content"]] + ,[s|{"t":"Figure","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],{"t":"CaptionBefore"},[["",[],[]],[{"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"}]}]]}|] @@ -460,7 +458,6 @@ t_tableSan = testCase "table sanitisation" assertion emptyRow = Row nullAttr $ replicate 2 emptyCell expected = singleton (Table nullAttr - (Caption Nothing []) [(AlignDefault,ColWidthDefault) ,(AlignDefault,ColWidthDefault)] (TableHead nullAttr @@ -635,12 +632,11 @@ t_tableNormExample = testCase "table normalization example" assertion ,[]] spec = replicate 3 (AlignDefault, ColWidthDefault) expected = singleton $ Table nullAttr - emptyCaption spec (th finalHeads) [finalTB] (tf finalHeads) - generated = table emptyCaption spec (th initialHeads) [initialTB] (tf initialHeads) + generated = table spec (th initialHeads) [initialTB] (tf initialHeads) tests :: [Test] tests = @@ -715,6 +711,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 ]