module Text.XML.HXT.XPath.Arrows
( getXPathTreesInDoc
, getXPathTreesInDocWithNsEnv
, getXPathTrees
, getXPathTreesWithNsEnv
, getElemNodeSet
, getElemAndAttrNodeSet
, getXPathNodeSet
, getFromNodeSet
, processXPathTrees
, processXPathTreesWithNsEnv
, processFromNodeSet
)
where
import Control.Arrow.ListArrows
import Text.XML.HXT.XPath.XPathEval ( getXPathSubTreesWithNsEnv
, getXPathNodeSetWithNsEnv'
, addRoot'
)
import Text.XML.HXT.DOM.Interface
import Text.XML.HXT.Arrow.XmlArrow
import Text.XML.HXT.Arrow.Edit ( canonicalizeForXPath )
getXPathTreesInDoc :: ArrowXml a => String -> a XmlTree XmlTree
getXPathTreesInDoc :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
getXPathTreesInDoc = Attributes -> String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
Attributes -> String -> a XmlTree XmlTree
getXPathTreesInDocWithNsEnv []
getXPathTreesInDocWithNsEnv :: ArrowXml a => Attributes -> String -> a XmlTree XmlTree
getXPathTreesInDocWithNsEnv :: forall (a :: * -> * -> *).
ArrowXml a =>
Attributes -> String -> a XmlTree XmlTree
getXPathTreesInDocWithNsEnv Attributes
env String
query = a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowList a => a XmlTree XmlTree
canonicalizeForXPath
a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(XmlTree -> [XmlTree]) -> a XmlTree XmlTree
forall b c. (b -> [c]) -> a b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL (Attributes -> String -> XmlTree -> [XmlTree]
getXPathSubTreesWithNsEnv Attributes
env String
query)
getXPathTrees :: ArrowXml a => String -> a XmlTree XmlTree
getXPathTrees :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
getXPathTrees = Attributes -> String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
Attributes -> String -> a XmlTree XmlTree
getXPathTreesWithNsEnv []
getXPathTreesWithNsEnv :: ArrowXml a => Attributes -> String -> a XmlTree XmlTree
getXPathTreesWithNsEnv :: forall (a :: * -> * -> *).
ArrowXml a =>
Attributes -> String -> a XmlTree XmlTree
getXPathTreesWithNsEnv Attributes
env String
query = (XmlTree -> [XmlTree]) -> a XmlTree XmlTree
forall b c. (b -> [c]) -> a b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL (Attributes -> String -> XmlTree -> [XmlTree]
getXPathSubTreesWithNsEnv Attributes
env String
query)
getXPathNodeSet :: ArrowXml a => String -> a XmlTree XmlNodeSet
getXPathNodeSet :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlNodeSet
getXPathNodeSet = Attributes -> String -> a XmlTree XmlNodeSet
forall (a :: * -> * -> *).
ArrowXml a =>
Attributes -> String -> a XmlTree XmlNodeSet
getXPathNodeSetWithNsEnv []
getXPathNodeSetWithNsEnv :: ArrowXml a => Attributes -> String -> a XmlTree XmlNodeSet
getXPathNodeSetWithNsEnv :: forall (a :: * -> * -> *).
ArrowXml a =>
Attributes -> String -> a XmlTree XmlNodeSet
getXPathNodeSetWithNsEnv Attributes
nsEnv String
query = (XmlTree -> XmlNodeSet) -> a XmlTree XmlNodeSet
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Attributes -> String -> XmlTree -> XmlNodeSet
getXPathNodeSetWithNsEnv' Attributes
nsEnv String
query)
getNodeSet :: ArrowXml a => a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
getNodeSet :: forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
getNodeSet a XmlTree QName
af a XmlTree XmlTree
f = ( ( a XmlTree XmlNodeSet -> a XmlTree [XmlNodeSet]
forall b c. a b c -> a b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ( a XmlTree XmlTree
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
a XmlTree XmlTree -> a XmlTree XmlNodeSet -> a XmlTree XmlNodeSet
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
getNodeSet a XmlTree QName
af a XmlTree XmlTree
f
)
a XmlTree [XmlNodeSet]
-> a [XmlNodeSet] ChildNodes -> a XmlTree ChildNodes
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
([XmlNodeSet] -> ChildNodes) -> a [XmlNodeSet] ChildNodes
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr [XmlNodeSet] -> ChildNodes
filterNodeSet
)
a XmlTree ChildNodes
-> a XmlTree ([QName], [XmlTree])
-> a XmlTree (ChildNodes, ([QName], [XmlTree]))
forall b c c'. a b c -> a b c' -> a b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
a XmlTree QName -> a XmlTree [QName]
forall b c. a b c -> a b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA a XmlTree QName
af
a XmlTree [QName]
-> a XmlTree [XmlTree] -> a XmlTree ([QName], [XmlTree])
forall b c c'. a b c -> a b c' -> a b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
a XmlTree XmlTree -> a XmlTree [XmlTree]
forall b c. a b c -> a b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA a XmlTree XmlTree
f
)
a XmlTree (ChildNodes, ([QName], [XmlTree]))
-> ((ChildNodes, ([QName], [XmlTree])) -> XmlNodeSet)
-> a XmlTree XmlNodeSet
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ (\ ~(ChildNodes
cl, ([QName]
al, [XmlTree]
n)) -> Bool -> [QName] -> ChildNodes -> XmlNodeSet
XNS (Bool -> Bool
not (Bool -> Bool) -> ([XmlTree] -> Bool) -> [XmlTree] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlTree] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([XmlTree] -> Bool) -> [XmlTree] -> Bool
forall a b. (a -> b) -> a -> b
$ [XmlTree]
n) [QName]
al ChildNodes
cl)
where
filterNodeSet :: [XmlNodeSet] -> ChildNodes
filterNodeSet :: [XmlNodeSet] -> ChildNodes
filterNodeSet = [ChildNodes] -> ChildNodes
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([ChildNodes] -> ChildNodes)
-> ([XmlNodeSet] -> [ChildNodes]) -> [XmlNodeSet] -> ChildNodes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> XmlNodeSet -> ChildNodes)
-> [Int] -> [XmlNodeSet] -> [ChildNodes]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> XmlNodeSet -> ChildNodes
filterIx [Int
0..]
filterIx :: Int -> XmlNodeSet -> ChildNodes
filterIx :: Int -> XmlNodeSet -> ChildNodes
filterIx Int
_ix (XNS Bool
False [] []) = []
filterIx Int
ix XmlNodeSet
ps = [(Int
ix, XmlNodeSet
ps)]
getElemNodeSet :: ArrowXml a => a XmlTree XmlTree -> a XmlTree XmlNodeSet
getElemNodeSet :: forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> a XmlTree XmlNodeSet
getElemNodeSet a XmlTree XmlTree
f = a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
getNodeSet a XmlTree QName
forall b c. a b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none a XmlTree XmlTree
f
getElemAndAttrNodeSet :: ArrowXml a => a XmlTree XmlTree -> a XmlTree XmlNodeSet
getElemAndAttrNodeSet :: forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> a XmlTree XmlNodeSet
getElemAndAttrNodeSet a XmlTree XmlTree
f = a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
getNodeSet ( a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
getAttrl
a XmlTree XmlTree -> a XmlTree QName -> a XmlTree QName
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
( a XmlTree XmlTree
f a XmlTree XmlTree -> a XmlTree QName -> a XmlTree QName
forall b c d. a b c -> a b d -> a b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` a XmlTree QName
forall (a :: * -> * -> *). ArrowXml a => a XmlTree QName
getAttrName )
) a XmlTree XmlTree
f
getFromNodeSet :: ArrowXml a => XmlNodeSet -> a XmlTree XmlTree
getFromNodeSet :: forall (a :: * -> * -> *).
ArrowXml a =>
XmlNodeSet -> a XmlTree XmlTree
getFromNodeSet XmlNodeSet
xns = LA XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA XmlTree XmlTree -> a XmlTree XmlTree)
-> LA XmlTree XmlTree -> a XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
(XmlTree -> XmlTree) -> LA XmlTree XmlTree
forall b c. (b -> c) -> LA b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr XmlTree -> XmlTree
addRoot' LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> XmlNodeSet -> LA XmlTree XmlTree
getFromNodeSet' XmlNodeSet
xns
getFromNodeSet' :: XmlNodeSet -> LA XmlTree XmlTree
getFromNodeSet' :: XmlNodeSet -> LA XmlTree XmlTree
getFromNodeSet' (XNS Bool
t [QName]
al ChildNodes
cl)
= LA XmlTree XmlTree -> LA XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA XmlTree XmlTree -> LA XmlTree XmlTree)
-> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
( if Bool
t then LA XmlTree XmlTree
forall b. LA b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this else LA XmlTree XmlTree
forall b c. LA b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none )
LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
( LA XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
getAttrl LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [QName] -> LA XmlTree XmlTree
getFromAttrl [QName]
al )
LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
( Int -> ChildNodes -> [XmlTree] -> LA XmlTree XmlTree
getFromChildren (Int
0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ChildNodes
cl ([XmlTree] -> LA XmlTree XmlTree)
-> LA XmlTree [XmlTree] -> LA XmlTree XmlTree
forall c b d. (c -> LA b d) -> LA b c -> LA b d
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< LA XmlTree XmlTree -> LA XmlTree [XmlTree]
forall b c. LA b c -> LA b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA LA XmlTree XmlTree
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren )
where
getFromAttrl :: [QName] -> LA XmlTree XmlTree
getFromAttrl :: [QName] -> LA XmlTree XmlTree
getFromAttrl [QName]
l
= ( [LA XmlTree XmlTree] -> LA XmlTree XmlTree
forall b c. [LA b c] -> LA b c
forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
catA ([LA XmlTree XmlTree] -> LA XmlTree XmlTree)
-> ([QName] -> [LA XmlTree XmlTree])
-> [QName]
-> LA XmlTree XmlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> LA XmlTree XmlTree) -> [QName] -> [LA XmlTree XmlTree]
forall a b. (a -> b) -> [a] -> [b]
map QName -> LA XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => QName -> a XmlTree XmlTree
hasQName ([QName] -> LA XmlTree XmlTree) -> [QName] -> LA XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$ [QName]
l)
LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall b c d. LA b c -> LA b d -> LA b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
LA XmlTree XmlTree
forall b. LA b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
getFromChildren :: Int -> ChildNodes -> XmlTrees -> LA XmlTree XmlTree
getFromChildren :: Int -> ChildNodes -> [XmlTree] -> LA XmlTree XmlTree
getFromChildren Int
_ [] [XmlTree]
_
= LA XmlTree XmlTree
forall b c. LA b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
getFromChildren Int
i' ((Int
i, XmlNodeSet
sp) : ChildNodes
sps) [XmlTree]
ts
= ( (XmlTree -> [XmlTree]) -> LA XmlTree XmlTree
forall b c. (b -> [c]) -> LA b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ([XmlTree] -> XmlTree -> [XmlTree]
forall a b. a -> b -> a
const [XmlTree]
t') LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> XmlNodeSet -> LA XmlTree XmlTree
getFromNodeSet' XmlNodeSet
sp )
LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
Int -> ChildNodes -> [XmlTree] -> LA XmlTree XmlTree
getFromChildren Int
i ChildNodes
sps [XmlTree]
ts'
where
([XmlTree]
t', [XmlTree]
ts') = Int -> [XmlTree] -> ([XmlTree], [XmlTree])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 ([XmlTree] -> ([XmlTree], [XmlTree]))
-> ([XmlTree] -> [XmlTree]) -> [XmlTree] -> ([XmlTree], [XmlTree])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [XmlTree] -> [XmlTree]
forall a. Int -> [a] -> [a]
drop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ([XmlTree] -> ([XmlTree], [XmlTree]))
-> [XmlTree] -> ([XmlTree], [XmlTree])
forall a b. (a -> b) -> a -> b
$ [XmlTree]
ts
processXPathTrees :: ArrowXml a => a XmlTree XmlTree -> String -> a XmlTree XmlTree
processXPathTrees :: forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> String -> a XmlTree XmlTree
processXPathTrees a XmlTree XmlTree
f = a XmlTree XmlTree -> Attributes -> String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> Attributes -> String -> a XmlTree XmlTree
processXPathTreesWithNsEnv a XmlTree XmlTree
f []
processXPathTreesWithNsEnv :: ArrowXml a => a XmlTree XmlTree -> Attributes -> String -> a XmlTree XmlTree
processXPathTreesWithNsEnv :: forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> Attributes -> String -> a XmlTree XmlTree
processXPathTreesWithNsEnv a XmlTree XmlTree
f Attributes
nsEnv String
query
= [IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)]
-> a XmlTree XmlTree
forall b c d. [IfThen (a b c) (a b d)] -> a b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
[ a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRoot a XmlTree XmlTree
-> a XmlTree XmlTree
-> IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> a XmlTree XmlTree -> a XmlTree XmlTree
forall (t :: * -> *) b. Tree t => a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren a XmlTree XmlTree
pns
, a XmlTree XmlTree
forall b. a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this a XmlTree XmlTree
-> a XmlTree XmlTree
-> IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> a XmlTree XmlTree
pns
]
where
pns :: a XmlTree XmlTree
pns = a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet a XmlTree XmlTree
f (XmlNodeSet -> a XmlTree XmlTree)
-> a XmlTree XmlNodeSet -> a XmlTree XmlTree
forall c b d. (c -> a b d) -> a b c -> a b d
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< Attributes -> String -> a XmlTree XmlNodeSet
forall (a :: * -> * -> *).
ArrowXml a =>
Attributes -> String -> a XmlTree XmlNodeSet
getXPathNodeSetWithNsEnv Attributes
nsEnv String
query
processFromNodeSet :: ArrowXml a => a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet :: forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet a XmlTree XmlTree
f XmlNodeSet
xns = ( a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRoot
a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall b c d. a b c -> a b d -> a b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet' a XmlTree XmlTree
f XmlNodeSet
xns
)
a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
( (XmlTree -> XmlTree) -> a XmlTree XmlTree
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr XmlTree -> XmlTree
addRoot'
a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet' a XmlTree XmlTree
f XmlNodeSet
xns
a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a XmlTree XmlTree
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
)
processFromNodeSet' :: ArrowXml a => a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet' :: forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet' a XmlTree XmlTree
f (XNS Bool
t [QName]
al ChildNodes
cl)
= ( if ChildNodes -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ChildNodes
cl
then a XmlTree XmlTree
forall b. a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
else a XmlTree XmlTree -> a XmlTree XmlTree
forall (t :: * -> *) b. Tree t => a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( Int -> ChildNodes -> [XmlTree] -> a XmlTree XmlTree
forall {b}. Int -> ChildNodes -> [XmlTree] -> a b XmlTree
processC (Int
0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ChildNodes
cl ([XmlTree] -> a XmlTree XmlTree)
-> a XmlTree [XmlTree] -> a XmlTree XmlTree
forall c b d. (c -> a b d) -> a b c -> a b d
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< a XmlTree XmlTree -> a XmlTree [XmlTree]
forall b c. a b c -> a b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA a XmlTree XmlTree
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren )
)
a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
( if [QName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [QName]
al
then a XmlTree XmlTree
forall b. a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
else a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> a XmlTree XmlTree
processAttrl ([QName] -> a XmlTree XmlTree
processA [QName]
al)
)
a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
( if Bool -> Bool
not Bool
t
then a XmlTree XmlTree
forall b. a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
else a XmlTree XmlTree
f
)
where
processA :: [QName] -> a XmlTree XmlTree
processA [QName]
l
= a XmlTree XmlTree
f a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall b c. a b b -> a b c -> a b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` ( [a XmlTree XmlTree] -> a XmlTree XmlTree
forall b c. [a b c] -> a b c
forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
catA ([a XmlTree XmlTree] -> a XmlTree XmlTree)
-> ([QName] -> [a XmlTree XmlTree]) -> [QName] -> a XmlTree XmlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> a XmlTree XmlTree) -> [QName] -> [a XmlTree XmlTree]
forall a b. (a -> b) -> [a] -> [b]
map QName -> a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => QName -> a XmlTree XmlTree
hasQName ([QName] -> a XmlTree XmlTree) -> [QName] -> a XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$ [QName]
l)
processC :: Int -> ChildNodes -> [XmlTree] -> a b XmlTree
processC Int
_ [] [XmlTree]
ts
= (b -> [XmlTree]) -> a b XmlTree
forall b c. (b -> [c]) -> a b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ([XmlTree] -> b -> [XmlTree]
forall a b. a -> b -> a
const [XmlTree]
ts)
processC Int
i' ((Int
i, XmlNodeSet
sp) : ChildNodes
sps) [XmlTree]
ts
= (b -> [XmlTree]) -> a b XmlTree
forall b c. (b -> [c]) -> a b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ([XmlTree] -> b -> [XmlTree]
forall a b. a -> b -> a
const [XmlTree]
ts1)
a b XmlTree -> a b XmlTree -> a b XmlTree
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
( (b -> [XmlTree]) -> a b XmlTree
forall b c. (b -> [c]) -> a b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ([XmlTree] -> b -> [XmlTree]
forall a b. a -> b -> a
const [XmlTree]
ti) a b XmlTree -> a XmlTree XmlTree -> a b XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet' a XmlTree XmlTree
f XmlNodeSet
sp)
a b XmlTree -> a b XmlTree -> a b XmlTree
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
Int -> ChildNodes -> [XmlTree] -> a b XmlTree
processC Int
i ChildNodes
sps [XmlTree]
ts21
where
([XmlTree]
ts1, [XmlTree]
ts2) = Int -> [XmlTree] -> ([XmlTree], [XmlTree])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [XmlTree]
ts
([XmlTree]
ti, [XmlTree]
ts21) = Int -> [XmlTree] -> ([XmlTree], [XmlTree])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [XmlTree]
ts2