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

{- |
   Module     : Text.XML.HXT.XPath.Arrows
   Copyright  : Copyright (C) 2006-infinity Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : experimental
   Portability: portable

   Most of the XPath arrows come in two versions,
   one without dealing with namespaces, element and attribute names
   in XPath expressions are taken as they ar ignoring any prefix:localname structure.

   The second variant uses a namespace environment for associating the right
   namespace for the appropriate prefix. An entry for the empty prefix
   defines the default namespace for the expression.

   The second variant should be used, when in the application namespaces
   are significant, that means when namespace propagation is done for
   the documents to be processed.

   The XPath evaluator computes a result, which can be a simple value
   like a string or number, or a node set. The nodes in these sets
   are identified by their position in the document tree.
   Node sets are returned as a list of XmlTrees with respect to the
   document order.

-}

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

module Text.XML.HXT.XPath.Arrows
    ( getXPathTreesInDoc
    , getXPathTreesInDocWithNsEnv
    , getXPathTrees
    , getXPathTreesWithNsEnv
    , getElemNodeSet
    , getElemAndAttrNodeSet
    , getXPathNodeSet
    , getFromNodeSet
    , processXPathTrees
    , processXPathTreesWithNsEnv
    , processFromNodeSet
    )
where

import Control.Arrow.ListArrows

import Text.XML.HXT.XPath.XPathEval     ( getXPathSubTreesWithNsEnv
                                        , getXPathNodeSetWithNsEnv'
                                        , addRoot'
                                        )
import Text.XML.HXT.DOM.Interface

import Text.XML.HXT.Arrow.XmlArrow
import Text.XML.HXT.Arrow.Edit          ( canonicalizeForXPath )

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

-- |
-- Select parts of a whole XML document with root node by a XPath expression.
--
-- The main filter for selecting parts of a document via XPath.
--
-- The string argument must be a XPath expression with an absolute location path,
-- the argument tree must be a complete document tree.
--
-- Before evaluating the xpath query, the document is canonicalized
-- with 'Text.XML.HXT.Arrow.Edit.canonicalizeForXPath'
--
-- Result is a possibly empty list of XmlTrees forming the set of selected XPath values.
-- XPath values other than XmlTrees (numbers, attributes, tagnames, ...)
-- are convertet to text nodes.

getXPathTreesInDoc                      :: ArrowXml a => String -> a XmlTree XmlTree
getXPathTreesInDoc :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
getXPathTreesInDoc                      = Attributes -> String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
Attributes -> String -> a XmlTree XmlTree
getXPathTreesInDocWithNsEnv []

-- | Same as 'getXPathTreesInDoc' but with namespace environment for the XPath names

getXPathTreesInDocWithNsEnv             :: ArrowXml a => Attributes -> String -> a XmlTree XmlTree
getXPathTreesInDocWithNsEnv :: forall (a :: * -> * -> *).
ArrowXml a =>
Attributes -> String -> a XmlTree XmlTree
getXPathTreesInDocWithNsEnv Attributes
env String
query   = a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowList a => a XmlTree XmlTree
canonicalizeForXPath
                                          a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                          (XmlTree -> [XmlTree]) -> a XmlTree XmlTree
forall b c. (b -> [c]) -> a b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL (Attributes -> String -> XmlTree -> [XmlTree]
getXPathSubTreesWithNsEnv Attributes
env String
query)

-- |
-- Select parts of an arbitrary XML tree by a XPath expression.
--
-- The main filter for selecting parts of an arbitrary XML tree via XPath.
-- The string argument must be a XPath expression with an absolute location path,
-- There are no restrictions on the argument tree.
--
-- No canonicalization is performed before evaluating the query
--
-- Result is a possibly empty list of XmlTrees forming the set of selected XPath values.
-- XPath values other than XmlTrees (numbers, attributes, tagnames, ...)
-- are convertet to text nodes.

getXPathTrees                           :: ArrowXml a => String -> a XmlTree XmlTree
getXPathTrees :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
getXPathTrees                           = Attributes -> String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
Attributes -> String -> a XmlTree XmlTree
getXPathTreesWithNsEnv []

-- | Same as 'getXPathTrees' but with namespace environment for the XPath names

getXPathTreesWithNsEnv                  :: ArrowXml a => Attributes -> String -> a XmlTree XmlTree
getXPathTreesWithNsEnv :: forall (a :: * -> * -> *).
ArrowXml a =>
Attributes -> String -> a XmlTree XmlTree
getXPathTreesWithNsEnv Attributes
env String
query        = (XmlTree -> [XmlTree]) -> a XmlTree XmlTree
forall b c. (b -> [c]) -> a b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL (Attributes -> String -> XmlTree -> [XmlTree]
getXPathSubTreesWithNsEnv Attributes
env String
query)

-- | Select a set of nodes via an XPath expression from an arbitray XML tree
--
-- The result is a set of \"pointers\" to nodes. This set can be used to
-- access or modify the values of the subnodes in subsequent calls to 'getFromNodeSet' or 'processFromNodeSet'.
--
-- This function enables for parsing an XPath expressions and traversing the tree for node selection once
-- and reuse this result possibly many times for later selection and modification operations.

getXPathNodeSet                         :: ArrowXml a => String -> a XmlTree XmlNodeSet
getXPathNodeSet :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlNodeSet
getXPathNodeSet                         = Attributes -> String -> a XmlTree XmlNodeSet
forall (a :: * -> * -> *).
ArrowXml a =>
Attributes -> String -> a XmlTree XmlNodeSet
getXPathNodeSetWithNsEnv []

-- | Same as 'getXPathNodeSet' but with namespace environment for the XPath names

getXPathNodeSetWithNsEnv                :: ArrowXml a => Attributes -> String -> a XmlTree XmlNodeSet
getXPathNodeSetWithNsEnv :: forall (a :: * -> * -> *).
ArrowXml a =>
Attributes -> String -> a XmlTree XmlNodeSet
getXPathNodeSetWithNsEnv Attributes
nsEnv String
query    = (XmlTree -> XmlNodeSet) -> a XmlTree XmlNodeSet
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Attributes -> String -> XmlTree -> XmlNodeSet
getXPathNodeSetWithNsEnv' Attributes
nsEnv String
query)

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

getNodeSet                              :: ArrowXml a => a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
getNodeSet :: forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
getNodeSet a XmlTree QName
af a XmlTree XmlTree
f                         = ( ( a XmlTree XmlNodeSet -> a XmlTree [XmlNodeSet]
forall b c. a b c -> a b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ( a XmlTree XmlTree
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                                                      a XmlTree XmlTree -> a XmlTree XmlNodeSet -> a XmlTree XmlNodeSet
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                                      a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
getNodeSet a XmlTree QName
af a XmlTree XmlTree
f
                                                    )
                                              a XmlTree [XmlNodeSet]
-> a [XmlNodeSet] ChildNodes -> a XmlTree ChildNodes
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                              ([XmlNodeSet] -> ChildNodes) -> a [XmlNodeSet] ChildNodes
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr [XmlNodeSet] -> ChildNodes
filterNodeSet
                                            )
                                            a XmlTree ChildNodes
-> a XmlTree ([QName], [XmlTree])
-> a XmlTree (ChildNodes, ([QName], [XmlTree]))
forall b c c'. a b c -> a b c' -> a b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                            a XmlTree QName -> a XmlTree [QName]
forall b c. a b c -> a b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA a XmlTree QName
af
                                            a XmlTree [QName]
-> a XmlTree [XmlTree] -> a XmlTree ([QName], [XmlTree])
forall b c c'. a b c -> a b c' -> a b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                            a XmlTree XmlTree -> a XmlTree [XmlTree]
forall b c. a b c -> a b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA a XmlTree XmlTree
f
                                          )
                                          a XmlTree (ChildNodes, ([QName], [XmlTree]))
-> ((ChildNodes, ([QName], [XmlTree])) -> XmlNodeSet)
-> a XmlTree XmlNodeSet
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ (\ ~(ChildNodes
cl, ([QName]
al, [XmlTree]
n)) -> Bool -> [QName] -> ChildNodes -> XmlNodeSet
XNS (Bool -> Bool
not (Bool -> Bool) -> ([XmlTree] -> Bool) -> [XmlTree] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlTree] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([XmlTree] -> Bool) -> [XmlTree] -> Bool
forall a b. (a -> b) -> a -> b
$ [XmlTree]
n) [QName]
al ChildNodes
cl)
    where
    filterNodeSet                       :: [XmlNodeSet] -> ChildNodes
    filterNodeSet :: [XmlNodeSet] -> ChildNodes
filterNodeSet                       = [ChildNodes] -> ChildNodes
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([ChildNodes] -> ChildNodes)
-> ([XmlNodeSet] -> [ChildNodes]) -> [XmlNodeSet] -> ChildNodes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> XmlNodeSet -> ChildNodes)
-> [Int] -> [XmlNodeSet] -> [ChildNodes]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> XmlNodeSet -> ChildNodes
filterIx [Int
0..]

    filterIx                            :: Int -> XmlNodeSet -> ChildNodes
    filterIx :: Int -> XmlNodeSet -> ChildNodes
filterIx Int
_ix (XNS Bool
False [] [])      = []
    filterIx Int
ix XmlNodeSet
ps                      = [(Int
ix, XmlNodeSet
ps)]

-- |
-- compute a node set from a tree, containing all nodes selected by the predicate arrow
--
-- computation of the set of element nodes with name \"a\" is done with
--
-- > getElemNodeSet (hasName "a")

getElemNodeSet                          :: ArrowXml a => a XmlTree XmlTree -> a XmlTree XmlNodeSet
getElemNodeSet :: forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> a XmlTree XmlNodeSet
getElemNodeSet a XmlTree XmlTree
f                        = a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
getNodeSet a XmlTree QName
forall b c. a b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none a XmlTree XmlTree
f

-- |
-- compute a node set from a tree, containing all nodes including attribute nodes
-- elected by the predicate arrow

getElemAndAttrNodeSet                   :: ArrowXml a => a XmlTree XmlTree -> a XmlTree XmlNodeSet
getElemAndAttrNodeSet :: forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> a XmlTree XmlNodeSet
getElemAndAttrNodeSet a XmlTree XmlTree
f                 = a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet
getNodeSet ( a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
getAttrl
                                                       a XmlTree XmlTree -> a XmlTree QName -> a XmlTree QName
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                                       ( a XmlTree XmlTree
f a XmlTree XmlTree -> a XmlTree QName -> a XmlTree QName
forall b c d. a b c -> a b d -> a b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` a XmlTree QName
forall (a :: * -> * -> *). ArrowXml a => a XmlTree QName
getAttrName )
                                                     ) a XmlTree XmlTree
f

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

-- |
-- select all subtrees specified by a previously computed node set
--
-- the following law holds:
--
-- > getFromNodeSet $< getElemNodeSet f == multi f

getFromNodeSet          :: ArrowXml a => XmlNodeSet -> a XmlTree XmlTree
getFromNodeSet :: forall (a :: * -> * -> *).
ArrowXml a =>
XmlNodeSet -> a XmlTree XmlTree
getFromNodeSet XmlNodeSet
xns      = LA XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA XmlTree XmlTree -> a XmlTree XmlTree)
-> LA XmlTree XmlTree -> a XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
                          (XmlTree -> XmlTree) -> LA XmlTree XmlTree
forall b c. (b -> c) -> LA b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr XmlTree -> XmlTree
addRoot' LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> XmlNodeSet -> LA XmlTree XmlTree
getFromNodeSet' XmlNodeSet
xns

getFromNodeSet'         :: XmlNodeSet -> LA XmlTree XmlTree
getFromNodeSet' :: XmlNodeSet -> LA XmlTree XmlTree
getFromNodeSet' (XNS Bool
t [QName]
al ChildNodes
cl)
    = LA XmlTree XmlTree -> LA XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA XmlTree XmlTree -> LA XmlTree XmlTree)
-> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
      ( if Bool
t then LA XmlTree XmlTree
forall b. LA b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this else LA XmlTree XmlTree
forall b c. LA b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none )
      LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
      ( LA XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
getAttrl LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [QName] -> LA XmlTree XmlTree
getFromAttrl [QName]
al )
      LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
      ( Int -> ChildNodes -> [XmlTree] -> LA XmlTree XmlTree
getFromChildren (Int
0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ChildNodes
cl ([XmlTree] -> LA XmlTree XmlTree)
-> LA XmlTree [XmlTree] -> LA XmlTree XmlTree
forall c b d. (c -> LA b d) -> LA b c -> LA b d
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< LA XmlTree XmlTree -> LA XmlTree [XmlTree]
forall b c. LA b c -> LA b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA LA XmlTree XmlTree
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren )
    where

    getFromAttrl        :: [QName] -> LA XmlTree XmlTree
    getFromAttrl :: [QName] -> LA XmlTree XmlTree
getFromAttrl [QName]
l
        = ( [LA XmlTree XmlTree] -> LA XmlTree XmlTree
forall b c. [LA b c] -> LA b c
forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
catA ([LA XmlTree XmlTree] -> LA XmlTree XmlTree)
-> ([QName] -> [LA XmlTree XmlTree])
-> [QName]
-> LA XmlTree XmlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> LA XmlTree XmlTree) -> [QName] -> [LA XmlTree XmlTree]
forall a b. (a -> b) -> [a] -> [b]
map QName -> LA XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => QName -> a XmlTree XmlTree
hasQName ([QName] -> LA XmlTree XmlTree) -> [QName] -> LA XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$ [QName]
l)
          LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall b c d. LA b c -> LA b d -> LA b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
          LA XmlTree XmlTree
forall b. LA b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this

    getFromChildren     :: Int -> ChildNodes -> XmlTrees -> LA XmlTree XmlTree
    getFromChildren :: Int -> ChildNodes -> [XmlTree] -> LA XmlTree XmlTree
getFromChildren Int
_ [] [XmlTree]
_
        = LA XmlTree XmlTree
forall b c. LA b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none

    getFromChildren Int
i' ((Int
i, XmlNodeSet
sp) : ChildNodes
sps) [XmlTree]
ts
        = ( (XmlTree -> [XmlTree]) -> LA XmlTree XmlTree
forall b c. (b -> [c]) -> LA b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ([XmlTree] -> XmlTree -> [XmlTree]
forall a b. a -> b -> a
const [XmlTree]
t') LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> XmlNodeSet -> LA XmlTree XmlTree
getFromNodeSet' XmlNodeSet
sp )
          LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
          Int -> ChildNodes -> [XmlTree] -> LA XmlTree XmlTree
getFromChildren Int
i ChildNodes
sps [XmlTree]
ts'
          where
          ([XmlTree]
t', [XmlTree]
ts') = Int -> [XmlTree] -> ([XmlTree], [XmlTree])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 ([XmlTree] -> ([XmlTree], [XmlTree]))
-> ([XmlTree] -> [XmlTree]) -> [XmlTree] -> ([XmlTree], [XmlTree])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [XmlTree] -> [XmlTree]
forall a. Int -> [a] -> [a]
drop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ([XmlTree] -> ([XmlTree], [XmlTree]))
-> [XmlTree] -> ([XmlTree], [XmlTree])
forall a b. (a -> b) -> a -> b
$ [XmlTree]
ts

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

-- |
-- process all subtrees selected by an XPath expression
--
-- the following law holds:
--
-- > processXPathTrees p xpathExpr == processFromNodeSet p $< getXPathNodeSet xpathExpr

processXPathTrees               :: ArrowXml a => a XmlTree XmlTree  -> String -> a XmlTree XmlTree
processXPathTrees :: forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> String -> a XmlTree XmlTree
processXPathTrees a XmlTree XmlTree
f             = a XmlTree XmlTree -> Attributes -> String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> Attributes -> String -> a XmlTree XmlTree
processXPathTreesWithNsEnv a XmlTree XmlTree
f []

-- | Same as 'processXPathTrees' but with namespace environment for the XPath names

processXPathTreesWithNsEnv      :: ArrowXml a => a XmlTree XmlTree  -> Attributes -> String -> a XmlTree XmlTree
processXPathTreesWithNsEnv :: forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> Attributes -> String -> a XmlTree XmlTree
processXPathTreesWithNsEnv a XmlTree XmlTree
f Attributes
nsEnv String
query
    = [IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)]
-> a XmlTree XmlTree
forall b c d. [IfThen (a b c) (a b d)] -> a b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
      [ a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRoot a XmlTree XmlTree
-> a XmlTree XmlTree
-> IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> a XmlTree XmlTree -> a XmlTree XmlTree
forall (t :: * -> *) b. Tree t => a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren a XmlTree XmlTree
pns
      , a XmlTree XmlTree
forall b. a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this   a XmlTree XmlTree
-> a XmlTree XmlTree
-> IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> a XmlTree XmlTree
pns
      ]
    where
    pns :: a XmlTree XmlTree
pns = a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet a XmlTree XmlTree
f (XmlNodeSet -> a XmlTree XmlTree)
-> a XmlTree XmlNodeSet -> a XmlTree XmlTree
forall c b d. (c -> a b d) -> a b c -> a b d
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< Attributes -> String -> a XmlTree XmlNodeSet
forall (a :: * -> * -> *).
ArrowXml a =>
Attributes -> String -> a XmlTree XmlNodeSet
getXPathNodeSetWithNsEnv Attributes
nsEnv String
query

-- ------------------------------------------------------------
-- |
-- process all subtrees specified by a previously computed node set in bottom up manner
--
-- the following law should hold:
--
-- > processFromNodeSet g $< getElemNodeSet f == processBottomUp (g `when` f)
--
-- when attributes are contained in the node set (see 'getElemAndAttrNodeSet'), these are processed
-- after the children and before the node itself
--
-- the advantage of processFromNodeSet is the separation of the selection of set of nodes to be processed (e.g. modified)
-- from the real proccessing. The selection sometimes can be done once, the processing possibly many times.

processFromNodeSet                      :: ArrowXml a => a XmlTree XmlTree  -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet :: forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet a XmlTree XmlTree
f XmlNodeSet
xns                = ( a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRoot
                                            a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall b c d. a b c -> a b d -> a b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet' a XmlTree XmlTree
f XmlNodeSet
xns
                                          )
                                          a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
                                          ( (XmlTree -> XmlTree) -> a XmlTree XmlTree
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr XmlTree -> XmlTree
addRoot'
                                            a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet' a XmlTree XmlTree
f XmlNodeSet
xns
                                            a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a XmlTree XmlTree
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                                          )


processFromNodeSet'     :: ArrowXml a => a XmlTree XmlTree  -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet' :: forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet' a XmlTree XmlTree
f (XNS Bool
t [QName]
al ChildNodes
cl)
    = ( if ChildNodes -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ChildNodes
cl
        then a XmlTree XmlTree
forall b. a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
        else a XmlTree XmlTree -> a XmlTree XmlTree
forall (t :: * -> *) b. Tree t => a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( Int -> ChildNodes -> [XmlTree] -> a XmlTree XmlTree
forall {b}. Int -> ChildNodes -> [XmlTree] -> a b XmlTree
processC (Int
0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ChildNodes
cl ([XmlTree] -> a XmlTree XmlTree)
-> a XmlTree [XmlTree] -> a XmlTree XmlTree
forall c b d. (c -> a b d) -> a b c -> a b d
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< a XmlTree XmlTree -> a XmlTree [XmlTree]
forall b c. a b c -> a b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA a XmlTree XmlTree
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren )
      )
      a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      ( if [QName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [QName]
al
        then a XmlTree XmlTree
forall b. a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
        else a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> a XmlTree XmlTree
processAttrl ([QName] -> a XmlTree XmlTree
processA [QName]
al)
      )
      a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      ( if Bool -> Bool
not Bool
t
        then a XmlTree XmlTree
forall b. a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
        else a XmlTree XmlTree
f
      )
    where

    -- processA         :: ChildNodes -> a XmlTree XmlTree
    processA :: [QName] -> a XmlTree XmlTree
processA [QName]
l
        = a XmlTree XmlTree
f a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall b c. a b b -> a b c -> a b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` ( [a XmlTree XmlTree] -> a XmlTree XmlTree
forall b c. [a b c] -> a b c
forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
catA ([a XmlTree XmlTree] -> a XmlTree XmlTree)
-> ([QName] -> [a XmlTree XmlTree]) -> [QName] -> a XmlTree XmlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> a XmlTree XmlTree) -> [QName] -> [a XmlTree XmlTree]
forall a b. (a -> b) -> [a] -> [b]
map QName -> a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => QName -> a XmlTree XmlTree
hasQName ([QName] -> a XmlTree XmlTree) -> [QName] -> a XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$ [QName]
l)

    -- processC         :: ChildNodes -> XmlTrees -> a XmlTree XmlTree
    processC :: Int -> ChildNodes -> [XmlTree] -> a b XmlTree
processC Int
_ [] [XmlTree]
ts
        = (b -> [XmlTree]) -> a b XmlTree
forall b c. (b -> [c]) -> a b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ([XmlTree] -> b -> [XmlTree]
forall a b. a -> b -> a
const [XmlTree]
ts)

    processC Int
i' ((Int
i, XmlNodeSet
sp) : ChildNodes
sps) [XmlTree]
ts
        = (b -> [XmlTree]) -> a b XmlTree
forall b c. (b -> [c]) -> a b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ([XmlTree] -> b -> [XmlTree]
forall a b. a -> b -> a
const [XmlTree]
ts1)
          a b XmlTree -> a b XmlTree -> a b XmlTree
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
          ( (b -> [XmlTree]) -> a b XmlTree
forall b c. (b -> [c]) -> a b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ([XmlTree] -> b -> [XmlTree]
forall a b. a -> b -> a
const [XmlTree]
ti) a b XmlTree -> a XmlTree XmlTree -> a b XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree
processFromNodeSet' a XmlTree XmlTree
f XmlNodeSet
sp)
          a b XmlTree -> a b XmlTree -> a b XmlTree
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
          Int -> ChildNodes -> [XmlTree] -> a b XmlTree
processC Int
i ChildNodes
sps [XmlTree]
ts21
          where
          ([XmlTree]
ts1, [XmlTree]
ts2) = Int -> [XmlTree] -> ([XmlTree], [XmlTree])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [XmlTree]
ts
          ([XmlTree]
ti, [XmlTree]
ts21) = Int -> [XmlTree] -> ([XmlTree], [XmlTree])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [XmlTree]
ts2

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