packages feed

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 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"