Lua: add module for AST element sequence traversal

Lua filters must be able to traverse sequences of AST elements and to
replace elements by splicing sequences back in their place. Special
`Walkable` instances can be used for this; those are provided in a new
module `Text.Pandoc.Lua.Walk`.

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

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,

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'

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