From 80a1d5c9b60b676ba7b7e6ed0267197c8f0ec459 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 16 Feb 2021 19:18:01 -0800 Subject: Revert "Add T.P.XML.Light.Cursor." This reverts commit d8fc4971868104274881570ce9bc3d9edf0d2506. --- src/Text/Pandoc/XML/Light/Cursor.hs | 346 ------------------------------------ 1 file changed, 346 deletions(-) delete mode 100644 src/Text/Pandoc/XML/Light/Cursor.hs (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/XML/Light/Cursor.hs b/src/Text/Pandoc/XML/Light/Cursor.hs deleted file mode 100644 index 2e6da5346..000000000 --- a/src/Text/Pandoc/XML/Light/Cursor.hs +++ /dev/null @@ -1,346 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{- | - Module : Text.Pandoc.XML.Light.Cursor - Copyright : Copyright (C) 2007 Galois, Inc., 2021 John MacFarlane - License : GNU GPL, version 2 or above - - Maintainer : John MacFarlane - Stability : alpha - Portability : portable - - This code is taken from xml-light, released under the BSD3 license. --} -module Text.Pandoc.XML.Light.Cursor - ( -- * Replacement for xml-light's Text.XML.Cursor - Tag(..) - , getTag - , setTag - , fromTag - , Cursor(..) - , Path - - -- * Conversions - , fromContent - , fromElement - , fromForest - , toForest - , toTree - - -- * Moving around - , parent - , root - , getChild - , firstChild - , lastChild - , left - , right - , nextDF - - -- ** Searching - , findChild - , findLeft - , findRight - , findRec - - -- * Node classification - , isRoot - , isFirst - , isLast - , isLeaf - , isChild - , hasChildren - , getNodeIndex - - -- * Updates - , setContent - , modifyContent - , modifyContentM - - -- ** Inserting content - , insertLeft - , insertRight - , insertGoLeft - , insertGoRight - - -- ** Removing content - , removeLeft - , removeRight - , removeGoLeft - , removeGoRight - , removeGoUp - - ) where - -import Text.Pandoc.XML.Light.Types -import Data.Maybe(isNothing) -import Control.Monad(mplus) - -data Tag = Tag { tagName :: QName - , tagAttribs :: [Attr] - , tagLine :: Maybe Line - } deriving (Show) - -getTag :: Element -> Tag -getTag e = Tag { tagName = elName e - , tagAttribs = elAttribs e - , tagLine = elLine e - } - -setTag :: Tag -> Element -> Element -setTag t e = fromTag t (elContent e) - -fromTag :: Tag -> [Content] -> Element -fromTag t cs = Element { elName = tagName t - , elAttribs = tagAttribs t - , elLine = tagLine t - , elContent = cs - } - -type Path = [([Content],Tag,[Content])] - --- | The position of a piece of content in an XML document. -data Cursor = Cur - { current :: Content -- ^ The currently selected content. - , lefts :: [Content] -- ^ Siblings on the left, closest first. - , rights :: [Content] -- ^ Siblings on the right, closest first. - , parents :: Path -- ^ The contexts of the parent elements of this location. - } deriving (Show) - --- Moving around --------------------------------------------------------------- - --- | The parent of the given location. -parent :: Cursor -> Maybe Cursor -parent loc = - case parents loc of - (pls,v,prs) : ps -> Just - Cur { current = Elem - (fromTag v - (combChildren (lefts loc) (current loc) (rights loc))) - , lefts = pls, rights = prs, parents = ps - } - [] -> Nothing - - --- | The top-most parent of the given location. -root :: Cursor -> Cursor -root loc = maybe loc root (parent loc) - --- | The left sibling of the given location. -left :: Cursor -> Maybe Cursor -left loc = - case lefts loc of - t : ts -> Just loc { current = t, lefts = ts - , rights = current loc : rights loc } - [] -> Nothing - --- | The right sibling of the given location. -right :: Cursor -> Maybe Cursor -right loc = - case rights loc of - t : ts -> Just loc { current = t, lefts = current loc : lefts loc - , rights = ts } - [] -> Nothing - --- | The first child of the given location. -firstChild :: Cursor -> Maybe Cursor -firstChild loc = - do (t : ts, ps) <- downParents loc - return Cur { current = t, lefts = [], rights = ts , parents = ps } - --- | The last child of the given location. -lastChild :: Cursor -> Maybe Cursor -lastChild loc = - do (ts, ps) <- downParents loc - case reverse ts of - l : ls -> return Cur { current = l, lefts = ls, rights = [] - , parents = ps } - [] -> Nothing - --- | Find the next left sibling that satisfies a predicate. -findLeft :: (Cursor -> Bool) -> Cursor -> Maybe Cursor -findLeft p loc = do loc1 <- left loc - if p loc1 then return loc1 else findLeft p loc1 - --- | Find the next right sibling that satisfies a predicate. -findRight :: (Cursor -> Bool) -> Cursor -> Maybe Cursor -findRight p loc = do loc1 <- right loc - if p loc1 then return loc1 else findRight p loc1 - --- | The first child that satisfies a predicate. -findChild :: (Cursor -> Bool) -> Cursor -> Maybe Cursor -findChild p loc = - do loc1 <- firstChild loc - if p loc1 then return loc1 else findRight p loc1 - --- | The next position in a left-to-right depth-first traversal of a document: --- either the first child, right sibling, or the right sibling of a parent that --- has one. -nextDF :: Cursor -> Maybe Cursor -nextDF c = firstChild c `mplus` up c - where up x = right x `mplus` (up =<< parent x) - --- | Perform a depth first search for a descendant that satisfies the --- given predicate. -findRec :: (Cursor -> Bool) -> Cursor -> Maybe Cursor -findRec p c = if p c then Just c else findRec p =<< nextDF c - --- | The child with the given index (starting from 0). -getChild :: Int -> Cursor -> Maybe Cursor -getChild n loc = - do (ts,ps) <- downParents loc - (ls,t,rs) <- splitChildren ts n - return Cur { current = t, lefts = ls, rights = rs, parents = ps } - - --- | private: computes the parent for "down" operations. -downParents :: Cursor -> Maybe ([Content], Path) -downParents loc = - case current loc of - Elem e -> Just ( elContent e - , (lefts loc, getTag e, rights loc) : parents loc - ) - _ -> Nothing - --- Conversions ----------------------------------------------------------------- - --- | A cursor for the given content. -fromContent :: Content -> Cursor -fromContent t = Cur { current = t, lefts = [], rights = [], parents = [] } - --- | A cursor for the given element. -fromElement :: Element -> Cursor -fromElement e = fromContent (Elem e) - --- | The location of the first tree in a forest. -fromForest :: [Content] -> Maybe Cursor -fromForest (t:ts) = Just Cur { current = t, lefts = [], rights = ts - , parents = [] } -fromForest [] = Nothing - --- | Computes the tree containing this location. -toTree :: Cursor -> Content -toTree loc = current (root loc) - --- | Computes the forest containing this location. -toForest :: Cursor -> [Content] -toForest loc = let r = root loc in combChildren (lefts r) (current r) (rights r) - - --- Queries --------------------------------------------------------------------- - --- | Are we at the top of the document? -isRoot :: Cursor -> Bool -isRoot loc = null (parents loc) - --- | Are we at the left end of the the document? -isFirst :: Cursor -> Bool -isFirst loc = null (lefts loc) - --- | Are we at the right end of the document? -isLast :: Cursor -> Bool -isLast loc = null (rights loc) - --- | Are we at the bottom of the document? -isLeaf :: Cursor -> Bool -isLeaf loc = isNothing (downParents loc) - --- | Do we have a parent? -isChild :: Cursor -> Bool -isChild loc = not (isRoot loc) - --- | Get the node index inside the sequence of children -getNodeIndex :: Cursor -> Int -getNodeIndex loc = length (lefts loc) - --- | Do we have children? -hasChildren :: Cursor -> Bool -hasChildren loc = not (isLeaf loc) - - - --- Updates --------------------------------------------------------------------- - --- | Change the current content. -setContent :: Content -> Cursor -> Cursor -setContent t loc = loc { current = t } - --- | Modify the current content. -modifyContent :: (Content -> Content) -> Cursor -> Cursor -modifyContent f loc = setContent (f (current loc)) loc - --- | Modify the current content, allowing for an effect. -modifyContentM :: Monad m => (Content -> m Content) -> Cursor -> m Cursor -modifyContentM f loc = do x <- f (current loc) - return (setContent x loc) - --- | Insert content to the left of the current position. -insertLeft :: Content -> Cursor -> Cursor -insertLeft t loc = loc { lefts = t : lefts loc } - --- | Insert content to the right of the current position. -insertRight :: Content -> Cursor -> Cursor -insertRight t loc = loc { rights = t : rights loc } - --- | Remove the content on the left of the current position, if any. -removeLeft :: Cursor -> Maybe (Content,Cursor) -removeLeft loc = case lefts loc of - l : ls -> return (l,loc { lefts = ls }) - [] -> Nothing - --- | Remove the content on the right of the current position, if any. -removeRight :: Cursor -> Maybe (Content,Cursor) -removeRight loc = case rights loc of - l : ls -> return (l,loc { rights = ls }) - [] -> Nothing - - --- | Insert content to the left of the current position. --- The new content becomes the current position. -insertGoLeft :: Content -> Cursor -> Cursor -insertGoLeft t loc = loc { current = t, rights = current loc : rights loc } - --- | Insert content to the right of the current position. --- The new content becomes the current position. -insertGoRight :: Content -> Cursor -> Cursor -insertGoRight t loc = loc { current = t, lefts = current loc : lefts loc } - --- | Remove the current element. --- The new position is the one on the left. -removeGoLeft :: Cursor -> Maybe Cursor -removeGoLeft loc = case lefts loc of - l : ls -> Just loc { current = l, lefts = ls } - [] -> Nothing - --- | Remove the current element. --- The new position is the one on the right. -removeGoRight :: Cursor -> Maybe Cursor -removeGoRight loc = case rights loc of - l : ls -> Just loc { current = l, rights = ls } - [] -> Nothing - --- | Remove the current element. --- The new position is the parent of the old position. -removeGoUp :: Cursor -> Maybe Cursor -removeGoUp loc = - case parents loc of - (pls,v,prs) : ps -> Just - Cur { current = Elem (fromTag v (reverse (lefts loc) ++ rights loc)) - , lefts = pls, rights = prs, parents = ps - } - [] -> Nothing - - --- | private: Gets the given element of a list. --- Also returns the preceding elements (reversed) and the following elements. -splitChildren :: [a] -> Int -> Maybe ([a],a,[a]) -splitChildren _ n | n < 0 = Nothing -splitChildren cs pos = loop [] cs pos - where loop acc (x:xs) 0 = Just (acc,x,xs) - loop acc (x:xs) n = loop (x:acc) xs $! n-1 - loop _ _ _ = Nothing - --- | private: combChildren ls x ys = reverse ls ++ [x] ++ ys -combChildren :: [a] -> a -> [a] -> [a] -combChildren ls t rs = foldl (flip (:)) (t:rs) ls - -- cgit v1.2.3