@@ -0,0 +1,112 @@
1+{-# LANGUAGE DeriveTraversable #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE NoImplicitPrelude #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
6+{- |
7+Module : Text.Pandoc.Lua.Walk
8+Copyright : © 2012–2019 John MacFarlane,
9+ © 2017-2019 Albert Krewinkel
10+License : GNU GPL, version 2 or above
11+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
12+Stability : alpha
13+
14+Walking documents in a filter-suitable way.
15+-}
16+module Text.Pandoc.Lua.Walk
17+ ( SingletonsList (..)
18+ )
19+where
20+
21+import Prelude
22+import Control.Monad ((<=<))
23+import Text.Pandoc.Definition
24+import Text.Pandoc.Walk
25+
26+-- | Helper type which allows to traverse trees in order, while splicing in
27+-- trees.
28+--
29+-- The only interesting use of this type is via it's '@Walkable@' instance. That
30+-- instance makes it possible to walk a Pandoc document (or a subset thereof),
31+-- while applying a function on each element of an AST element /list/, and have
32+-- the resulting list spliced back in place of the original element. This is the
33+-- traversal/splicing method used for Lua filters.
34+newtype SingletonsList a = SingletonsList { singletonsList :: [a] }
35+ deriving (Functor, Foldable, Traversable)
36+
37+--
38+-- SingletonsList Inline
39+--
40+instance {-# OVERLAPPING #-} Walkable (SingletonsList Inline) [Inline] where
41+ walkM = walkSingletonsListM
42+ query = querySingletonsList
43+
44+instance Walkable (SingletonsList Inline) Pandoc where
45+ walkM = walkPandocM
46+ query = queryPandoc
47+
48+instance Walkable (SingletonsList Inline) Citation where
49+ walkM = walkCitationM
50+ query = queryCitation
51+
52+instance Walkable (SingletonsList Inline) Inline where
53+ walkM = walkInlineM
54+ query = queryInline
55+
56+instance Walkable (SingletonsList Inline) Block where
57+ walkM = walkBlockM
58+ query = queryBlock
59+
60+instance Walkable (SingletonsList Inline) MetaValue where
61+ walkM = walkMetaValueM
62+ query = queryMetaValue
63+
64+instance Walkable (SingletonsList Inline) Meta where
65+ walkM f (Meta metamap) = Meta <$> walkM f metamap
66+ query f (Meta metamap) = query f metamap
67+
68+--
69+-- SingletonsList Block
70+--
71+instance {-# OVERLAPPING #-} Walkable (SingletonsList Block) [Block] where
72+ walkM = walkSingletonsListM
73+ query = querySingletonsList
74+
75+instance Walkable (SingletonsList Block) Pandoc where
76+ walkM = walkPandocM
77+ query = queryPandoc
78+
79+instance Walkable (SingletonsList Block) Citation where
80+ walkM = walkCitationM
81+ query = queryCitation
82+
83+instance Walkable (SingletonsList Block) Inline where
84+ walkM = walkInlineM
85+ query = queryInline
86+
87+instance Walkable (SingletonsList Block) Block where
88+ walkM = walkBlockM
89+ query = queryBlock
90+
91+instance Walkable (SingletonsList Block) MetaValue where
92+ walkM = walkMetaValueM
93+ query = queryMetaValue
94+
95+instance Walkable (SingletonsList Block) Meta where
96+ walkM f (Meta metamap) = Meta <$> walkM f metamap
97+ query f (Meta metamap) = query f metamap
98+
99+
100+walkSingletonsListM :: (Monad m, Walkable (SingletonsList a) a)
101+ => (SingletonsList a -> m (SingletonsList a))
102+ -> [a] -> m [a]
103+walkSingletonsListM f =
104+ let f' = fmap singletonsList . f . SingletonsList . (:[]) <=< walkM f
105+ in fmap mconcat . mapM f'
106+
107+querySingletonsList :: (Monoid c, Walkable (SingletonsList a) a)
108+ => (SingletonsList a -> c)
109+ -> [a] -> c
110+querySingletonsList f =
111+ let f' x = f (SingletonsList [x]) `mappend` query f x
112+ in mconcat . map f'