module Text.XML.HXT.XPath.XPathToNodeSet
( xPValue2NodeSet
, emptyNodeSet
)
where
import Text.XML.HXT.DOM.TypeDefs
import Text.XML.HXT.XPath.XPathDataTypes
import Data.Maybe
xPValue2NodeSet :: XPathValue -> XmlNodeSet
xPValue2NodeSet (XPVNode ns)
= toNodeSet ns
xPValue2NodeSet _
= emptyNodeSet
emptyNodeSet :: XmlNodeSet
emptyNodeSet = XNS False [] []
leafNodeSet :: XmlNodeSet
leafNodeSet = XNS True [] []
toNodeSet :: NodeSet -> XmlNodeSet
toNodeSet
= pathListToNodeSet . map toPath
toPath :: NavXmlTree -> XmlNodeSet
toPath
= upTree leafNodeSet
upTree :: XmlNodeSet -> NavXmlTree -> XmlNodeSet
upTree ps t@(NT (NTree n _) _par left _right)
= up (upNT t)
where
up (Just pt)
| isJust . upNT $ pt
= upTree (pix n) pt
| otherwise
= ps
up Nothing
= ps
pix (XAttr qn) = XNS False [qn] []
pix _ = XNS False [] [(length left, ps)]
pathListToNodeSet ::[XmlNodeSet] -> XmlNodeSet
pathListToNodeSet
= foldr mergePaths emptyNodeSet
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'