aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Lua/Walk.hs112
1 files changed, 112 insertions, 0 deletions
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'