Copyright | (c) Galois Inc. 2008 (c) Herbert Valerio Riedel 2019 |
---|---|
License | BSD-3-Clause AND GPL-3.0-or-later |
Safe Haskell | None |
Language | Haskell2010 |
XML cursors for working XML content withing the context of an XML document. This implementation is based on the general tree zipper written by Krasimir Angelov and Iavor S. Diatchki.
Synopsis
- data Tag = Tag {
- tagName :: QName
- tagAttribs :: [Attr]
- getTag :: Element -> Tag
- setTag :: Tag -> Element -> Element
- fromTag :: Tag -> [Content] -> Element
- data Cursor = Cur {}
- type Path = [([Content], Tag, [Content])]
- fromContent :: Content -> Cursor
- fromElement :: Element -> Cursor
- fromForest :: [Content] -> Maybe Cursor
- toForest :: Cursor -> [Content]
- toTree :: Cursor -> Content
- parent :: Cursor -> Maybe Cursor
- root :: Cursor -> Cursor
- getChild :: Int -> Cursor -> Maybe Cursor
- firstChild :: Cursor -> Maybe Cursor
- lastChild :: Cursor -> Maybe Cursor
- left :: Cursor -> Maybe Cursor
- right :: Cursor -> Maybe Cursor
- nextDF :: Cursor -> Maybe Cursor
- findChild :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
- findLeft :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
- findRight :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
- findRec :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
- isRoot :: Cursor -> Bool
- isFirst :: Cursor -> Bool
- isLast :: Cursor -> Bool
- isLeaf :: Cursor -> Bool
- isChild :: Cursor -> Bool
- hasChildren :: Cursor -> Bool
- getNodeIndex :: Cursor -> Int
- setContent :: Content -> Cursor -> Cursor
- modifyContent :: (Content -> Content) -> Cursor -> Cursor
- modifyContentM :: Monad m => (Content -> m Content) -> Cursor -> m Cursor
- insertLeft :: Content -> Cursor -> Cursor
- insertRight :: Content -> Cursor -> Cursor
- insertGoLeft :: Content -> Cursor -> Cursor
- insertGoRight :: Content -> Cursor -> Cursor
- removeLeft :: Cursor -> Maybe (Content, Cursor)
- removeRight :: Cursor -> Maybe (Content, Cursor)
- removeGoLeft :: Cursor -> Maybe Cursor
- removeGoRight :: Cursor -> Maybe Cursor
- removeGoUp :: Cursor -> Maybe Cursor
Documentation
Tag | |
|
Instances
Data Tag Source # | |
Defined in Text.XML.Cursor gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Tag -> c Tag # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Tag # dataTypeOf :: Tag -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Tag) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Tag) # gmapT :: (forall b. Data b => b -> b) -> Tag -> Tag # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tag -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tag -> r # gmapQ :: (forall d. Data d => d -> u) -> Tag -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Tag -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Tag -> m Tag # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Tag -> m Tag # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Tag -> m Tag # | |
Show Tag Source # | |
Generic Tag Source # | |
NFData Tag Source # | |
Defined in Text.XML.Cursor | |
type Rep Tag Source # | |
Defined in Text.XML.Cursor type Rep Tag = D1 (MetaData "Tag" "Text.XML.Cursor" "X-0.2.0.0-KR8E8xemt3kGReqajouUyg" False) (C1 (MetaCons "Tag" PrefixI True) (S1 (MetaSel (Just "tagName") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 QName) :*: S1 (MetaSel (Just "tagAttribs") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [Attr]))) |
The position of a piece of content in an XML document.
Instances
Data Cursor Source # | |
Defined in Text.XML.Cursor gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Cursor -> c Cursor # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Cursor # toConstr :: Cursor -> Constr # dataTypeOf :: Cursor -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Cursor) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cursor) # gmapT :: (forall b. Data b => b -> b) -> Cursor -> Cursor # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cursor -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cursor -> r # gmapQ :: (forall d. Data d => d -> u) -> Cursor -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Cursor -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Cursor -> m Cursor # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Cursor -> m Cursor # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Cursor -> m Cursor # | |
Show Cursor Source # | |
Generic Cursor Source # | |
NFData Cursor Source # | |
Defined in Text.XML.Cursor | |
type Rep Cursor Source # | |
Defined in Text.XML.Cursor type Rep Cursor = D1 (MetaData "Cursor" "Text.XML.Cursor" "X-0.2.0.0-KR8E8xemt3kGReqajouUyg" False) (C1 (MetaCons "Cur" PrefixI True) ((S1 (MetaSel (Just "current") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Content) :*: S1 (MetaSel (Just "lefts") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [Content])) :*: (S1 (MetaSel (Just "rights") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [Content]) :*: S1 (MetaSel (Just "parents") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Path)))) |
Conversions
fromContent :: Content -> Cursor Source #
A cursor for the given content.
fromElement :: Element -> Cursor Source #
A cursor for the given element.
Moving around
nextDF :: Cursor -> Maybe Cursor Source #
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.
Searching
findChild :: (Cursor -> Bool) -> Cursor -> Maybe Cursor Source #
The first child that satisfies a predicate.
findLeft :: (Cursor -> Bool) -> Cursor -> Maybe Cursor Source #
Find the next left sibling that satisfies a predicate.
findRight :: (Cursor -> Bool) -> Cursor -> Maybe Cursor Source #
Find the next right sibling that satisfies a predicate.
findRec :: (Cursor -> Bool) -> Cursor -> Maybe Cursor Source #
Perform a depth first search for a descendant that satisfies the given predicate.
Node classification
hasChildren :: Cursor -> Bool Source #
Do we have children?
getNodeIndex :: Cursor -> Int Source #
Get the node index inside the sequence of children
Updates
modifyContentM :: Monad m => (Content -> m Content) -> Cursor -> m Cursor Source #
Modify the current content, allowing for an effect.
Inserting content
insertLeft :: Content -> Cursor -> Cursor Source #
Insert content to the left of the current position.
insertRight :: Content -> Cursor -> Cursor Source #
Insert content to the right of the current position.
insertGoLeft :: Content -> Cursor -> Cursor Source #
Insert content to the left of the current position. The new content becomes the current position.
insertGoRight :: Content -> Cursor -> Cursor Source #
Insert content to the right of the current position. The new content becomes the current position.
Removing content
removeLeft :: Cursor -> Maybe (Content, Cursor) Source #
Remove the content on the left of the current position, if any.
removeRight :: Cursor -> Maybe (Content, Cursor) Source #
Remove the content on the right of the current position, if any.
removeGoLeft :: Cursor -> Maybe Cursor Source #
Remove the current element. The new position is the one on the left.