blob: 695c7b44e9517129d972762154d5834cf65f156d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{- |
Module : Text.Pandoc.Lua.Walk
Copyright : © 2012–2020 John MacFarlane,
© 2017-2020 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 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) Row where
walkM = walkRowM
query = queryRow
instance Walkable (SingletonsList Inline) TableHead where
walkM = walkTableHeadM
query = queryTableHead
instance Walkable (SingletonsList Inline) TableBody where
walkM = walkTableBodyM
query = queryTableBody
instance Walkable (SingletonsList Inline) TableFoot where
walkM = walkTableFootM
query = queryTableFoot
instance Walkable (SingletonsList Inline) Caption where
walkM = walkCaptionM
query = queryCaption
instance Walkable (SingletonsList Inline) Cell where
walkM = walkCellM
query = queryCell
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) Row where
walkM = walkRowM
query = queryRow
instance Walkable (SingletonsList Block) TableHead where
walkM = walkTableHeadM
query = queryTableHead
instance Walkable (SingletonsList Block) TableBody where
walkM = walkTableBodyM
query = queryTableBody
instance Walkable (SingletonsList Block) TableFoot where
walkM = walkTableFootM
query = queryTableFoot
instance Walkable (SingletonsList Block) Caption where
walkM = walkCaptionM
query = queryCaption
instance Walkable (SingletonsList Block) Cell where
walkM = walkCellM
query = queryCell
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'
|
