diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2006-2019, John MacFarlane +Copyright (c) 2006-2023, John MacFarlane All rights reserved. diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,14 @@ +[1.23] + + * Remove Null constructor from Block (#91) [API change]. + + * ToJSONFilter: Add instance for MonadIO (#105, Willem Van Onsem) + [API change]. + + * Add `Figure` block constructor (Albert Krewinkel, Aner Lucero, + and Christian Despres) [API change]. The new Figure block represents + a figure with attributes, caption, and arbitrary block content. + [1.22.2.1] * Allow aeson 2.1.* and criterion 1.6. diff --git a/pandoc-types.cabal b/pandoc-types.cabal --- a/pandoc-types.cabal +++ b/pandoc-types.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 Name: pandoc-types -version: 1.22.2.1 +version: 1.23 Synopsis: Types for representing a structured document Description: @Text.Pandoc.Definition@ defines the 'Pandoc' data structure, which is used by pandoc to represent @@ -29,12 +29,12 @@ Author: John MacFarlane Maintainer: jgm@berkeley.edu Bug-Reports: https://github.com/jgm/pandoc-types/issues -Copyright: (c) 2006-2019 John MacFarlane +Copyright: (c) 2006-2023 John MacFarlane Category: Text Build-type: Simple Tested-With: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.2, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7, - GHC == 9.0.2, GHC == 9.2.3 + GHC == 9.0.2, GHC == 9.2.5, GHC == 9.4.4 Extra-Source-Files: changelog Source-repository head type: git diff --git a/src/Text/Pandoc/Arbitrary.hs b/src/Text/Pandoc/Arbitrary.hs --- a/src/Text/Pandoc/Arbitrary.hs +++ b/src/Text/Pandoc/Arbitrary.hs @@ -39,7 +39,7 @@ shrink = fmap fromList . ((++) <$> shrink <*> flattenShrinkInlines) . toList where flattenShrinkInlines (x:xs) = let x' = flattenInline x - in (if null x' then [] else [x' ++ xs]) ++ [x:xs' | xs' <- flattenShrinkInlines xs] + in [x' ++ xs | not (null x')] ++ [x:xs' | xs' <- flattenShrinkInlines xs] flattenShrinkInlines [] = [] flattenInline :: Inline -> [Inline] flattenInline (Str _) = [] @@ -68,7 +68,7 @@ shrink = fmap fromList . ((++) <$> shrink <*> flattenShrinkBlocks) . toList where flattenShrinkBlocks (x:xs) = let x' = flattenBlock x - in (if null x' then [] else [x' ++ xs]) ++ [x:xs' | xs' <- flattenShrinkBlocks xs] + in [x' ++ xs | not (null x')] ++ [x:xs' | xs' <- flattenShrinkBlocks xs] flattenShrinkBlocks [] = [] flattenBlock :: Block -> [Block] flattenBlock Plain{} = [] @@ -86,8 +86,8 @@ 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 @@ -204,9 +204,12 @@ [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 = [] arbBlock :: Int -> Gen Block arbBlock n = frequency $ [ (10, Plain <$> arbInlines (n-1)) @@ -246,6 +249,9 @@ <*> 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 --- a/src/Text/Pandoc/Builder.hs +++ b/src/Text/Pandoc/Builder.hs @@ -3,7 +3,7 @@ DeriveTraversable, OverloadedStrings, PatternGuards #-} {- -Copyright (C) 2010-2019 John MacFarlane +Copyright (C) 2010-2023 John MacFarlane All rights reserved. @@ -37,7 +37,7 @@ {- | Module : Text.Pandoc.Builder - Copyright : Copyright (C) 2010-2019 John MacFarlane + Copyright : Copyright (C) 2010-2023 John MacFarlane License : BSD3 Maintainer : John MacFarlane @@ -168,6 +168,8 @@ , table , simpleTable , tableWith + , figure + , figureWith , caption , simpleCaption , emptyCaption @@ -560,6 +562,12 @@ 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 @@ 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 --- a/src/Text/Pandoc/Definition.hs +++ b/src/Text/Pandoc/Definition.hs @@ -3,7 +3,7 @@ TemplateHaskell , PatternSynonyms, ViewPatterns, StrictData #-} {- -Copyright (c) 2006-2019, John MacFarlane +Copyright (c) 2006-2023, John MacFarlane All rights reserved. @@ -37,7 +37,7 @@ {- | Module : Text.Pandoc.Definition - Copyright : Copyright (C) 2006-2019 John MacFarlane + Copyright : Copyright (C) 2006-2023 John MacFarlane License : BSD3 Maintainer : John MacFarlane @@ -88,7 +88,7 @@ import Data.Generics (Data, Typeable) import Data.Ord (comparing) -import Data.Aeson hiding (Null) +import Data.Aeson import Data.Aeson.TH (deriveJSON) import qualified Data.Aeson.Types as Aeson import qualified Data.Map as M @@ -254,7 +254,7 @@ -- | 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,10 +301,10 @@ -- 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 - | Null deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) -- | Type of quotation marks to use in Quoted inline. @@ -391,7 +391,7 @@ { allNullaryToStringTag = False , sumEncoding = TaggedObject { tagFieldName = "t", contentsFieldName = "c" } } - in fmap concat $ traverse (deriveJSON jsonOpts) + in concat <$> traverse (deriveJSON jsonOpts) [ ''MetaValue , ''CitationMode , ''Citation diff --git a/src/Text/Pandoc/Generic.hs b/src/Text/Pandoc/Generic.hs --- a/src/Text/Pandoc/Generic.hs +++ b/src/Text/Pandoc/Generic.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {- -Copyright (c) 2006-2019, John MacFarlane +Copyright (c) 2006-2023, John MacFarlane All rights reserved. @@ -34,7 +34,7 @@ {- | Module : Text.Pandoc.Generic - Copyright : Copyright (C) 2006-2019 John MacFarlane + Copyright : Copyright (C) 2006-2023 John MacFarlane License : BSD3 Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/JSON.hs b/src/Text/Pandoc/JSON.hs --- a/src/Text/Pandoc/JSON.hs +++ b/src/Text/Pandoc/JSON.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-} {- -Copyright (c) 2013-2019, John MacFarlane +Copyright (c) 2013-2023, John MacFarlane All rights reserved. @@ -34,7 +34,7 @@ {- | Module : Text.Pandoc.JSON - Copyright : Copyright (C) 2013-2019 John MacFarlane + Copyright : Copyright (C) 2013-2023 John MacFarlane License : BSD3 Maintainer : John MacFarlane @@ -74,6 +74,7 @@ where import Text.Pandoc.Definition import Text.Pandoc.Walk +import Control.Monad.IO.Class(MonadIO(liftIO)) import Data.Maybe (listToMaybe) import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T @@ -99,32 +100,28 @@ -- provides the target format as argument when scripts are called using -- the `--filter` option. -class ToJSONFilter a where - toJSONFilter :: a -> IO () +class ToJSONFilter m a where + toJSONFilter :: a -> m () -instance (Walkable a Pandoc) => ToJSONFilter (a -> a) where +instance (Walkable a Pandoc) => ToJSONFilter IO (a -> a) where toJSONFilter f = BL.getContents >>= BL.putStr . encode . (walk f :: Pandoc -> Pandoc) . either error id . eitherDecode' -instance (Walkable a Pandoc) => ToJSONFilter (a -> IO a) where - toJSONFilter f = BL.getContents >>= - (walkM f :: Pandoc -> IO Pandoc) . either error id . eitherDecode' >>= - BL.putStr . encode - -instance (Walkable [a] Pandoc) => ToJSONFilter (a -> [a]) where - toJSONFilter f = BL.getContents >>= - BL.putStr . encode . (walk (concatMap f) :: Pandoc -> Pandoc) . - either error id . eitherDecode' +instance (Walkable a Pandoc, MonadIO m) => ToJSONFilter m (a -> m a) where + toJSONFilter f = do + c <- liftIO BL.getContents + r <- walkM f (either error id (eitherDecode' c) :: Pandoc) + liftIO (BL.putStr (encode (r :: Pandoc))) -instance (Walkable [a] Pandoc) => ToJSONFilter (a -> IO [a]) where - toJSONFilter f = BL.getContents >>= - (walkM (fmap concat . mapM f) :: Pandoc -> IO Pandoc) . - either error id . eitherDecode' >>= - BL.putStr . encode +instance (Walkable [a] Pandoc, MonadIO m) => ToJSONFilter m (a -> m [a]) where + toJSONFilter f = do + c <- liftIO BL.getContents + r <- (walkM (fmap concat . mapM f)) (either error id (eitherDecode' c) :: Pandoc) + liftIO (BL.putStr (encode (r :: Pandoc))) -instance (ToJSONFilter a) => ToJSONFilter ([String] -> a) where - toJSONFilter f = getArgs >>= toJSONFilter . f +instance (ToJSONFilter m a, MonadIO m) => ToJSONFilter m ([String] -> a) where + toJSONFilter f = liftIO getArgs >>= toJSONFilter . f -instance (ToJSONFilter a) => ToJSONFilter (Maybe Format -> a) where - toJSONFilter f = getArgs >>= toJSONFilter . f . fmap (Format . T.pack) . listToMaybe +instance (ToJSONFilter m a, MonadIO m) => ToJSONFilter m (Maybe Format -> a) where + toJSONFilter f = liftIO getArgs >>= toJSONFilter . f . fmap (Format . T.pack) . listToMaybe diff --git a/src/Text/Pandoc/Walk.hs b/src/Text/Pandoc/Walk.hs --- a/src/Text/Pandoc/Walk.hs +++ b/src/Text/Pandoc/Walk.hs @@ -8,7 +8,7 @@ #endif #define OVERLAPS {-# OVERLAPPING #-} {- -Copyright (c) 2013-2019, John MacFarlane +Copyright (c) 2013-2023, John MacFarlane All rights reserved. @@ -42,7 +42,7 @@ {- | Module : Text.Pandoc.Walk - Copyright : Copyright (C) 2013-2019 John MacFarlane + Copyright : Copyright (C) 2013-2023 John MacFarlane License : BSD3 Maintainer : John MacFarlane @@ -485,13 +485,16 @@ 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 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,8 +518,10 @@ 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 -- | Helper method to walk to elements nested below @'MetaValue'@ nodes. -- diff --git a/test/test-pandoc-types.hs b/test/test-pandoc-types.hs --- a/test/test-pandoc-types.hs +++ b/test/test-pandoc-types.hs @@ -149,7 +149,7 @@ ) t_metablocks :: (MetaValue, ByteString) -t_metablocks = ( MetaBlocks [Null,Null], [s|{"t":"MetaBlocks","c":[{"t":"Null"},{"t":"Null"}]}|]) +t_metablocks = ( MetaBlocks [HorizontalRule,HorizontalRule], [s|{"t":"MetaBlocks","c":[{"t":"HorizontalRule"},{"t":"HorizontalRule"}]}|]) t_singlequote :: (QuoteType, ByteString) t_singlequote = (SingleQuote, [s|{"t":"SingleQuote"}|]) @@ -451,14 +451,19 @@ 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"}]}]]}|] ) -t_null :: (Block, ByteString) -t_null = (Null, [s|{"t":"Null"}|]) - -- headers and rows are padded to a consistent number of -- cells in order to avoid syntax errors after conversion, see -- jgm/pandoc#4059. @@ -658,15 +663,17 @@ 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,8 +752,8 @@ , testEncodeDecode "DefinitionList" t_definitionlist , testEncodeDecode "Header" t_header , testEncodeDecode "Table" t_table + , testEncodeDecode "Figure" t_figure , testEncodeDecode "Div" t_div - , testEncodeDecode "Null" t_null ] , testGroup "Table" [ testEncodeDecode "Row" t_row