pandoc-types 1.22.2.1 → 1.23.1.2
raw patch · 11 files changed
Files
- LICENSE +1/−1
- changelog +53/−0
- pandoc-types.cabal +15/−20
- src/Text/Pandoc/Arbitrary.hs +10/−5
- src/Text/Pandoc/Builder.hs +15/−6
- src/Text/Pandoc/Definition.hs +8/−9
- src/Text/Pandoc/Generic.hs +2/−2
- src/Text/Pandoc/JSON.hs +27/−24
- src/Text/Pandoc/Walk.hs +9/−8
- test/Data/String/QQ.hs +19/−0
- test/test-pandoc-types.hs +16/−9
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2006-2019, John MacFarlane+Copyright (c) 2006-2023, John MacFarlane All rights reserved.
changelog view
@@ -1,3 +1,56 @@+[1.23.1.2]++ * Bump upper bound for QuickCheck.++ * Remove obsolete semigroups clause for ghc < 8.++ * Allow aeson 2.3 (Francesco Gazzetta).++ * CI: remove ghc 8.10 from testing++ * Use lts-26 in stack.yaml.++ * Set minimum base version 4.15.++[1.23.1.1]++ * Remove unused `ghc-prim` dependency (konsumlam).++ * Bump bound for QuickCheck.++ * Allow deepseq-1.5 (Bodigrim).++ * Fix 'patter' typo in SimpleFigure haddock (Owen Shepherd).++[1.23.1]++ * Restore toJSONFilter instance for pure `a -> [a]`.+ This went missing after my ill-considered revision to #105,+ commit 183af9d9f1066be974ac55fd23a4c985999d3ce8 . See jgm/pandoc#8976.++ * Generalize ToJSONFilter instance. Previously a pure function `a -> a`+ could only be promoted to a filter in IO. Now we allow it to work with+ any instance of MonadIO. (This adds to #105.)++ * Allow bytestring 0.12.++[1.23.0.1]++ * Allow aeson 2.2.++ * Remove dependency on string-qq (recbecca skinner).++[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.
pandoc-types.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 Name: pandoc-types-version: 1.22.2.1+version: 1.23.1.2 Synopsis: Types for representing a structured document Description: @Text.Pandoc.Definition@ defines the 'Pandoc' data structure, which is used by pandoc to represent@@ -29,16 +29,13 @@ 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-Extra-Source-Files: changelog+Extra-doc-files: changelog Source-repository head type: git- location: git://github.com/jgm/pandoc-types.git+ location: https://github.com/jgm/pandoc-types.git Library hs-source-dirs: src@@ -50,18 +47,15 @@ Text.Pandoc.Arbitrary Other-modules: Paths_pandoc_types Autogen-modules: Paths_pandoc_types- Build-depends: base >= 4.5 && < 5,+ Build-depends: base >= 4.15 && < 5, containers >= 0.3, text,- deepseq >= 1.4.1 && < 1.5,+ deepseq >= 1.4.1 && < 1.6, syb >= 0.1 && < 0.8,- ghc-prim >= 0.2,- bytestring >= 0.9 && < 0.12,- aeson >= 0.6.2 && < 2.2,+ bytestring >= 0.9 && < 0.13,+ aeson >= 0.6.2 && < 2.4, transformers >= 0.2 && < 0.7,- QuickCheck >= 2.10 && < 2.15- if !impl(ghc >= 8.0)- Build-depends: semigroups == 0.18.*+ QuickCheck >= 2.10 && < 2.19 ghc-options: -Wall default-language: Haskell2010 @@ -69,19 +63,20 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: test-pandoc-types.hs+ Other-modules: Data.String.QQ build-depends: base, pandoc-types, syb,- aeson >= 0.6.2 && < 2.2,+ aeson >= 0.6.2 && < 2.4, containers >= 0.3, text,- bytestring >= 0.9 && < 0.12,+ bytestring >= 0.9 && < 0.13, test-framework >= 0.3 && < 0.9, test-framework-hunit >= 0.2 && < 0.4, test-framework-quickcheck2 >= 0.2.9 && < 0.4,- QuickCheck >= 2.10 && < 2.15,+ QuickCheck >= 2.10 && < 2.19, HUnit >= 1.2 && < 1.7,- string-qq >= 0.0.2 && < 0.1+ template-haskell >= 2 ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -O2 default-language: Haskell2010 @@ -90,7 +85,7 @@ main-is: bench.hs hs-source-dirs: benchmark build-depends: pandoc-types,- base >= 4.5 && < 5,+ base >= 4.15 && < 5, text, criterion >= 1.0 ghc-options: -rtsopts -Wall -fno-warn-unused-do-bind -O2
src/Text/Pandoc/Arbitrary.hs view
@@ -4,7 +4,6 @@ module Text.Pandoc.Arbitrary () where import Test.QuickCheck-import Control.Applicative (Applicative ((<*>), pure), (<$>)) import Control.Monad (forM) import Data.Text (Text) import qualified Data.Text as T@@ -39,7 +38,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 +67,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 +85,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 +203,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 +248,9 @@ <*> arbTableHead (n-1) <*> vectorOf bs (arbTableBody (n-1)) <*> arbTableFoot (n-1))+ , (2, Figure <$> arbAttr+ <*> arbitrary+ <*> listOf1 (arbBlock (n-1))) ] arbRow :: Int -> Gen Row
src/Text/Pandoc/Builder.hs view
@@ -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 <jgm@berkeley.edu>@@ -168,6 +168,8 @@ , table , simpleTable , tableWith+ , figure+ , figureWith , caption , simpleCaption , emptyCaption@@ -189,13 +191,10 @@ import qualified Data.Text as T import Data.Sequence (Seq, (|>), viewr, viewl, ViewR(..), ViewL(..)) import qualified Data.Sequence as Seq-import Data.Traversable (Traversable)-import Data.Foldable (Foldable) import qualified Data.Foldable as F import Data.Data import Control.Arrow ((***)) import GHC.Generics (Generic)-import Data.Semigroup (Semigroup(..)) newtype Many a = Many { unMany :: Seq a } deriving (Data, Ord, Eq, Typeable, Foldable, Traversable, Functor, Show, Read)@@ -560,6 +559,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 +574,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
src/Text/Pandoc/Definition.hs view
@@ -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 <jgm@berkeley.edu>@@ -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@@ -99,7 +99,6 @@ 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]@@ -254,7 +253,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 +300,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.@@ -318,7 +317,7 @@ | (src, Just tit) <- second (T.stripPrefix "fig:") tgt = Just (src, tit) | otherwise = Nothing --- | Bidirectional patter synonym+-- | Bidirectional pattern synonym -- -- It can pass as a Block constructor --@@ -391,7 +390,7 @@ { allNullaryToStringTag = False , sumEncoding = TaggedObject { tagFieldName = "t", contentsFieldName = "c" } }- in fmap concat $ traverse (deriveJSON jsonOpts)+ in concat <$> traverse (deriveJSON jsonOpts) [ ''MetaValue , ''CitationMode , ''Citation
src/Text/Pandoc/Generic.hs view
@@ -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 <jgm@berkeley.edu>
src/Text/Pandoc/JSON.hs view
@@ -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 <jgm@berkeley.edu>@@ -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,34 @@ -- 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- toJSONFilter f = BL.getContents >>=+instance (Walkable a Pandoc, MonadIO m) => ToJSONFilter m (a -> a) where+ toJSONFilter f = liftIO $ 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 >>=+instance (Walkable [a] Pandoc, MonadIO m) => ToJSONFilter m (a -> [a]) where+ toJSONFilter f = liftIO $ BL.getContents >>= BL.putStr . encode . (walk (concatMap f) :: Pandoc -> Pandoc) .- either error id . eitherDecode'+ either error id .+ eitherDecode' -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 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 (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 (Maybe Format -> a) where- toJSONFilter f = getArgs >>= toJSONFilter . f . fmap (Format . T.pack) . listToMaybe+instance (ToJSONFilter m a, MonadIO m) => ToJSONFilter m ([String] -> a) where+ toJSONFilter f = liftIO getArgs >>= toJSONFilter . f++instance (ToJSONFilter m a, MonadIO m) => ToJSONFilter m (Maybe Format -> a) where+ toJSONFilter f = liftIO getArgs >>= toJSONFilter . f . fmap (Format . T.pack) . listToMaybe
src/Text/Pandoc/Walk.hs view
@@ -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 <jgm@berkeley.edu>@@ -114,16 +114,12 @@ , walkPandocM ) where-import Control.Applicative (Applicative ((<*>), pure), (<$>)) import Control.Monad ((>=>)) import Data.Functor.Identity (Identity (runIdentity)) import qualified Data.Map as M import Text.Pandoc.Definition import qualified Data.Traversable as T-import Data.Traversable (Traversable) import qualified Data.Foldable as F-import Data.Foldable (Foldable)-import Data.Monoid ((<>)) class Walkable a b where -- | @walk f x@ walks the structure @x@ (bottom up) and replaces every@@ -485,13 +481,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 +514,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. --
+ test/Data/String/QQ.hs view
@@ -0,0 +1,19 @@+-- | This module is based off the QQ implementation from string-qq+-- (https://github.com/audreyt/string-qq).+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE RankNTypes #-}+module Data.String.QQ (s) where+import Data.String (IsString(..))+import Language.Haskell.TH.Quote (QuasiQuoter(..))++s :: QuasiQuoter+s = QuasiQuoter expr pat typ dec+ where+ expr = (\a -> [|fromString a|]) . clean+ pat = error "Cannot use s as a pattern"+ typ = error "Cannot use s as a type"+ dec = error "Cannot use s as a dec"+ clean = removeCarriageReturns . trimLeadingNewline+ removeCarriageReturns = filter (/= '\r')+ trimLeadingNewline ('\n':xs) = xs+ trimLeadingNewline xs = xs
test/test-pandoc-types.hs view
@@ -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