pandoc-types 1.17.1 → 1.17.2
raw patch · 6 files changed
+321/−296 lines, 6 filesdep +criteriondep +transformersdep ~basePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: criterion, transformers
Dependency ranges changed: base
API changes (from Hackage documentation)
- Text.Pandoc.JSON: instance Data.Data.Data a => Text.Pandoc.JSON.ToJSONFilter (a -> GHC.Types.IO [a])
- Text.Pandoc.JSON: instance Data.Data.Data a => Text.Pandoc.JSON.ToJSONFilter (a -> [a])
+ Text.Pandoc.JSON: instance Text.Pandoc.Walk.Walkable [a] Text.Pandoc.Definition.Pandoc => Text.Pandoc.JSON.ToJSONFilter (a -> GHC.Types.IO [a])
+ Text.Pandoc.JSON: instance Text.Pandoc.Walk.Walkable [a] Text.Pandoc.Definition.Pandoc => Text.Pandoc.JSON.ToJSONFilter (a -> [a])
+ Text.Pandoc.Walk: instance Text.Pandoc.Walk.Walkable [Text.Pandoc.Definition.Block] Text.Pandoc.Definition.Citation
+ Text.Pandoc.Walk: instance Text.Pandoc.Walk.Walkable [Text.Pandoc.Definition.Block] Text.Pandoc.Definition.Inline
+ Text.Pandoc.Walk: instance Text.Pandoc.Walk.Walkable [Text.Pandoc.Definition.Block] Text.Pandoc.Definition.Meta
+ Text.Pandoc.Walk: instance Text.Pandoc.Walk.Walkable [Text.Pandoc.Definition.Block] Text.Pandoc.Definition.MetaValue
+ Text.Pandoc.Walk: instance Text.Pandoc.Walk.Walkable [Text.Pandoc.Definition.Block] Text.Pandoc.Definition.Pandoc
+ Text.Pandoc.Walk: instance Text.Pandoc.Walk.Walkable [Text.Pandoc.Definition.Block] [Text.Pandoc.Definition.Block]
+ Text.Pandoc.Walk: instance Text.Pandoc.Walk.Walkable [Text.Pandoc.Definition.Inline] Text.Pandoc.Definition.Block
+ Text.Pandoc.Walk: instance Text.Pandoc.Walk.Walkable [Text.Pandoc.Definition.Inline] Text.Pandoc.Definition.Citation
+ Text.Pandoc.Walk: instance Text.Pandoc.Walk.Walkable [Text.Pandoc.Definition.Inline] Text.Pandoc.Definition.Meta
+ Text.Pandoc.Walk: instance Text.Pandoc.Walk.Walkable [Text.Pandoc.Definition.Inline] Text.Pandoc.Definition.MetaValue
+ Text.Pandoc.Walk: instance Text.Pandoc.Walk.Walkable [Text.Pandoc.Definition.Inline] Text.Pandoc.Definition.Pandoc
+ Text.Pandoc.Walk: instance Text.Pandoc.Walk.Walkable [Text.Pandoc.Definition.Inline] [Text.Pandoc.Definition.Inline]
- Text.Pandoc.Walk: class Walkable a b
+ Text.Pandoc.Walk: class Walkable a b where walk f = runIdentity . walkM (return . f)
- Text.Pandoc.Walk: walkM :: (Walkable a b, Monad m, Functor m) => (a -> m a) -> b -> m b
+ Text.Pandoc.Walk: walkM :: (Walkable a b, Monad m, Applicative m, Functor m) => (a -> m a) -> b -> m b
Files
- Text/Pandoc/JSON.hs +4/−6
- Text/Pandoc/Walk.hs +201/−285
- benchmark/bench.hs +39/−0
- changelog +24/−0
- pandoc-types.cabal +14/−3
- test/test-pandoc-types.hs +39/−2
Text/Pandoc/JSON.hs view
@@ -74,9 +74,7 @@ where import Text.Pandoc.Definition import Text.Pandoc.Walk-import Text.Pandoc.Generic import Data.Maybe (listToMaybe)-import Data.Data import qualified Data.ByteString.Lazy as BL import Data.Aeson import System.Environment (getArgs)@@ -113,14 +111,14 @@ (walkM f :: Pandoc -> IO Pandoc) . either error id . eitherDecode' >>= BL.putStr . encode -instance Data a => ToJSONFilter (a -> [a]) where+instance (Walkable [a] Pandoc) => ToJSONFilter (a -> [a]) where toJSONFilter f = BL.getContents >>=- BL.putStr . encode . (bottomUp (concatMap f) :: Pandoc -> Pandoc) .+ BL.putStr . encode . (walk (concatMap f) :: Pandoc -> Pandoc) . either error id . eitherDecode' -instance Data a => ToJSONFilter (a -> IO [a]) where+instance (Walkable [a] Pandoc) => ToJSONFilter (a -> IO [a]) where toJSONFilter f = BL.getContents >>=- (bottomUpM (fmap concat . mapM f) :: Pandoc -> IO Pandoc) .+ (walkM (fmap concat . mapM f) :: Pandoc -> IO Pandoc) . either error id . eitherDecode' >>= BL.putStr . encode
Text/Pandoc/Walk.hs view
@@ -1,6 +1,10 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables, CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,9,0)-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+{-# OPTIONS_GHC -fno-warn-redundant-constraints -O2 #-} #endif #if MIN_VERSION_base(4,8,0) #define OVERLAPS {-# OVERLAPPING #-}@@ -9,7 +13,7 @@ #define OVERLAPS #endif {--Copyright (c) 2013-2016, John MacFarlane+Copyright (c) 2013-2017, John MacFarlane All rights reserved. @@ -89,7 +93,9 @@ module Text.Pandoc.Walk (Walkable(..)) where-import Control.Applicative ((<$>))+import Control.Applicative (Applicative (pure), (<$>), (<*>))+import Control.Monad ((>=>))+import Data.Functor.Identity (Identity (runIdentity)) import Text.Pandoc.Definition import qualified Data.Traversable as T import Data.Traversable (Traversable)@@ -105,11 +111,13 @@ -- | @walk f x@ walks the structure @x@ (bottom up) and replaces every -- occurrence of an @a@ with the result of applying @f@ to it. walk :: (a -> a) -> b -> b+ walk f = runIdentity . walkM (return . f) -- | A monadic version of 'walk'.- walkM :: (Monad m, Functor m) => (a -> m a) -> b -> m b+ walkM :: (Monad m, Applicative m, Functor m) => (a -> m a) -> b -> m b -- | @query f x@ walks the structure @x@ (bottom up) and applies @f@ -- to every @a@, appending the results. query :: Monoid c => (a -> c) -> b -> c+ {-# MINIMAL walkM, query #-} instance (Foldable t, Traversable t, Walkable a b) => Walkable a (t b) where walk f = T.fmapDefault (walk f)@@ -125,326 +133,234 @@ query f (x,y) = mappend (query f x) (query f y) instance Walkable Inline Inline where- walk f (Str xs) = f $ Str xs- walk f (Emph xs) = f $ Emph (walk f xs)- walk f (Strong xs) = f $ Strong (walk f xs)- walk f (Strikeout xs) = f $ Strikeout (walk f xs)- walk f (Subscript xs) = f $ Subscript (walk f xs)- walk f (Superscript xs) = f $ Superscript (walk f xs)- walk f (SmallCaps xs) = f $ SmallCaps (walk f xs)- walk f (Quoted qt xs) = f $ Quoted qt (walk f xs)- walk f (Cite cs xs) = f $ Cite (walk f cs) (walk f xs)- walk f (Code attr s) = f $ Code attr s- walk f Space = f Space- walk f SoftBreak = f SoftBreak- walk f LineBreak = f LineBreak- walk f (Math mt s) = f (Math mt s)- walk f (RawInline t s) = f $ RawInline t s- walk f (Link atr xs t) = f $ Link atr (walk f xs) t- walk f (Image atr xs t) = f $ Image atr (walk f xs) t- walk f (Note bs) = f $ Note (walk f bs)- walk f (Span attr xs) = f $ Span attr (walk f xs)-- walkM f (Str xs) = f $ Str xs- walkM f (Emph xs) = Emph <$> walkM f xs >>= f- walkM f (Strong xs) = Strong <$> walkM f xs >>= f- walkM f (Strikeout xs) = Strikeout <$> walkM f xs >>= f- walkM f (Subscript xs) = Subscript <$> walkM f xs >>= f- walkM f (Superscript xs)= Superscript <$> walkM f xs >>= f- walkM f (SmallCaps xs) = SmallCaps <$> walkM f xs >>= f- walkM f (Quoted qt xs) = Quoted qt <$> walkM f xs >>= f- walkM f (Cite cs xs) = do cs' <- walkM f cs- xs' <- walkM f xs- f $ Cite cs' xs'- walkM f (Code attr s) = f $ Code attr s- walkM f Space = f Space- walkM f SoftBreak = f SoftBreak- walkM f LineBreak = f LineBreak- walkM f (Math mt s) = f (Math mt s)- walkM f (RawInline t s) = f $ RawInline t s- walkM f (Link atr xs t) = Link atr <$> walkM f xs >>= f . ($ t)- walkM f (Image atr xs t)= Image atr <$> walkM f xs >>= f . ($ t)- walkM f (Note bs) = Note <$> walkM f bs >>= f- walkM f (Span attr xs) = Span attr <$> walkM f xs >>= f+ walkM f x = walkInlineM f x >>= f+ query f x = f x <> queryInline f x - query f (Str xs) = f (Str xs)- query f (Emph xs) = f (Emph xs) <> query f xs- query f (Strong xs) = f (Strong xs) <> query f xs- query f (Strikeout xs) = f (Strikeout xs) <> query f xs- query f (Subscript xs) = f (Subscript xs) <> query f xs- query f (Superscript xs)= f (Superscript xs) <> query f xs- query f (SmallCaps xs) = f (SmallCaps xs) <> query f xs- query f (Quoted qt xs) = f (Quoted qt xs) <> query f xs- query f (Cite cs xs) = f (Cite cs xs) <> query f cs <> query f xs- query f (Code attr s) = f (Code attr s)- query f Space = f Space- query f SoftBreak = f SoftBreak- query f LineBreak = f LineBreak- query f (Math mt s) = f (Math mt s)- query f (RawInline t s) = f (RawInline t s)- query f (Link atr xs t) = f (Link atr xs t) <> query f xs- query f (Image atr xs t)= f (Image atr xs t) <> query f xs- query f (Note bs) = f (Note bs) <> query f bs- query f (Span attr xs) = f (Span attr xs) <> query f xs+instance OVERLAPS+ Walkable [Inline] [Inline] where+ walkM f = T.traverse (walkInlineM f) >=> f+ query f inlns = f inlns <> mconcat (map (queryInline f) inlns) instance Walkable Inline Block where- walk f (Para xs) = Para $ walk f xs- walk f (Plain xs) = Plain $ walk f xs- walk f (LineBlock xs) = LineBlock $ walk f xs- walk _ (CodeBlock attr s) = CodeBlock attr s- walk _ (RawBlock t s) = RawBlock t s- walk f (BlockQuote bs) = BlockQuote $ walk f bs- walk f (OrderedList a cs) = OrderedList a $ walk f cs- walk f (BulletList cs) = BulletList $ walk f cs- walk f (DefinitionList xs) = DefinitionList $ walk f xs- walk f (Header lev attr xs) = Header lev attr $ walk f xs- walk _ HorizontalRule = HorizontalRule- walk f (Table capt as ws hs rs) = Table (walk f capt) as ws (walk f hs) (walk f rs)- walk f (Div attr bs) = Div attr (walk f bs)- walk _ Null = Null-- walkM f (Para xs) = Para <$> walkM f xs- walkM f (Plain xs) = Plain <$> walkM f xs- walkM f (LineBlock xs) = LineBlock <$> walkM f xs- walkM _ (CodeBlock attr s) = return $ CodeBlock attr s- walkM _ (RawBlock t s) = return $ RawBlock t s- walkM f (BlockQuote bs) = BlockQuote <$> walkM f bs- walkM f (OrderedList a cs) = OrderedList a <$> walkM f cs- walkM f (BulletList cs) = BulletList <$> walkM f cs- walkM f (DefinitionList xs) = DefinitionList <$> walkM f xs- walkM f (Header lev attr xs) = Header lev attr <$> walkM f xs- walkM _ HorizontalRule = return HorizontalRule- walkM f (Table capt as ws hs rs) = do- capt' <- walkM f capt- hs' <- walkM f hs- rs' <- walkM f rs- return $ Table capt' as ws hs' rs'- walkM f (Div attr bs) = Div attr <$> (walkM f bs)- walkM _ Null = return Null+ walkM f x = walkBlockM f x+ query f x = queryBlock f x - query f (Para xs) = query f xs- query f (Plain xs) = query f xs- query f (LineBlock xs) = query f xs- query _ (CodeBlock _ _) = mempty- query _ (RawBlock _ _) = mempty- query f (BlockQuote bs) = query f bs- query f (OrderedList _ cs) = query f cs- query f (BulletList cs) = query f cs- query f (DefinitionList xs) = query f xs- query f (Header _ _ xs) = query f xs- query _ HorizontalRule = mempty- query f (Table capt _ _ hs rs) = query f capt <> query f hs <> query f rs- query f (Div _ bs) = query f bs- query _ Null = mempty+instance Walkable [Inline] Block where+ walkM f x = walkBlockM f x+ query f x = queryBlock f x instance Walkable Block Block where- walk f (Para xs) = f $ Para $ walk f xs- walk f (Plain xs) = f $ Plain $ walk f xs- walk f (LineBlock xs) = f $ LineBlock $ walk f xs- walk f (CodeBlock attr s) = f $ CodeBlock attr s- walk f (RawBlock t s) = f $ RawBlock t s- walk f (BlockQuote bs) = f $ BlockQuote $ walk f bs- walk f (OrderedList a cs) = f $ OrderedList a $ walk f cs- walk f (BulletList cs) = f $ BulletList $ walk f cs- walk f (DefinitionList xs) = f $ DefinitionList $ walk f xs- walk f (Header lev attr xs) = f $ Header lev attr $ walk f xs- walk f HorizontalRule = f $ HorizontalRule- walk f (Table capt as ws hs rs) = f $ Table (walk f capt) as ws (walk f hs)- (walk f rs)- walk f (Div attr bs) = f $ Div attr (walk f bs)- walk _ Null = Null-- walkM f (Para xs) = Para <$> walkM f xs >>= f- walkM f (Plain xs) = Plain <$> walkM f xs >>= f- walkM f (LineBlock xs) = LineBlock <$> walkM f xs >>= f- walkM f (CodeBlock attr s) = f $ CodeBlock attr s- walkM f (RawBlock t s) = f $ RawBlock t s- walkM f (BlockQuote bs) = BlockQuote <$> walkM f bs >>= f- walkM f (OrderedList a cs) = OrderedList a <$> walkM f cs >>= f- walkM f (BulletList cs) = BulletList <$> walkM f cs >>= f- walkM f (DefinitionList xs) = DefinitionList <$> walkM f xs >>= f- walkM f (Header lev attr xs) = Header lev attr <$> walkM f xs >>= f- walkM f HorizontalRule = f $ HorizontalRule- walkM f (Table capt as ws hs rs) = do capt' <- walkM f capt- hs' <- walkM f hs- rs' <- walkM f rs- f $ Table capt' as ws hs' rs'- walkM f (Div attr bs) = Div attr <$> walkM f bs >>= f- walkM f Null = f Null+ walkM f x = walkBlockM f x >>= f+ query f x = f x <> queryBlock f x - query f (Para xs) = f (Para xs) <> query f xs- query f (Plain xs) = f (Plain xs) <> query f xs- query f (LineBlock xs) = f (LineBlock xs) <> query f xs- query f (CodeBlock attr s) = f $ CodeBlock attr s- query f (RawBlock t s) = f $ RawBlock t s- query f (BlockQuote bs) = f (BlockQuote bs) <> query f bs- query f (OrderedList a cs) = f (OrderedList a cs) <> query f cs- query f (BulletList cs) = f (BulletList cs) <> query f cs- query f (DefinitionList xs) = f (DefinitionList xs) <> query f xs- query f (Header lev attr xs) = f (Header lev attr xs) <> query f xs- query f HorizontalRule = f $ HorizontalRule- query f (Table capt as ws hs rs) = f (Table capt as ws hs rs) <>- query f capt <> query f hs <> query f rs- query f (Div attr bs) = f (Div attr bs) <> query f bs- query f Null = f Null+instance OVERLAPS+ Walkable [Block] [Block] where+ walkM f = T.traverse (walkBlockM f) >=> f+ query f blks = f blks <> mconcat (map (queryBlock f) blks) instance Walkable Block Inline where- walk _ (Str xs) = Str xs- walk f (Emph xs) = Emph (walk f xs)- walk f (Strong xs) = Strong (walk f xs)- walk f (Strikeout xs) = Strikeout (walk f xs)- walk f (Subscript xs) = Subscript (walk f xs)- walk f (Superscript xs)= Superscript (walk f xs)- walk f (SmallCaps xs) = SmallCaps (walk f xs)- walk f (Quoted qt xs) = Quoted qt (walk f xs)- walk f (Cite cs xs) = Cite (walk f cs) (walk f xs)- walk _ (Code attr s) = Code attr s- walk _ Space = Space- walk _ SoftBreak = SoftBreak- walk _ LineBreak = LineBreak- walk _ (Math mt s) = Math mt s- walk _ (RawInline t s) = RawInline t s- walk f (Link atr xs t) = Link atr (walk f xs) t- walk f (Image atr xs t)= Image atr (walk f xs) t- walk f (Note bs) = Note (walk f bs)- walk f (Span attr xs) = Span attr (walk f xs)-- walkM _ (Str xs) = return $ Str xs- walkM f (Emph xs) = Emph <$> walkM f xs- walkM f (Strong xs) = Strong <$> walkM f xs- walkM f (Strikeout xs) = Strikeout <$> walkM f xs- walkM f (Subscript xs) = Subscript <$> walkM f xs- walkM f (Superscript xs)= Superscript <$> walkM f xs- walkM f (SmallCaps xs) = SmallCaps <$> walkM f xs- walkM f (Quoted qt xs) = Quoted qt <$> walkM f xs- walkM f (Cite cs xs) = do cs' <- walkM f cs- xs' <- walkM f xs- return $ Cite cs' xs'- walkM _ (Code attr s) = return $ Code attr s- walkM _ Space = return $ Space- walkM _ SoftBreak = return $ SoftBreak- walkM _ LineBreak = return $ LineBreak- walkM _ (Math mt s) = return $ Math mt s- walkM _ (RawInline t s) = return $ RawInline t s- walkM f (Link atr xs t) = (\lab -> Link atr lab t) <$> walkM f xs- walkM f (Image atr xs t)= (\lab -> Image atr lab t) <$> walkM f xs- walkM f (Note bs) = Note <$> walkM f bs- walkM f (Span attr xs) = Span attr <$> walkM f xs+ walkM f x = walkInlineM f x+ query f x = queryInline f x - query _ (Str _) = mempty- query f (Emph xs) = query f xs- query f (Strong xs) = query f xs- query f (Strikeout xs) = query f xs- query f (Subscript xs) = query f xs- query f (Superscript xs)= query f xs- query f (SmallCaps xs) = query f xs- query f (Quoted _ xs) = query f xs- query f (Cite cs xs) = query f cs <> query f xs- query _ (Code _ _) = mempty- query _ Space = mempty- query _ SoftBreak = mempty- query _ LineBreak = mempty- query _ (Math _ _) = mempty- query _ (RawInline _ _) = mempty- query f (Link _ xs _) = query f xs- query f (Image _ xs _) = query f xs- query f (Note bs) = query f bs- query f (Span _ xs) = query f xs+instance Walkable [Block] Inline where+ walkM f x = walkInlineM f x+ query f x = queryInline f x instance Walkable Block Pandoc where- walk f (Pandoc m bs) = Pandoc (walk f m) (walk f bs)- walkM f (Pandoc m bs) = do m' <- walkM f m- bs' <- walkM f bs- return $ Pandoc m' bs'- query f (Pandoc m bs) = query f m <> query f bs+ walkM = walkPandocM+ query = queryPandoc +instance Walkable [Block] Pandoc where+ walkM = walkPandocM+ query = queryPandoc+ instance Walkable Inline Pandoc where- walk f (Pandoc m bs) = Pandoc (walk f m) (walk f bs)- walkM f (Pandoc m bs) = do m' <- walkM f m- bs' <- walkM f bs- return $ Pandoc m' bs'- query f (Pandoc m bs) = query f m <> query f bs+ walkM = walkPandocM+ query = queryPandoc +instance Walkable [Inline] Pandoc where+ walkM = walkPandocM+ query = queryPandoc+ instance Walkable Pandoc Pandoc where- walk f = f walkM f = f query f = f instance Walkable Meta Meta where- walk f = f walkM f = f query f = f instance Walkable Inline Meta where- walk f (Meta metamap) = Meta $ walk f metamap walkM f (Meta metamap) = Meta <$> walkM f metamap query f (Meta metamap) = query f metamap +instance Walkable [Inline] Meta where+ walkM f (Meta metamap) = Meta <$> walkM f metamap+ query f (Meta metamap) = query f metamap+ instance Walkable Block Meta where- walk f (Meta metamap) = Meta $ walk f metamap walkM f (Meta metamap) = Meta <$> walkM f metamap query f (Meta metamap) = query f metamap -instance Walkable Inline MetaValue where- walk f (MetaList xs) = MetaList $ walk f xs- walk _ (MetaBool b) = MetaBool b- walk _ (MetaString s) = MetaString s- walk f (MetaInlines xs) = MetaInlines $ walk f xs- walk f (MetaBlocks bs) = MetaBlocks $ walk f bs- walk f (MetaMap m) = MetaMap $ walk f m+instance Walkable [Block] Meta where+ walkM f (Meta metamap) = Meta <$> walkM f metamap+ query f (Meta metamap) = query f metamap - walkM f (MetaList xs) = MetaList <$> walkM f xs- walkM _ (MetaBool b) = return $ MetaBool b- walkM _ (MetaString s) = return $ MetaString s- walkM f (MetaInlines xs) = MetaInlines <$> walkM f xs- walkM f (MetaBlocks bs) = MetaBlocks <$> walkM f bs- walkM f (MetaMap m) = MetaMap <$> walkM f m+instance Walkable Inline MetaValue where+ walkM = walkMetaValueM+ query = queryMetaValue - query f (MetaList xs) = query f xs- query _ (MetaBool _) = mempty- query _ (MetaString _) = mempty- query f (MetaInlines xs) = query f xs- query f (MetaBlocks bs) = query f bs- query f (MetaMap m) = query f m+instance Walkable [Inline] MetaValue where+ walkM = walkMetaValueM+ query = queryMetaValue instance Walkable Block MetaValue where- walk f (MetaList xs) = MetaList $ walk f xs- walk _ (MetaBool b) = MetaBool b- walk _ (MetaString s) = MetaString s- walk f (MetaInlines xs) = MetaInlines $ walk f xs- walk f (MetaBlocks bs) = MetaBlocks $ walk f bs- walk f (MetaMap m) = MetaMap $ walk f m-- walkM f (MetaList xs) = MetaList <$> walkM f xs- walkM _ (MetaBool b) = return $ MetaBool b- walkM _ (MetaString s) = return $ MetaString s- walkM f (MetaInlines xs) = MetaInlines <$> walkM f xs- walkM f (MetaBlocks bs) = MetaBlocks <$> walkM f bs- walkM f (MetaMap m) = MetaMap <$> walkM f m+ walkM = walkMetaValueM+ query = queryMetaValue - query f (MetaList xs) = query f xs- query _ (MetaBool _) = mempty- query _ (MetaString _) = mempty- query f (MetaInlines xs) = query f xs- query f (MetaBlocks bs) = query f bs- query f (MetaMap m) = query f m+instance Walkable [Block] MetaValue where+ walkM = walkMetaValueM+ query = queryMetaValue instance Walkable Inline Citation where- walk f (Citation id' pref suff mode notenum hash) =- Citation id' (walk f pref) (walk f suff) mode notenum hash- walkM f (Citation id' pref suff mode notenum hash) =- do pref' <- walkM f pref- suff' <- walkM f suff- return $ Citation id' pref' suff' mode notenum hash- query f (Citation _ pref suff _ _ _) =- query f pref <> query f suff+ walkM = walkCitationM+ query = queryCitation +instance Walkable [Inline] Citation where+ walkM = walkCitationM+ query = queryCitation+ instance Walkable Block Citation where- walk f (Citation id' pref suff mode notenum hash) =- Citation id' (walk f pref) (walk f suff) mode notenum hash- walkM f (Citation id' pref suff mode notenum hash) =+ walkM = walkCitationM+ query = queryCitation++instance Walkable [Block] Citation where+ walkM = walkCitationM+ query = queryCitation++walkInlineM :: (Walkable a Citation, Walkable a [Block],+ Walkable a [Inline], Monad m, Applicative m, Functor m)+ => (a -> m a) -> Inline -> m Inline+walkInlineM _ (Str xs) = return (Str xs)+walkInlineM f (Emph xs) = Emph <$> walkM f xs+walkInlineM f (Strong xs) = Strong <$> walkM f xs+walkInlineM f (Strikeout xs) = Strikeout <$> walkM f xs+walkInlineM f (Subscript xs) = Subscript <$> walkM f xs+walkInlineM f (Superscript xs) = Superscript <$> walkM f xs+walkInlineM f (SmallCaps xs) = SmallCaps <$> walkM f xs+walkInlineM f (Quoted qt xs) = Quoted qt <$> walkM f xs+walkInlineM f (Link atr xs t) = Link atr <$> walkM f xs <*> pure t+walkInlineM f (Image atr xs t) = Image atr <$> walkM f xs <*> pure t+walkInlineM f (Note bs) = Note <$> walkM f bs+walkInlineM f (Span attr xs) = Span attr <$> walkM f xs+walkInlineM f (Cite cs xs) = Cite <$> walkM f cs <*> walkM f xs+walkInlineM _ LineBreak = return LineBreak+walkInlineM _ SoftBreak = return SoftBreak+walkInlineM _ Space = return Space+walkInlineM _ x@Code {} = return x+walkInlineM _ x@Math {} = return x+walkInlineM _ x@RawInline {} = return x++walkBlockM :: (Walkable a [Block], Walkable a [Inline], Monad m,+ Applicative m, Functor m)+ => (a -> m a) -> Block -> m Block+walkBlockM f (Para xs) = Para <$> walkM f xs+walkBlockM f (Plain xs) = Plain <$> walkM f xs+walkBlockM f (LineBlock xs) = LineBlock <$> walkM f xs+walkBlockM f (BlockQuote xs) = BlockQuote <$> walkM f xs+walkBlockM f (OrderedList a cs) = OrderedList a <$> walkM f cs+walkBlockM f (BulletList cs) = BulletList <$> walkM f cs+walkBlockM f (DefinitionList xs) = DefinitionList <$> walkM f xs+walkBlockM f (Header lev attr xs) = Header lev attr <$> walkM f xs+walkBlockM f (Div attr bs') = Div attr <$> walkM f bs'+walkBlockM _ x@CodeBlock {} = return x+walkBlockM _ x@RawBlock {} = return x+walkBlockM _ HorizontalRule = return HorizontalRule+walkBlockM _ Null = return Null+walkBlockM f (Table capt as ws hs rs) = do capt' <- walkM f capt+ hs' <- walkM f hs+ rs' <- walkM f rs+ return $ Table capt' as ws hs' rs'++walkMetaValueM :: (Walkable a MetaValue, Walkable a [Block],+ Walkable a [Inline], Monad f, Applicative f, Functor f)+ => (a -> f a) -> MetaValue -> f MetaValue+walkMetaValueM f (MetaList xs) = MetaList <$> walkM f xs+walkMetaValueM _ (MetaBool b) = return $ MetaBool b+walkMetaValueM _ (MetaString s) = return $ MetaString s+walkMetaValueM f (MetaInlines xs) = MetaInlines <$> walkM f xs+walkMetaValueM f (MetaBlocks bs) = MetaBlocks <$> walkM f bs+walkMetaValueM f (MetaMap m) = MetaMap <$> walkM f m++queryInline :: (Walkable a Citation, Walkable a [Block],+ Walkable a [Inline], Monoid c)+ => (a -> c) -> Inline -> c+queryInline _ (Str _) = mempty+queryInline f (Emph xs) = query f xs+queryInline f (Strong xs) = query f xs+queryInline f (Strikeout xs) = query f xs+queryInline f (Subscript xs) = query f xs+queryInline f (Superscript xs)= query f xs+queryInline f (SmallCaps xs) = query f xs+queryInline f (Quoted _ xs) = query f xs+queryInline f (Cite cs xs) = query f cs <> query f xs+queryInline _ (Code _ _) = mempty+queryInline _ Space = mempty+queryInline _ SoftBreak = mempty+queryInline _ LineBreak = mempty+queryInline _ (Math _ _) = mempty+queryInline _ (RawInline _ _) = mempty+queryInline f (Link _ xs _) = query f xs+queryInline f (Image _ xs _) = query f xs+queryInline f (Note bs) = query f bs+queryInline f (Span _ xs) = query f xs++queryBlock :: (Walkable a Citation, Walkable a [Block],+ Walkable a [Inline], Monoid c)+ => (a -> c) -> Block -> c+queryBlock f (Para xs) = query f xs+queryBlock f (Plain xs) = query f xs+queryBlock f (LineBlock xs) = query f xs+queryBlock _ (CodeBlock _ _) = mempty+queryBlock _ (RawBlock _ _) = mempty+queryBlock f (BlockQuote bs) = query f bs+queryBlock f (OrderedList _ cs) = query f cs+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 rs) = query f capt <> query f hs <> query f rs+queryBlock f (Div _ bs) = query f bs+queryBlock _ Null = mempty++queryMetaValue :: (Walkable a MetaValue, Walkable a [Block],+ Walkable a [Inline], Monoid c)+ => (a -> c) -> MetaValue -> c+queryMetaValue f (MetaList xs) = query f xs+queryMetaValue _ (MetaBool _) = mempty+queryMetaValue _ (MetaString _) = mempty+queryMetaValue f (MetaInlines xs) = query f xs+queryMetaValue f (MetaBlocks bs) = query f bs+queryMetaValue f (MetaMap m) = query f m++walkCitationM :: (Walkable a [Inline], Monad m, Applicative m, Functor m)+ => (a -> m a) -> Citation -> m Citation+walkCitationM f (Citation id' pref suff mode notenum hash) = do pref' <- walkM f pref suff' <- walkM f suff return $ Citation id' pref' suff' mode notenum hash- query f (Citation _ pref suff _ _ _) =- query f pref <> query f suff++queryCitation :: (Walkable a [Inline], Monoid c)+ => (a -> c) -> Citation -> c+queryCitation f (Citation _ pref suff _ _ _) = query f pref <> query f suff++walkPandocM :: (Walkable a Meta, Walkable a [Block], Monad m,+ Applicative m, Functor m)+ => (a -> m a) -> Pandoc -> m Pandoc+walkPandocM f (Pandoc m bs) = do m' <- walkM f m+ bs' <- walkM f bs+ return $ Pandoc m' bs'++queryPandoc :: (Walkable a Meta, Walkable a [Block], Monoid c)+ => (a -> c) -> Pandoc -> c+queryPandoc f (Pandoc m bs) = query f m <> query f bs
+ benchmark/bench.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}++import Criterion.Main (bench, defaultMain, nf)+import Text.Pandoc.Definition (Pandoc, Inline (Str))+import Text.Pandoc.Walk (walk)+import Text.Pandoc.Builder++main :: IO ()+main = do+ defaultMain [+ bench "simple walk" $ nf (walk prependZeroWidthSpace) mydoc+ , bench "walk concatMap" $ nf (walk $ concatMap prependZeroWidthSpace') mydoc+ , bench "walk lists" $ nf (walk prependZeroWidthSpace'') mydoc+ ]++prependZeroWidthSpace :: Inline -> Inline+prependZeroWidthSpace (Str s) = Str ('\8203' : s)+prependZeroWidthSpace x = x++prependZeroWidthSpace' :: Inline -> [Inline]+prependZeroWidthSpace' (Str s) = [Str ('\8203' : s)]+prependZeroWidthSpace' x = [x]++prependZeroWidthSpace'' :: [Inline] -> [Inline]+prependZeroWidthSpace'' (Str s : xs) =+ (Str ('\8203' : s) : prependZeroWidthSpace'' xs)+prependZeroWidthSpace'' (x : xs) =+ x : prependZeroWidthSpace'' xs+prependZeroWidthSpace'' [] = []++mydoc :: Pandoc+mydoc = setTitle "My title" $ doc $+ mconcat $ replicate 50 $+ para "This is the first paragraph" <>+ para ("And " <> emph "another" <> ".") <>+ bulletList [ para "item one" <> para "continuation"+ , plain ("item two and a " <>+ link "/url" "go to url" "link")+ ]
changelog view
@@ -1,3 +1,27 @@+[1.17.2]++ * Provide default implementation for walk (Albert Krewinkel).+ The implementations for `walk` and `walkM` are very similar, so a+ default method is provided which implements the former in terms of the+ latter. This change should not affect performance, as the `Identity`+ functor, which is used in the default definition, is a newtype that+ should be eliminated at compile time. (This requires a dependency+ on transformers for ghc 7.8.x.)+ * Force optimizations when compiling Walk module (Albert Krewinkel).+ * Add `Applicative m` to the context of walkM (Albert Krewinkel).+ The acceptance of AMP makes this a natural change.+ * Add `Walkable [Block]` and `Walkable [Inline]` instances (Albert+ Krewinkel).+ * Factored out duplicate code in Walk.+ * Added benchmark.+ * Text.Pandoc.JSON: Use `walk` instead of `bottomUp` in the+ `ToJSONFilter` instance for `a -> [a]`. Note that behavior will be+ slightly different, since bottomUp's treatment of a function `[a] -> [a]`+ is to apply it to each sublist of a list, while walk applies it only to+ maximal sublists. Usually the latter behavior is what is wanted, and the+ former can be simulated when needed. But there may be existing filters+ that need to be rewritten in light of the new behavior.+ [1.17.1] * Better consistency in simpleTable and table (jgm/pandoc#3648).
pandoc-types.cabal view
@@ -1,5 +1,5 @@ Name: pandoc-types-Version: 1.17.1+Version: 1.17.2 Synopsis: Types for representing a structured document Description: @Text.Pandoc.Definition@ defines the 'Pandoc' data structure, which is used by pandoc to represent@@ -28,7 +28,7 @@ Author: John MacFarlane Maintainer: jgm@berkeley.edu Bug-Reports: https://github.com/jgm/pandoc-types/issues-Copyright: (c) 2006-2015 John MacFarlane+Copyright: (c) 2006-2017 John MacFarlane Category: Text Build-type: Simple Cabal-version: >=1.8@@ -52,11 +52,13 @@ ghc-prim >= 0.2, bytestring >= 0.9 && < 0.11, aeson >= 0.6.2 && < 1.3,+ transformers >= 0.2 && < 0.6, QuickCheck >= 2 if impl(ghc < 7.10) Build-depends: deepseq-generics >= 0.1 && < 0.2 else Build-depends: deepseq >= 1.4.1 && < 1.5+ ghc-options: -Wall test-suite test-pandoc-types type: exitcode-stdio-1.0@@ -74,4 +76,13 @@ QuickCheck >= 2.4 && < 2.11, HUnit >= 1.2 && < 1.7, string-qq == 0.0.2- ghc-options: -threaded -rtsopts -with-rtsopts=-N+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -O2++benchmark benchmark-pandoc-types+ type: exitcode-stdio-1.0+ main-is: bench.hs+ hs-source-dirs: benchmark+ build-depends: pandoc-types,+ base >= 4.2 && < 5,+ criterion >= 1.0 && < 1.3+ ghc-options: -rtsopts -Wall -fno-warn-unused-do-bind -O2
test/test-pandoc-types.hs view
@@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings, QuasiQuotes, FlexibleContexts, CPP #-} +import Text.Pandoc.Arbitrary () import Text.Pandoc.Definition import Text.Pandoc.Walk-import Text.Pandoc.Arbitrary() import Data.Generics+import Data.List (tails) import Test.HUnit (Assertion, assertEqual, assertFailure)-import Text.Pandoc.Arbitrary () import Data.Char (toUpper) import Data.Aeson (FromJSON, ToJSON, encode, decode) import Test.Framework@@ -18,35 +18,68 @@ #else import Data.Monoid #endif+import qualified Data.Monoid as Monoid p_walk :: (Typeable a, Walkable a Pandoc) => (a -> a) -> Pandoc -> Bool p_walk f d = everywhere (mkT f) d == walk f d +p_walkList :: (Typeable a, Walkable [a] Pandoc)+ => ([a] -> [a]) -> Pandoc -> Bool+p_walkList f d = everywhere (mkT f) d == walk (foldr g []) d+ where g x ys = f (x:ys)+ p_query :: (Eq a, Typeable a1, Monoid a, Walkable a1 Pandoc) => (a1 -> a) -> Pandoc -> Bool p_query f d = everything mappend (mempty `mkQ` f) d == query f d +p_queryList :: (Eq a, Typeable a1, Monoid a, Walkable [a1] Pandoc)+ => ([a1] -> a) -> Pandoc -> Bool+p_queryList f d = everything mappend (mempty `mkQ` f) d ==+ query (mconcat . map f . tails) d+ inlineTrans :: Inline -> Inline inlineTrans (Str xs) = Str $ map toUpper xs inlineTrans (Emph xs) = Strong xs inlineTrans x = x +inlinesTrans :: [Inline] -> [Inline]+inlinesTrans ys | all whitespaceInline ys = []+ where+ whitespaceInline Space = True+ whitespaceInline LineBreak = True+ whitespaceInline SoftBreak = True+ whitespaceInline (Str "") = True+ whitespaceInline _ = False+inlinesTrans ys = ys+ blockTrans :: Block -> Block blockTrans (Plain xs) = Para xs blockTrans (BlockQuote xs) = Div ("",["special"],[]) xs blockTrans x = x +blocksTrans :: [Block] -> [Block]+blocksTrans [CodeBlock {}] = []+blocksTrans [BlockQuote xs] = xs+blocksTrans [Div _ xs] = xs+blocksTrans xs = xs+ inlineQuery :: Inline -> String inlineQuery (Str xs) = xs inlineQuery _ = "" +inlinesQuery :: [Inline] -> Monoid.Sum Int+inlinesQuery = Monoid.Sum . length+ blockQuery :: Block -> [Int] blockQuery (Header lev _ _) = [lev] blockQuery _ = [] +blocksQuery :: [Block] -> Monoid.Sum Int+blocksQuery = Monoid.Sum . length + prop_roundtrip :: Pandoc -> Bool prop_roundtrip doc = case decode $ encode doc :: (Maybe Pandoc) of Just doc' -> doc == doc'@@ -337,6 +370,10 @@ , testProperty "p_walk blockTrans" (p_walk blockTrans) , testProperty "p_query inlineQuery" (p_query inlineQuery) , testProperty "p_query blockQuery" (p_query blockQuery)+ , testProperty "p_walkList inlinesTrans" (p_walkList inlinesTrans)+ , testProperty "p_queryList inlinesQuery" (p_queryList inlinesQuery)+ , testProperty "p_walkList blocksTrans" (p_walkList blocksTrans)+ , testProperty "p_queryList blocksQuery" (p_queryList blocksQuery) ] , testGroup "JSON" [ testGroup "encoding/decoding properties"