module Text.XML.HXT.XPath.XPathToNodeSet
( xPValue2XmlNodeSet
, emptyXmlNodeSet
)
where
import Text.XML.HXT.DOM.TypeDefs
import Text.XML.HXT.XPath.XPathDataTypes
xPValue2XmlNodeSet :: XPathValue -> XmlNodeSet
xPValue2XmlNodeSet :: XPathValue -> XmlNodeSet
xPValue2XmlNodeSet (XPVNode NodeSet
ns) = NodeSet -> XmlNodeSet
toNodeSet' NodeSet
ns
xPValue2XmlNodeSet XPathValue
_ = XmlNodeSet
emptyXmlNodeSet
emptyXmlNodeSet :: XmlNodeSet
emptyXmlNodeSet :: XmlNodeSet
emptyXmlNodeSet = Bool -> [QName] -> ChildNodes -> XmlNodeSet
XNS Bool
False [] []
leafNodeSet :: XmlNodeSet
leafNodeSet :: XmlNodeSet
leafNodeSet = Bool -> [QName] -> ChildNodes -> XmlNodeSet
XNS Bool
True [] []
toNodeSet' :: NodeSet -> XmlNodeSet
toNodeSet' :: NodeSet -> XmlNodeSet
toNodeSet' = [XmlNodeSet] -> XmlNodeSet
pathListToNodeSet ([XmlNodeSet] -> XmlNodeSet)
-> (NodeSet -> [XmlNodeSet]) -> NodeSet -> XmlNodeSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NavXmlTree -> XmlNodeSet) -> [NavXmlTree] -> [XmlNodeSet]
forall a b. (a -> b) -> [a] -> [b]
map NavXmlTree -> XmlNodeSet
toPath ([NavXmlTree] -> [XmlNodeSet])
-> (NodeSet -> [NavXmlTree]) -> NodeSet -> [XmlNodeSet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeSet -> [NavXmlTree]
fromNodeSet
toPath :: NavXmlTree -> XmlNodeSet
toPath :: NavXmlTree -> XmlNodeSet
toPath = XmlNodeSet -> NavXmlTree -> XmlNodeSet
upTree XmlNodeSet
leafNodeSet
upTree :: XmlNodeSet -> NavXmlTree -> XmlNodeSet
upTree :: XmlNodeSet -> NavXmlTree -> XmlNodeSet
upTree XmlNodeSet
ps (NT NTree XNode
_ Int
_ [] [NTree XNode]
_ [NTree XNode]
_) = XmlNodeSet
ps
upTree XmlNodeSet
ps (NT (NTree XNode
n [NTree XNode]
_)
Int
ix [NavXmlTree]
par [NTree XNode]
_left [NTree XNode]
_right) = XmlNodeSet -> NavXmlTree -> XmlNodeSet
upTree XmlNodeSet
ps' (NavXmlTree -> XmlNodeSet) -> NavXmlTree -> XmlNodeSet
forall a b. (a -> b) -> a -> b
$ [NavXmlTree] -> NavXmlTree
forall a. HasCallStack => [a] -> a
head [NavXmlTree]
par
where
ps' :: XmlNodeSet
ps' = XNode -> XmlNodeSet
pix XNode
n
pix :: XNode -> XmlNodeSet
pix (XAttr QName
qn) = Bool -> [QName] -> ChildNodes -> XmlNodeSet
XNS Bool
False [QName
qn] []
pix XNode
_ = Bool -> [QName] -> ChildNodes -> XmlNodeSet
XNS Bool
False [] [(Int
ix, XmlNodeSet
ps)]
pathListToNodeSet ::[XmlNodeSet] -> XmlNodeSet
pathListToNodeSet :: [XmlNodeSet] -> XmlNodeSet
pathListToNodeSet = (XmlNodeSet -> XmlNodeSet -> XmlNodeSet)
-> XmlNodeSet -> [XmlNodeSet] -> XmlNodeSet
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr XmlNodeSet -> XmlNodeSet -> XmlNodeSet
mergePaths XmlNodeSet
emptyXmlNodeSet
where
mergePaths :: XmlNodeSet -> XmlNodeSet -> XmlNodeSet
mergePaths (XNS Bool
p1 [QName]
al1 ChildNodes
cl1)
(XNS Bool
p2 [QName]
al2 ChildNodes
cl2) = Bool -> [QName] -> ChildNodes -> XmlNodeSet
XNS (Bool
p1 Bool -> Bool -> Bool
|| Bool
p2) ([QName]
al1 [QName] -> [QName] -> [QName]
forall a. [a] -> [a] -> [a]
++ [QName]
al2) (ChildNodes -> ChildNodes -> ChildNodes
mergeSubPaths ChildNodes
cl1 ChildNodes
cl2)
mergeSubPaths :: ChildNodes -> ChildNodes -> ChildNodes
mergeSubPaths [] ChildNodes
sp2 = ChildNodes
sp2
mergeSubPaths ((Int, XmlNodeSet)
s1:ChildNodes
sp1) ChildNodes
sp2 = (Int, XmlNodeSet) -> ChildNodes -> ChildNodes
mergeSubPath (Int, XmlNodeSet)
s1 (ChildNodes -> ChildNodes -> ChildNodes
mergeSubPaths ChildNodes
sp1 ChildNodes
sp2)
mergeSubPath :: (Int, XmlNodeSet) -> ChildNodes -> ChildNodes
mergeSubPath (Int, XmlNodeSet)
s1 [] = [(Int, XmlNodeSet)
s1]
mergeSubPath s1 :: (Int, XmlNodeSet)
s1@(Int
ix1,XmlNodeSet
p1)
sl :: ChildNodes
sl@(s2 :: (Int, XmlNodeSet)
s2@(Int
ix2, XmlNodeSet
p2) : ChildNodes
sl')
| Int
ix1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ix2 = (Int, XmlNodeSet)
s1 (Int, XmlNodeSet) -> ChildNodes -> ChildNodes
forall a. a -> [a] -> [a]
: ChildNodes
sl
| Int
ix1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ix2 = (Int, XmlNodeSet)
s2 (Int, XmlNodeSet) -> ChildNodes -> ChildNodes
forall a. a -> [a] -> [a]
: (Int, XmlNodeSet) -> ChildNodes -> ChildNodes
mergeSubPath (Int, XmlNodeSet)
s1 ChildNodes
sl'
| Bool
otherwise = (Int
ix1, XmlNodeSet -> XmlNodeSet -> XmlNodeSet
mergePaths XmlNodeSet
p1 XmlNodeSet
p2) (Int, XmlNodeSet) -> ChildNodes -> ChildNodes
forall a. a -> [a] -> [a]
: ChildNodes
sl'