    -- |
    -- 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

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