diff --git a/src/Text/Pandoc/Arbitrary.hs b/src/Text/Pandoc/Arbitrary.hs index 142baea..c337d88 100644 --- a/src/Text/Pandoc/Arbitrary.hs +++ b/src/Text/Pandoc/Arbitrary.hs @@ -83,9 +83,10 @@ instance Arbitrary Blocks where flattenBlock (Header _ _ ils) = [Para ils] flattenBlock HorizontalRule = [] flattenBlock (Table _ capt _ hd bd ft) = flattenCaption capt <> - flattenTableHead hd <> - concatMap flattenTableBody bd <> - flattenTableFoot ft + flattenTableHead hd <> + concatMap flattenTableBody bd <> + flattenTableFoot ft + flattenBlock (Figure _ capt blks) = flattenCaption capt <> blks flattenBlock (Div _ blks) = blks flattenBlock Null = [] @@ -202,8 +203,11 @@ instance Arbitrary Block where [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 capt specs thead tbody tfoot' | tfoot' <- shrink tfoot] + 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 +250,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 77af1f3..33d8def 100644 --- a/src/Text/Pandoc/Builder.hs +++ b/src/Text/Pandoc/Builder.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, GeneralizedNewtypeDeriving, CPP, StandaloneDeriving, DeriveGeneric, DeriveTraversable, OverloadedStrings, PatternGuards #-} + {- Copyright (C) 2010-2019 John MacFarlane @@ -167,9 +168,13 @@ module Text.Pandoc.Builder ( module Text.Pandoc.Definition , table , simpleTable , tableWith + , figure + , figureWith , caption , simpleCaption , emptyCaption + , simpleFigureWith + , simpleFigure , divWith -- * Table processing , normalizeTableHead @@ -557,8 +562,14 @@ 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 +caption msc = Caption msc . toList simpleCaption :: Blocks -> Caption simpleCaption = caption Nothing @@ -566,6 +577,13 @@ simpleCaption = caption Nothing emptyCaption :: Caption emptyCaption = simpleCaption mempty +simpleFigureWith :: Attr -> Inlines -> Text -> Text -> Blocks +simpleFigureWith attr figureCaption url title = + para $ imageWith attr url ("fig:" <> title) figureCaption + +simpleFigure :: Inlines -> Text -> Text -> Blocks +simpleFigure = simpleFigureWith nullAttr + divWith :: Attr -> Blocks -> Blocks divWith attr = singleton . Div attr . toList diff --git a/src/Text/Pandoc/Definition.hs b/src/Text/Pandoc/Definition.hs index b2bf606..9180d66 100644 --- a/src/Text/Pandoc/Definition.hs +++ b/src/Text/Pandoc/Definition.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric, FlexibleContexts, GeneralizedNewtypeDeriving, PatternGuards, CPP, - TemplateHaskell #-} + TemplateHaskell , PatternSynonyms, ViewPatterns #-} {- Copyright (c) 2006-2019, John MacFarlane @@ -57,6 +57,7 @@ module Text.Pandoc.Definition ( Pandoc(..) , docAuthors , docDate , Block(..) + , pattern SimpleFigure , Inline(..) , ListAttributes , ListNumberStyle(..) @@ -99,6 +100,7 @@ import Control.DeepSeq import Paths_pandoc_types (version) import Data.Version (Version, versionBranch) import Data.Semigroup (Semigroup(..)) +import Control.Arrow (second) data Pandoc = Pandoc Meta [Block] deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) @@ -252,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 figure, with optional short caption. data Caption = Caption (Maybe ShortCaption) [Block] deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) @@ -295,10 +297,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, with attributes, column alignments and widths + -- (required), table head, table bodies, and table foot | Table Attr Caption [ColSpec] TableHead [TableBody] TableFoot + -- | Figure, with attributes, caption and caption position, width + -- (optional), and content (list of blocks) + | Figure Attr Caption [Block] -- | Generic block container with attributes | Div Attr [Block] -- | Nothing @@ -311,6 +315,34 @@ data QuoteType = SingleQuote | DoubleQuote deriving (Show, Eq, Ord, Read, Typeab -- | Link target (URL, title). type Target = (Text, Text) +isFigureTarget :: Target -> Maybe Target +isFigureTarget tgt + | (src, Just tit) <- second (T.stripPrefix "fig:") tgt = Just (src, tit) + | otherwise = Nothing + +-- | Bidirectional patter synonym +-- +-- It can pass as a Block constructor +-- +-- >>> SimpleFigure nullAttr [] (T.pack "", T.pack "title") +-- Para [Image ("",[],[]) [] ("","fig:title")] +-- +-- +-- It can be used to pattern match +-- >>> let img = Para [Image undefined undefined (undefined, T.pack "title")] +-- >>> case img of { SimpleFigure _ _ _ -> True; _ -> False } +-- False +-- >>> let fig = Para [Image undefined undefined (undefined, T.pack "fig:title")] +-- >>> case fig of { SimpleFigure _ _ tit -> snd tit; _ -> T.pack "" } +-- "title" +pattern SimpleFigure :: Attr -> [Inline] -> Target -> Block +pattern SimpleFigure attr figureCaption tgt <- + Para [Image attr figureCaption + (isFigureTarget -> Just tgt)] where + SimpleFigure attr figureCaption tgt = + Para [Image attr figureCaption (second ("fig:" <>) tgt)] + + -- | Type of math element (display or inline). data MathType = DisplayMath | InlineMath deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) diff --git a/src/Text/Pandoc/Walk.hs b/src/Text/Pandoc/Walk.hs index a71d848..142c56e 100644 --- a/src/Text/Pandoc/Walk.hs +++ b/src/Text/Pandoc/Walk.hs @@ -472,6 +472,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. @@ -495,6 +499,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 f450d19..ce1c9e8 100644 --- a/test/test-pandoc-types.hs +++ b/test/test-pandoc-types.hs @@ -5,7 +5,8 @@ import Text.Pandoc.Definition import Text.Pandoc.Walk import Text.Pandoc.Builder (singleton, plain, text, simpleTable, table, emptyCell, normalizeTableHead, normalizeTableBody, normalizeTableFoot, - emptyCaption) + emptyCaption, simpleFigureWith) +import qualified Text.Pandoc.Builder as Builder import Data.Generics import Data.List (tails) import Test.HUnit (Assertion, assertEqual, assertFailure) @@ -13,7 +14,7 @@ import Data.Aeson (FromJSON, ToJSON, encode, decode) import Test.Framework import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.Framework.Providers.HUnit (testCase) -import Test.QuickCheck (forAll, choose, Property, Arbitrary, Testable) +import Test.QuickCheck (forAll, choose, Property, Arbitrary, Testable, arbitrary, Gen) import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T @@ -335,7 +336,8 @@ 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"]] +t_caption = (Caption + (Just [Str "foo"]) [Para [Str "bar"]] ,[s|[[{"t":"Str","c":"foo"}],[{"t":"Para","c":[{"t":"Str","c":"bar"}]}]]|]) t_tablehead :: (TableHead, ByteString) @@ -429,6 +431,7 @@ 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"}]}]]]]]]]}|] ) where @@ -436,6 +439,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"}]}]]}|] @@ -460,7 +471,7 @@ t_tableSan = testCase "table sanitisation" assertion emptyRow = Row nullAttr $ replicate 2 emptyCell expected = singleton (Table nullAttr - (Caption Nothing []) + emptyCaption [(AlignDefault,ColWidthDefault) ,(AlignDefault,ColWidthDefault)] (TableHead nullAttr @@ -642,6 +653,17 @@ t_tableNormExample = testCase "table normalization example" assertion (tf finalHeads) generated = table emptyCaption spec (th initialHeads) [initialTB] (tf initialHeads) +p_figureRepresentation :: Property +p_figureRepresentation = forAll (arbitrary :: Gen [Inline]) (\figureCaption -> + simpleFigureWith + ("", [], []) + (Builder.fromList figureCaption) + "url" + "title" == + Builder.fromList + [Para [Image ("", [], []) figureCaption ("url", "fig:title") ]] + ) + tests :: [Test] tests = [ testGroup "Walk" @@ -715,6 +737,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 ] @@ -744,6 +767,8 @@ tests = ] , t_tableSan , t_tableNormExample + , testGroup "Figure" + [ testProperty "p_figureRepresentation figure representation" p_figureRepresentation ] ]