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 (XPVNode ns) = toNodeSet' ns
xPValue2XmlNodeSet _ = emptyXmlNodeSet
emptyXmlNodeSet :: XmlNodeSet
emptyXmlNodeSet = XNS False [] []
leafNodeSet :: XmlNodeSet
leafNodeSet = XNS True [] []
toNodeSet' :: NodeSet -> XmlNodeSet
toNodeSet' = pathListToNodeSet . map toPath . fromNodeSet
toPath :: NavXmlTree -> XmlNodeSet
toPath = upTree leafNodeSet
upTree :: XmlNodeSet -> NavXmlTree -> XmlNodeSet
upTree ps (NT _ _ [] _ _) = ps
upTree ps (NT (NTree n _)
ix par _left _right) = upTree ps' $ head par
where
ps' = pix n
pix (XAttr qn) = XNS False [qn] []
pix _ = XNS False [] [(ix, ps)]
pathListToNodeSet ::[XmlNodeSet] -> XmlNodeSet
pathListToNodeSet = foldr mergePaths emptyXmlNodeSet
where
mergePaths (XNS p1 al1 cl1)
(XNS p2 al2 cl2) = XNS (p1 || p2) (al1 ++ al2) (mergeSubPaths cl1 cl2)
mergeSubPaths [] sp2 = sp2
mergeSubPaths (s1:sp1) sp2 = mergeSubPath s1 (mergeSubPaths sp1 sp2)
mergeSubPath s1 [] = [s1]
mergeSubPath s1@(ix1,p1)
sl@(s2@(ix2, p2) : sl')
| ix1 < ix2 = s1 : sl
| ix1 > ix2 = s2 : mergeSubPath s1 sl'
| otherwise = (ix1, mergePaths p1 p2) : sl'