diff options
| -rw-r--r-- | cabal.project | 5 | ||||
| -rw-r--r-- | pandoc.cabal | 1 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Walk.hs | 112 | ||||
| -rw-r--r-- | stack.yaml | 2 |
4 files changed, 120 insertions, 0 deletions
diff --git a/cabal.project b/cabal.project index b6846aac0..55a33733f 100644 --- a/cabal.project +++ b/cabal.project @@ -12,3 +12,8 @@ source-repository-package type: git location: https://github.com/jgm/pandoc-citeproc tag: 6d62678ece91bbb4fe4f5a99695006e1d53c3bae + +source-repository-package + type: git + location: https://github.com/jgm/pandoc-types + tag: 996a61018e406aa1e333e9085e84a04c83804c34 diff --git a/pandoc.cabal b/pandoc.cabal index 6001ea04c..bc047f9a6 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -606,6 +606,7 @@ library Text.Pandoc.Lua.Module.Utils, Text.Pandoc.Lua.Packages, Text.Pandoc.Lua.Util, + Text.Pandoc.Lua.Walk, Text.Pandoc.CSS, Text.Pandoc.CSV, Text.Pandoc.RoffChar, diff --git a/src/Text/Pandoc/Lua/Walk.hs b/src/Text/Pandoc/Lua/Walk.hs new file mode 100644 index 000000000..0afe3454a --- /dev/null +++ b/src/Text/Pandoc/Lua/Walk.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{- | +Module : Text.Pandoc.Lua.Walk +Copyright : © 2012–2019 John MacFarlane, + © 2017-2019 Albert Krewinkel +License : GNU GPL, version 2 or above +Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> +Stability : alpha + +Walking documents in a filter-suitable way. +-} +module Text.Pandoc.Lua.Walk + ( SingletonsList (..) + ) +where + +import Prelude +import Control.Monad ((<=<)) +import Text.Pandoc.Definition +import Text.Pandoc.Walk + +-- | Helper type which allows to traverse trees in order, while splicing in +-- trees. +-- +-- The only interesting use of this type is via it's '@Walkable@' instance. That +-- instance makes it possible to walk a Pandoc document (or a subset thereof), +-- while applying a function on each element of an AST element /list/, and have +-- the resulting list spliced back in place of the original element. This is the +-- traversal/splicing method used for Lua filters. +newtype SingletonsList a = SingletonsList { singletonsList :: [a] } + deriving (Functor, Foldable, Traversable) + +-- +-- SingletonsList Inline +-- +instance {-# OVERLAPPING #-} Walkable (SingletonsList Inline) [Inline] where + walkM = walkSingletonsListM + query = querySingletonsList + +instance Walkable (SingletonsList Inline) Pandoc where + walkM = walkPandocM + query = queryPandoc + +instance Walkable (SingletonsList Inline) Citation where + walkM = walkCitationM + query = queryCitation + +instance Walkable (SingletonsList Inline) Inline where + walkM = walkInlineM + query = queryInline + +instance Walkable (SingletonsList Inline) Block where + walkM = walkBlockM + query = queryBlock + +instance Walkable (SingletonsList Inline) MetaValue where + walkM = walkMetaValueM + query = queryMetaValue + +instance Walkable (SingletonsList Inline) Meta where + walkM f (Meta metamap) = Meta <$> walkM f metamap + query f (Meta metamap) = query f metamap + +-- +-- SingletonsList Block +-- +instance {-# OVERLAPPING #-} Walkable (SingletonsList Block) [Block] where + walkM = walkSingletonsListM + query = querySingletonsList + +instance Walkable (SingletonsList Block) Pandoc where + walkM = walkPandocM + query = queryPandoc + +instance Walkable (SingletonsList Block) Citation where + walkM = walkCitationM + query = queryCitation + +instance Walkable (SingletonsList Block) Inline where + walkM = walkInlineM + query = queryInline + +instance Walkable (SingletonsList Block) Block where + walkM = walkBlockM + query = queryBlock + +instance Walkable (SingletonsList Block) MetaValue where + walkM = walkMetaValueM + query = queryMetaValue + +instance Walkable (SingletonsList Block) Meta where + walkM f (Meta metamap) = Meta <$> walkM f metamap + query f (Meta metamap) = query f metamap + + +walkSingletonsListM :: (Monad m, Walkable (SingletonsList a) a) + => (SingletonsList a -> m (SingletonsList a)) + -> [a] -> m [a] +walkSingletonsListM f = + let f' = fmap singletonsList . f . SingletonsList . (:[]) <=< walkM f + in fmap mconcat . mapM f' + +querySingletonsList :: (Monoid c, Walkable (SingletonsList a) a) + => (SingletonsList a -> c) + -> [a] -> c +querySingletonsList f = + let f' x = f (SingletonsList [x]) `mappend` query f x + in mconcat . map f' diff --git a/stack.yaml b/stack.yaml index bd9a9396e..f78f24e2b 100644 --- a/stack.yaml +++ b/stack.yaml @@ -14,6 +14,8 @@ extra-deps: # - pandoc-citeproc-0.16.2 - git: https://github.com/jgm/pandoc-citeproc commit: 6d62678ece91bbb4fe4f5a99695006e1d53c3bae +- git: https://github.com/tarleb/pandoc-types + commit: a087b0174a597b92c5fec4d633c46887c188b496 - ipynb-0.1 - cmark-gfm-0.2.0 - hslua-1.0.3.1 |