------------------------------------------------------------------------------
-- | A zipper for navigating and modifying XML trees.  This is nearly the
-- same exposed interface as the @xml@ package in @Text.XML.Light.Cursor@,
-- with modifications as needed to adapt to different types.
module Text.XmlHtml.Cursor (
    -- * Cursor type
    Cursor,

    -- * Conversion to and from cursors
    fromNode,
    fromNodes,
    topNode,
    topNodes,
    current,
    siblings,

    -- * Cursor navigation
    parent,
    root,
    getChild,
    firstChild,
    lastChild,
    left,
    right,
    nextDF,

    -- * Search
    findChild,
    findLeft,
    findRight,
    findRec,

    -- * Node classification
    isRoot,
    isFirst,
    isLast,
    isLeaf,
    isChild,
    hasChildren,
    getNodeIndex,

    -- * Updates
    setNode,
    modifyNode,
    modifyNodeM,

    -- * Insertions
    insertLeft,
    insertRight,
    insertManyLeft,
    insertManyRight,
    insertFirstChild,
    insertLastChild,
    insertManyFirstChild,
    insertManyLastChild,
    insertGoLeft,
    insertGoRight,

    -- * Deletions
    removeLeft,
    removeRight,
    removeGoLeft,
    removeGoRight,
    removeGoUp
    ) where

import           Control.Monad
import           Data.Maybe
import           Data.Text (Text)
import           Text.XmlHtml

------------------------------------------------------------------------------
-- | Just the tag of an element
type Tag = (Text, [(Text, Text)])


------------------------------------------------------------------------------
-- | Reconstructs an element from a tag and a list of its children.
fromTag :: Tag -> [Node] -> Node
fromTag :: Tag -> [Node] -> Node
fromTag (Text
t,[(Text, Text)]
a) [Node]
c = Text -> [(Text, Text)] -> [Node] -> Node
Element Text
t [(Text, Text)]
a [Node]
c


------------------------------------------------------------------------------
-- | A zipper for XML document forests.
data Cursor = Cursor {
    Cursor -> Node
current :: !Node,   -- ^ Retrieves the current node of a 'Cursor'
    Cursor -> [Node]
lefts   :: ![Node],                 -- right to left
    Cursor -> [Node]
rights  :: ![Node],                 -- left to right
    Cursor -> [([Node], Tag, [Node])]
parents :: ![([Node], Tag, [Node])] -- parent's tag and siblings
    }
    deriving (Cursor -> Cursor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cursor -> Cursor -> Bool
$c/= :: Cursor -> Cursor -> Bool
== :: Cursor -> Cursor -> Bool
$c== :: Cursor -> Cursor -> Bool
Eq)


------------------------------------------------------------------------------
-- | Builds a 'Cursor' for navigating a tree. That is, a forest with a single
-- root 'Node'.
fromNode :: Node -> Cursor
fromNode :: Node -> Cursor
fromNode Node
n = Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor Node
n [] [] []


------------------------------------------------------------------------------
-- | Builds a 'Cursor' for navigating a forest with the given list of roots.
-- The cursor is initially positioned at the left-most node.  Gives 'Nothing'
-- if the list is empty.
fromNodes :: [Node] -> Maybe Cursor
fromNodes :: [Node] -> Maybe Cursor
fromNodes (Node
n:[Node]
ns) = forall a. a -> Maybe a
Just (Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor Node
n [] [Node]
ns [])
fromNodes []     = forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Retrieves the root node containing the current cursor position.
topNode :: Cursor -> Node
topNode :: Cursor -> Node
topNode Cursor
cur  = Cursor -> Node
current (Cursor -> Cursor
root Cursor
cur)


------------------------------------------------------------------------------
-- | Retrieves the entire forest of 'Node's corresponding to a 'Cursor'.
topNodes :: Cursor -> [Node]
topNodes :: Cursor -> [Node]
topNodes Cursor
cur = Cursor -> [Node]
siblings (Cursor -> Cursor
root Cursor
cur)


------------------------------------------------------------------------------
-- | Retrieves a list of the 'Node's at the same level as the current position
-- of a cursor, including the current node.
siblings :: Cursor -> [Node]
siblings :: Cursor -> [Node]
siblings (Cursor Node
cur [Node]
ls [Node]
rs [([Node], Tag, [Node])]
_) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) (Node
curforall a. a -> [a] -> [a]
:[Node]
rs) [Node]
ls


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' to its parent in the document.
parent :: Cursor -> Maybe Cursor
parent :: Cursor -> Maybe Cursor
parent c :: Cursor
c@(Cursor Node
_ [Node]
_ [Node]
_ (([Node]
ls,Tag
t,[Node]
rs):[([Node], Tag, [Node])]
ps))
            = forall a. a -> Maybe a
Just (Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor (Tag -> [Node] -> Node
fromTag Tag
t (Cursor -> [Node]
siblings Cursor
c)) [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps)
parent Cursor
_    = forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' up through parents to reach the root level.
root :: Cursor -> Cursor
root :: Cursor -> Cursor
root = forall a. (a -> Bool) -> (a -> a) -> a -> a
until Cursor -> Bool
isRoot (forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> Maybe Cursor
parent)


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' down to the indicated child index.
getChild :: Int -> Cursor -> Maybe Cursor
getChild :: Int -> Cursor -> Maybe Cursor
getChild Int
i (Cursor Node
n [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps) =
    case Node
n of
      Element Text
t [(Text, Text)]
a [Node]
cs -> let ([Node]
lls, [Node]
rest) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [Node]
cs in
          if Int
i forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length [Node]
cs Bool -> Bool -> Bool
|| Int
i forall a. Ord a => a -> a -> Bool
< Int
0
            then forall a. Maybe a
Nothing
            else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor (forall a. [a] -> a
head [Node]
rest)
                               (forall a. [a] -> [a]
reverse [Node]
lls)
                               (forall a. [a] -> [a]
tail [Node]
rest)
                               (([Node]
ls, (Text
t,[(Text, Text)]
a), [Node]
rs)forall a. a -> [a] -> [a]
:[([Node], Tag, [Node])]
ps)
      Node
_              -> forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' down to its first child.
firstChild :: Cursor -> Maybe Cursor
firstChild :: Cursor -> Maybe Cursor
firstChild = Int -> Cursor -> Maybe Cursor
getChild Int
0


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' down to its last child.
lastChild :: Cursor -> Maybe Cursor
lastChild :: Cursor -> Maybe Cursor
lastChild (Cursor (Element Text
t [(Text, Text)]
a [Node]
c) [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Node]
c)
    = let rc :: [Node]
rc = forall a. [a] -> [a]
reverse [Node]
c
      in  forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor (forall a. [a] -> a
head [Node]
rc) (forall a. [a] -> [a]
tail [Node]
rc) [] (([Node]
ls, (Text
t,[(Text, Text)]
a), [Node]
rs)forall a. a -> [a] -> [a]
:[([Node], Tag, [Node])]
ps)
lastChild Cursor
_
    = forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Moves a 'Cursor' to its left sibling.
left :: Cursor -> Maybe Cursor
left :: Cursor -> Maybe Cursor
left (Cursor Node
c (Node
l:[Node]
ls) [Node]
rs [([Node], Tag, [Node])]
ps) = forall a. a -> Maybe a
Just (Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor Node
l [Node]
ls (Node
cforall a. a -> [a] -> [a]
:[Node]
rs) [([Node], Tag, [Node])]
ps)
left Cursor
_                       = forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Moves a 'Cursor' to its right sibling.
right :: Cursor -> Maybe Cursor
right :: Cursor -> Maybe Cursor
right (Cursor Node
c [Node]
ls (Node
r:[Node]
rs) [([Node], Tag, [Node])]
ps) = forall a. a -> Maybe a
Just (Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor Node
r (Node
cforall a. a -> [a] -> [a]
:[Node]
ls) [Node]
rs [([Node], Tag, [Node])]
ps)
right Cursor
_                       = forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Moves a 'Cursor' to the next node encountered in a depth-first search.
-- If it has children, this is equivalent to 'firstChild'.  Otherwise, if it
-- has a right sibling, then this is equivalent to 'right'.  Otherwise, the
-- cursor moves to the first right sibling of one of its parents.
nextDF :: Cursor -> Maybe Cursor
nextDF :: Cursor -> Maybe Cursor
nextDF Cursor
c = Cursor -> Maybe Cursor
firstChild Cursor
c forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Cursor -> Maybe Cursor
up Cursor
c
  where up :: Cursor -> Maybe Cursor
up Cursor
x = Cursor -> Maybe Cursor
right Cursor
x forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (Cursor -> Maybe Cursor
up forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cursor -> Maybe Cursor
parent Cursor
x)


------------------------------------------------------------------------------
-- | Repeats the given move until a 'Cursor' is obtained that matches the
-- predicate.
search :: (Cursor -> Bool)         -- ^ predicate
       -> (Cursor -> Maybe Cursor) -- ^ move
       -> Cursor                   -- ^ starting point
       -> Maybe Cursor
search :: (Cursor -> Bool)
-> (Cursor -> Maybe Cursor) -> Cursor -> Maybe Cursor
search Cursor -> Bool
p Cursor -> Maybe Cursor
move Cursor
c | Cursor -> Bool
p Cursor
c       = forall (m :: * -> *) a. Monad m => a -> m a
return Cursor
c
                | Bool
otherwise = (Cursor -> Bool)
-> (Cursor -> Maybe Cursor) -> Cursor -> Maybe Cursor
search Cursor -> Bool
p Cursor -> Maybe Cursor
move forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cursor -> Maybe Cursor
move Cursor
c


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' to the first child that matches the predicate.
findChild :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
findChild :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
findChild Cursor -> Bool
p Cursor
cur = (Cursor -> Bool)
-> (Cursor -> Maybe Cursor) -> Cursor -> Maybe Cursor
search Cursor -> Bool
p Cursor -> Maybe Cursor
right forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cursor -> Maybe Cursor
firstChild Cursor
cur


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' to the nearest left sibling that matches a
-- predicate.
findLeft :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
findLeft :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
findLeft Cursor -> Bool
p Cursor
cur = (Cursor -> Bool)
-> (Cursor -> Maybe Cursor) -> Cursor -> Maybe Cursor
search Cursor -> Bool
p Cursor -> Maybe Cursor
left forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cursor -> Maybe Cursor
left Cursor
cur


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' to the nearest right sibling that matches a
-- predicate.
findRight :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
findRight :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
findRight Cursor -> Bool
p Cursor
cur = (Cursor -> Bool)
-> (Cursor -> Maybe Cursor) -> Cursor -> Maybe Cursor
search Cursor -> Bool
p Cursor -> Maybe Cursor
right forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cursor -> Maybe Cursor
right Cursor
cur


------------------------------------------------------------------------------
-- | Does a depth-first search for a descendant matching the predicate.  This
-- can match the current cursor position.
findRec :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
findRec :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
findRec Cursor -> Bool
p = (Cursor -> Bool)
-> (Cursor -> Maybe Cursor) -> Cursor -> Maybe Cursor
search Cursor -> Bool
p Cursor -> Maybe Cursor
nextDF


------------------------------------------------------------------------------
-- | Determines if the 'Cursor' is at a root node.
isRoot :: Cursor -> Bool
isRoot :: Cursor -> Bool
isRoot Cursor
cur = forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Cursor -> [([Node], Tag, [Node])]
parents Cursor
cur)


------------------------------------------------------------------------------
-- | Determines if the 'Cursor' is at a first child.
isFirst :: Cursor -> Bool
isFirst :: Cursor -> Bool
isFirst Cursor
cur = forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Cursor -> [Node]
lefts Cursor
cur)


------------------------------------------------------------------------------
-- | Determines if the 'Cursor' is at a last child.
isLast :: Cursor -> Bool
isLast :: Cursor -> Bool
isLast Cursor
cur = forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Cursor -> [Node]
rights Cursor
cur)


------------------------------------------------------------------------------
-- | Determines if the 'Cursor' is at a leaf node.
isLeaf :: Cursor -> Bool
isLeaf :: Cursor -> Bool
isLeaf (Cursor (Element Text
_ [(Text, Text)]
_ [Node]
c) [Node]
_ [Node]
_ [([Node], Tag, [Node])]
_) = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Node]
c
isLeaf Cursor
_                              = Bool
True


------------------------------------------------------------------------------
-- | Determines if the 'Cursor' is at a child node (i.e., if it has a parent).
isChild :: Cursor -> Bool
isChild :: Cursor -> Bool
isChild = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> Bool
isRoot


------------------------------------------------------------------------------
-- | Determines if the 'Cursor' is at a non-leaf node (i.e., if it has
-- children).
hasChildren :: Cursor -> Bool
hasChildren :: Cursor -> Bool
hasChildren = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> Bool
isLeaf


------------------------------------------------------------------------------
-- | Gets the index of the 'Cursor' among its siblings.
getNodeIndex :: Cursor -> Int
getNodeIndex :: Cursor -> Int
getNodeIndex Cursor
cur = forall (t :: * -> *) a. Foldable t => t a -> Int
length (Cursor -> [Node]
lefts Cursor
cur)


------------------------------------------------------------------------------
-- | Replaces the current node.
setNode :: Node -> Cursor -> Cursor
setNode :: Node -> Cursor -> Cursor
setNode Node
n Cursor
cur = Cursor
cur { current :: Node
current = Node
n }


------------------------------------------------------------------------------
-- | Modifies the current node by applying a function.
modifyNode :: (Node -> Node) -> Cursor -> Cursor
modifyNode :: (Node -> Node) -> Cursor -> Cursor
modifyNode Node -> Node
f Cursor
cur = Node -> Cursor -> Cursor
setNode (Node -> Node
f (Cursor -> Node
current Cursor
cur)) Cursor
cur


------------------------------------------------------------------------------
-- | Modifies the current node by applying an action in some functor.
modifyNodeM :: Functor m => (Node -> m Node) -> Cursor -> m Cursor
modifyNodeM :: forall (m :: * -> *).
Functor m =>
(Node -> m Node) -> Cursor -> m Cursor
modifyNodeM Node -> m Node
f Cursor
cur = forall a b c. (a -> b -> c) -> b -> a -> c
flip Node -> Cursor -> Cursor
setNode Cursor
cur forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Node -> m Node
f (Cursor -> Node
current Cursor
cur)


------------------------------------------------------------------------------
-- | Inserts a new 'Node' to the left of the current position.
insertLeft :: Node -> Cursor -> Cursor
insertLeft :: Node -> Cursor -> Cursor
insertLeft Node
n (Cursor Node
nn [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps) = Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor Node
nn (Node
nforall a. a -> [a] -> [a]
:[Node]
ls) [Node]
rs [([Node], Tag, [Node])]
ps


------------------------------------------------------------------------------
-- | Inserts a new 'Node' to the right of the current position.
insertRight :: Node -> Cursor -> Cursor
insertRight :: Node -> Cursor -> Cursor
insertRight Node
n (Cursor Node
nn [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps) = Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor Node
nn [Node]
ls (Node
nforall a. a -> [a] -> [a]
:[Node]
rs) [([Node], Tag, [Node])]
ps


------------------------------------------------------------------------------
-- | Inserts a list of new 'Node's to the left of the current position.
insertManyLeft :: [Node] -> Cursor -> Cursor
insertManyLeft :: [Node] -> Cursor -> Cursor
insertManyLeft [Node]
ns (Cursor Node
nn [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps) = Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor Node
nn (forall a. [a] -> [a]
reverse [Node]
ns forall a. [a] -> [a] -> [a]
++ [Node]
ls) [Node]
rs [([Node], Tag, [Node])]
ps


------------------------------------------------------------------------------
-- | Inserts a list of new 'Node's to the right of the current position.
insertManyRight :: [Node] -> Cursor -> Cursor
insertManyRight :: [Node] -> Cursor -> Cursor
insertManyRight [Node]
ns (Cursor Node
nn [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps) = Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor Node
nn [Node]
ls ([Node]
ns forall a. [a] -> [a] -> [a]
++ [Node]
rs) [([Node], Tag, [Node])]
ps


------------------------------------------------------------------------------
-- | Inserts a 'Node' as the first child of the current element.
insertFirstChild :: Node -> Cursor -> Maybe Cursor
insertFirstChild :: Node -> Cursor -> Maybe Cursor
insertFirstChild Node
n (Cursor (Element Text
t [(Text, Text)]
a [Node]
c) [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps)
    = forall a. a -> Maybe a
Just (Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor (Text -> [(Text, Text)] -> [Node] -> Node
Element Text
t [(Text, Text)]
a (Node
nforall a. a -> [a] -> [a]
:[Node]
c)) [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps)
insertFirstChild Node
_ Cursor
_
    = forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Inserts a 'Node' as the last child of the current element.
insertLastChild :: Node -> Cursor -> Maybe Cursor
insertLastChild :: Node -> Cursor -> Maybe Cursor
insertLastChild Node
n (Cursor (Element Text
t [(Text, Text)]
a [Node]
c) [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps)
    = forall a. a -> Maybe a
Just (Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor (Text -> [(Text, Text)] -> [Node] -> Node
Element Text
t [(Text, Text)]
a ([Node]
c forall a. [a] -> [a] -> [a]
++ [Node
n])) [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps)
insertLastChild Node
_ Cursor
_
    = forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Inserts a list of 'Node's as the first children of the current element.
insertManyFirstChild :: [Node] -> Cursor -> Maybe Cursor
insertManyFirstChild :: [Node] -> Cursor -> Maybe Cursor
insertManyFirstChild [Node]
ns (Cursor (Element Text
t [(Text, Text)]
a [Node]
c) [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps)
    = forall a. a -> Maybe a
Just (Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor (Text -> [(Text, Text)] -> [Node] -> Node
Element Text
t [(Text, Text)]
a ([Node]
ns forall a. [a] -> [a] -> [a]
++ [Node]
c)) [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps)
insertManyFirstChild [Node]
_ Cursor
_
    = forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Inserts a list of 'Node's as the last children of the current element.
insertManyLastChild :: [Node] -> Cursor -> Maybe Cursor
insertManyLastChild :: [Node] -> Cursor -> Maybe Cursor
insertManyLastChild [Node]
ns (Cursor (Element Text
t [(Text, Text)]
a [Node]
c) [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps)
    = forall a. a -> Maybe a
Just (Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor (Text -> [(Text, Text)] -> [Node] -> Node
Element Text
t [(Text, Text)]
a ([Node]
c forall a. [a] -> [a] -> [a]
++ [Node]
ns)) [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps)
insertManyLastChild [Node]
_ Cursor
_
    = forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Inserts a new 'Node' to the left of the current position, and moves
-- left to the new node.
insertGoLeft :: Node -> Cursor -> Cursor
insertGoLeft :: Node -> Cursor -> Cursor
insertGoLeft Node
n (Cursor Node
nn [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps) = Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor Node
n [Node]
ls (Node
nnforall a. a -> [a] -> [a]
:[Node]
rs) [([Node], Tag, [Node])]
ps


------------------------------------------------------------------------------
-- | Inserts a new 'Node' to the right of the current position, and moves
-- right to the new node.
insertGoRight :: Node -> Cursor -> Cursor
insertGoRight :: Node -> Cursor -> Cursor
insertGoRight Node
n (Cursor Node
nn [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps) = Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor Node
n (Node
nnforall a. a -> [a] -> [a]
:[Node]
ls) [Node]
rs [([Node], Tag, [Node])]
ps


------------------------------------------------------------------------------
-- | Removes the 'Node' to the left of the current position, if any.
removeLeft :: Cursor -> Maybe (Node, Cursor)
removeLeft :: Cursor -> Maybe (Node, Cursor)
removeLeft (Cursor Node
n (Node
l:[Node]
ls) [Node]
rs [([Node], Tag, [Node])]
ps) = forall a. a -> Maybe a
Just (Node
l, Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor Node
n [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps)
removeLeft Cursor
_                       = forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Removes the 'Node' to the right of the current position, if any.
removeRight :: Cursor -> Maybe (Node, Cursor)
removeRight :: Cursor -> Maybe (Node, Cursor)
removeRight (Cursor Node
n [Node]
ls (Node
r:[Node]
rs) [([Node], Tag, [Node])]
ps) = forall a. a -> Maybe a
Just (Node
r, Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor Node
n [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps)
removeRight Cursor
_                       = forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Removes the current 'Node', and moves the Cursor to its left sibling,
-- if any.
removeGoLeft :: Cursor -> Maybe Cursor
removeGoLeft :: Cursor -> Maybe Cursor
removeGoLeft (Cursor Node
_ (Node
l:[Node]
ls) [Node]
rs [([Node], Tag, [Node])]
ps) = forall a. a -> Maybe a
Just (Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor Node
l [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps)
removeGoLeft Cursor
_                       = forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Removes the current 'Node', and moves the Cursor to its right sibling,
-- if any.
removeGoRight :: Cursor -> Maybe Cursor
removeGoRight :: Cursor -> Maybe Cursor
removeGoRight (Cursor Node
_ [Node]
ls (Node
r:[Node]
rs) [([Node], Tag, [Node])]
ps) = forall a. a -> Maybe a
Just (Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor Node
r [Node]
ls [Node]
rs [([Node], Tag, [Node])]
ps)
removeGoRight Cursor
_                       = forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Removes the current 'Node', and moves the Cursor to its parent, if any.
removeGoUp :: Cursor -> Maybe Cursor
removeGoUp :: Cursor -> Maybe Cursor
removeGoUp (Cursor Node
_ [Node]
ls [Node]
rs (([Node]
lls, (Text
t,[(Text, Text)]
a), [Node]
rrs):[([Node], Tag, [Node])]
ps))
    = forall a. a -> Maybe a
Just (Node -> [Node] -> [Node] -> [([Node], Tag, [Node])] -> Cursor
Cursor (Text -> [(Text, Text)] -> [Node] -> Node
Element Text
t [(Text, Text)]
a [Node]
children) [Node]
lls [Node]
rrs [([Node], Tag, [Node])]
ps)
  where
    children :: [Node]
children = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) ([Node]
rs) [Node]
ls
removeGoUp Cursor
_                       = forall a. Maybe a
Nothing