@@ -1,346 +0,0 @@
1−{-# LANGUAGE FlexibleInstances #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{- |
4− Module : Text.Pandoc.XML.Light.Cursor
5− Copyright : Copyright (C) 2007 Galois, Inc., 2021 John MacFarlane
6− License : GNU GPL, version 2 or above
7−
8− Maintainer : John MacFarlane <jgm@berkeley.edu>
9− Stability : alpha
10− Portability : portable
11−
12− This code is taken from xml-light, released under the BSD3 license.
13−-}
14−module Text.Pandoc.XML.Light.Cursor
15− ( -- * Replacement for xml-light's Text.XML.Cursor
16− Tag(..)
17− , getTag
18− , setTag
19− , fromTag
20− , Cursor(..)
21− , Path
22−
23− -- * Conversions
24− , fromContent
25− , fromElement
26− , fromForest
27− , toForest
28− , toTree
29−
30− -- * Moving around
31− , parent
32− , root
33− , getChild
34− , firstChild
35− , lastChild
36− , left
37− , right
38− , nextDF
39−
40− -- ** Searching
41− , findChild
42− , findLeft
43− , findRight
44− , findRec
45−
46− -- * Node classification
47− , isRoot
48− , isFirst
49− , isLast
50− , isLeaf
51− , isChild
52− , hasChildren
53− , getNodeIndex
54−
55− -- * Updates
56− , setContent
57− , modifyContent
58− , modifyContentM
59−
60− -- ** Inserting content
61− , insertLeft
62− , insertRight
63− , insertGoLeft
64− , insertGoRight
65−
66− -- ** Removing content
67− , removeLeft
68− , removeRight
69− , removeGoLeft
70− , removeGoRight
71− , removeGoUp
72−
73− ) where
74−
75−import Text.Pandoc.XML.Light.Types
76−import Data.Maybe(isNothing)
77−import Control.Monad(mplus)
78−
79−data Tag = Tag { tagName :: QName
80− , tagAttribs :: [Attr]
81− , tagLine :: Maybe Line
82− } deriving (Show)
83−
84−getTag :: Element -> Tag
85−getTag e = Tag { tagName = elName e
86− , tagAttribs = elAttribs e
87− , tagLine = elLine e
88− }
89−
90−setTag :: Tag -> Element -> Element
91−setTag t e = fromTag t (elContent e)
92−
93−fromTag :: Tag -> [Content] -> Element
94−fromTag t cs = Element { elName = tagName t
95− , elAttribs = tagAttribs t
96− , elLine = tagLine t
97− , elContent = cs
98− }
99−
100−type Path = [([Content],Tag,[Content])]
101−
102−-- | The position of a piece of content in an XML document.
103−data Cursor = Cur
104− { current :: Content -- ^ The currently selected content.
105− , lefts :: [Content] -- ^ Siblings on the left, closest first.
106− , rights :: [Content] -- ^ Siblings on the right, closest first.
107− , parents :: Path -- ^ The contexts of the parent elements of this location.
108− } deriving (Show)
109−
110−-- Moving around ---------------------------------------------------------------
111−
112−-- | The parent of the given location.
113−parent :: Cursor -> Maybe Cursor
114−parent loc =
115− case parents loc of
116− (pls,v,prs) : ps -> Just
117− Cur { current = Elem
118− (fromTag v
119− (combChildren (lefts loc) (current loc) (rights loc)))
120− , lefts = pls, rights = prs, parents = ps
121− }
122− [] -> Nothing
123−
124−
125−-- | The top-most parent of the given location.
126−root :: Cursor -> Cursor
127−root loc = maybe loc root (parent loc)
128−
129−-- | The left sibling of the given location.
130−left :: Cursor -> Maybe Cursor
131−left loc =
132− case lefts loc of
133− t : ts -> Just loc { current = t, lefts = ts
134− , rights = current loc : rights loc }
135− [] -> Nothing
136−
137−-- | The right sibling of the given location.
138−right :: Cursor -> Maybe Cursor
139−right loc =
140− case rights loc of
141− t : ts -> Just loc { current = t, lefts = current loc : lefts loc
142− , rights = ts }
143− [] -> Nothing
144−
145−-- | The first child of the given location.
146−firstChild :: Cursor -> Maybe Cursor
147−firstChild loc =
148− do (t : ts, ps) <- downParents loc
149− return Cur { current = t, lefts = [], rights = ts , parents = ps }
150−
151−-- | The last child of the given location.
152−lastChild :: Cursor -> Maybe Cursor
153−lastChild loc =
154− do (ts, ps) <- downParents loc
155− case reverse ts of
156− l : ls -> return Cur { current = l, lefts = ls, rights = []
157− , parents = ps }
158− [] -> Nothing
159−
160−-- | Find the next left sibling that satisfies a predicate.
161−findLeft :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
162−findLeft p loc = do loc1 <- left loc
163− if p loc1 then return loc1 else findLeft p loc1
164−
165−-- | Find the next right sibling that satisfies a predicate.
166−findRight :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
167−findRight p loc = do loc1 <- right loc
168− if p loc1 then return loc1 else findRight p loc1
169−
170−-- | The first child that satisfies a predicate.
171−findChild :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
172−findChild p loc =
173− do loc1 <- firstChild loc
174− if p loc1 then return loc1 else findRight p loc1
175−
176−-- | The next position in a left-to-right depth-first traversal of a document:
177−-- either the first child, right sibling, or the right sibling of a parent that
178−-- has one.
179−nextDF :: Cursor -> Maybe Cursor
180−nextDF c = firstChild c `mplus` up c
181− where up x = right x `mplus` (up =<< parent x)
182−
183−-- | Perform a depth first search for a descendant that satisfies the
184−-- given predicate.
185−findRec :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
186−findRec p c = if p c then Just c else findRec p =<< nextDF c
187−
188−-- | The child with the given index (starting from 0).
189−getChild :: Int -> Cursor -> Maybe Cursor
190−getChild n loc =
191− do (ts,ps) <- downParents loc
192− (ls,t,rs) <- splitChildren ts n
193− return Cur { current = t, lefts = ls, rights = rs, parents = ps }
194−
195−
196−-- | private: computes the parent for "down" operations.
197−downParents :: Cursor -> Maybe ([Content], Path)
198−downParents loc =
199− case current loc of
200− Elem e -> Just ( elContent e
201− , (lefts loc, getTag e, rights loc) : parents loc
202− )
203− _ -> Nothing
204−
205−-- Conversions -----------------------------------------------------------------
206−
207−-- | A cursor for the given content.
208−fromContent :: Content -> Cursor
209−fromContent t = Cur { current = t, lefts = [], rights = [], parents = [] }
210−
211−-- | A cursor for the given element.
212−fromElement :: Element -> Cursor
213−fromElement e = fromContent (Elem e)
214−
215−-- | The location of the first tree in a forest.
216−fromForest :: [Content] -> Maybe Cursor
217−fromForest (t:ts) = Just Cur { current = t, lefts = [], rights = ts
218− , parents = [] }
219−fromForest [] = Nothing
220−
221−-- | Computes the tree containing this location.
222−toTree :: Cursor -> Content
223−toTree loc = current (root loc)
224−
225−-- | Computes the forest containing this location.
226−toForest :: Cursor -> [Content]
227−toForest loc = let r = root loc in combChildren (lefts r) (current r) (rights r)
228−
229−
230−-- Queries ---------------------------------------------------------------------
231−
232−-- | Are we at the top of the document?
233−isRoot :: Cursor -> Bool
234−isRoot loc = null (parents loc)
235−
236−-- | Are we at the left end of the the document?
237−isFirst :: Cursor -> Bool
238−isFirst loc = null (lefts loc)
239−
240−-- | Are we at the right end of the document?
241−isLast :: Cursor -> Bool
242−isLast loc = null (rights loc)
243−
244−-- | Are we at the bottom of the document?
245−isLeaf :: Cursor -> Bool
246−isLeaf loc = isNothing (downParents loc)
247−
248−-- | Do we have a parent?
249−isChild :: Cursor -> Bool
250−isChild loc = not (isRoot loc)
251−
252−-- | Get the node index inside the sequence of children
253−getNodeIndex :: Cursor -> Int
254−getNodeIndex loc = length (lefts loc)
255−
256−-- | Do we have children?
257−hasChildren :: Cursor -> Bool
258−hasChildren loc = not (isLeaf loc)
259−
260−
261−
262−-- Updates ---------------------------------------------------------------------
263−
264−-- | Change the current content.
265−setContent :: Content -> Cursor -> Cursor
266−setContent t loc = loc { current = t }
267−
268−-- | Modify the current content.
269−modifyContent :: (Content -> Content) -> Cursor -> Cursor
270−modifyContent f loc = setContent (f (current loc)) loc
271−
272−-- | Modify the current content, allowing for an effect.
273−modifyContentM :: Monad m => (Content -> m Content) -> Cursor -> m Cursor
274−modifyContentM f loc = do x <- f (current loc)
275− return (setContent x loc)
276−
277−-- | Insert content to the left of the current position.
278−insertLeft :: Content -> Cursor -> Cursor
279−insertLeft t loc = loc { lefts = t : lefts loc }
280−
281−-- | Insert content to the right of the current position.
282−insertRight :: Content -> Cursor -> Cursor
283−insertRight t loc = loc { rights = t : rights loc }
284−
285−-- | Remove the content on the left of the current position, if any.
286−removeLeft :: Cursor -> Maybe (Content,Cursor)
287−removeLeft loc = case lefts loc of
288− l : ls -> return (l,loc { lefts = ls })
289− [] -> Nothing
290−
291−-- | Remove the content on the right of the current position, if any.
292−removeRight :: Cursor -> Maybe (Content,Cursor)
293−removeRight loc = case rights loc of
294− l : ls -> return (l,loc { rights = ls })
295− [] -> Nothing
296−
297−
298−-- | Insert content to the left of the current position.
299−-- The new content becomes the current position.
300−insertGoLeft :: Content -> Cursor -> Cursor
301−insertGoLeft t loc = loc { current = t, rights = current loc : rights loc }
302−
303−-- | Insert content to the right of the current position.
304−-- The new content becomes the current position.
305−insertGoRight :: Content -> Cursor -> Cursor
306−insertGoRight t loc = loc { current = t, lefts = current loc : lefts loc }
307−
308−-- | Remove the current element.
309−-- The new position is the one on the left.
310−removeGoLeft :: Cursor -> Maybe Cursor
311−removeGoLeft loc = case lefts loc of
312− l : ls -> Just loc { current = l, lefts = ls }
313− [] -> Nothing
314−
315−-- | Remove the current element.
316−-- The new position is the one on the right.
317−removeGoRight :: Cursor -> Maybe Cursor
318−removeGoRight loc = case rights loc of
319− l : ls -> Just loc { current = l, rights = ls }
320− [] -> Nothing
321−
322−-- | Remove the current element.
323−-- The new position is the parent of the old position.
324−removeGoUp :: Cursor -> Maybe Cursor
325−removeGoUp loc =
326− case parents loc of
327− (pls,v,prs) : ps -> Just
328− Cur { current = Elem (fromTag v (reverse (lefts loc) ++ rights loc))
329− , lefts = pls, rights = prs, parents = ps
330− }
331− [] -> Nothing
332−
333−
334−-- | private: Gets the given element of a list.
335−-- Also returns the preceding elements (reversed) and the following elements.
336−splitChildren :: [a] -> Int -> Maybe ([a],a,[a])
337−splitChildren _ n | n < 0 = Nothing
338−splitChildren cs pos = loop [] cs pos
339− where loop acc (x:xs) 0 = Just (acc,x,xs)
340− loop acc (x:xs) n = loop (x:acc) xs $! n-1
341− loop _ _ _ = Nothing
342−
343−-- | private: combChildren ls x ys = reverse ls ++ [x] ++ ys
344−combChildren :: [a] -> a -> [a] -> [a]
345−combChildren ls t rs = foldl (flip (:)) (t:rs) ls
346−