-- |
-- Convert an XPath result set into a node set
--


module Text.XML.HXT.XPath.XPathToNodeSet
    ( xPValue2XmlNodeSet
    , emptyXmlNodeSet
    )
where

import Text.XML.HXT.DOM.TypeDefs
import Text.XML.HXT.XPath.XPathDataTypes

-- -----------------------------------------------------------------------------
-- |
-- Convert a a XPath-value into a XmlNodeSet represented by a tree structure
--
-- The XmlNodeSet can be used to traverse a tree an process all
-- marked nodes.

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    -- root node reached

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'              -- ordered insert of s1
        | Bool
otherwise                     = (Int
ix1, XmlNodeSet -> XmlNodeSet -> XmlNodeSet
mergePaths XmlNodeSet
p1 XmlNodeSet
p2) (Int, XmlNodeSet) -> ChildNodes -> ChildNodes
forall a. a -> [a] -> [a]
: ChildNodes
sl'         -- same ix merge subpaths

-- -----------------------------------------------------------------------------