diff --git a/src/Text/Pandoc/Builder.hs b/src/Text/Pandoc/Builder.hs index 77af1f3..ce61ef8 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 @@ -170,6 +171,8 @@ module Text.Pandoc.Builder ( module Text.Pandoc.Definition , caption , simpleCaption , emptyCaption + , simpleFigureWith + , simpleFigure , divWith -- * Table processing , normalizeTableHead @@ -566,6 +569,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..5b4f090 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) @@ -311,6 +313,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/test/test-pandoc-types.hs b/test/test-pandoc-types.hs index f450d19..422f3f4 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 @@ -642,6 +643,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" @@ -744,6 +756,8 @@ tests = ] , t_tableSan , t_tableNormExample + , testGroup "Figure" + [ testProperty "p_figureRepresentation figure representation" p_figureRepresentation ] ]