module Text.XML.HXT.XPath.NavTree
( module Text.XML.HXT.XPath.NavTree
, module Data.Tree.NTree.TypeDefs
)
where
import Data.Maybe
import Data.Tree.NTree.TypeDefs
import Text.XML.HXT.DOM.Interface ( XNode
, xmlnsNamespace
, namespaceUri
)
import Text.XML.HXT.DOM.XmlNode ( isRoot
, isElem
, getName
, getAttrl
)
data NavTree a = NT { forall a. NavTree a -> NTree a
self :: (NTree a)
, forall a. NavTree a -> Int
selfIndex :: Int
, forall a. NavTree a -> [NavTree a]
ancestors :: [NavTree a]
, forall a. NavTree a -> [NTree a]
previousSiblings :: [NTree a]
, forall a. NavTree a -> [NTree a]
followingSiblings :: [NTree a]
}
deriving (Int -> NavTree a -> ShowS
[NavTree a] -> ShowS
NavTree a -> String
(Int -> NavTree a -> ShowS)
-> (NavTree a -> String)
-> ([NavTree a] -> ShowS)
-> Show (NavTree a)
forall a. Show a => Int -> NavTree a -> ShowS
forall a. Show a => [NavTree a] -> ShowS
forall a. Show a => NavTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> NavTree a -> ShowS
showsPrec :: Int -> NavTree a -> ShowS
$cshow :: forall a. Show a => NavTree a -> String
show :: NavTree a -> String
$cshowList :: forall a. Show a => [NavTree a] -> ShowS
showList :: [NavTree a] -> ShowS
Show)
ntree :: NTree a -> NavTree a
ntree :: forall a. NTree a -> NavTree a
ntree NTree a
nd = NTree a
-> Int -> [NavTree a] -> [NTree a] -> [NTree a] -> NavTree a
forall a.
NTree a
-> Int -> [NavTree a] -> [NTree a] -> [NTree a] -> NavTree a
NT NTree a
nd (-Int
1) [] [] []
subtreeNT :: NavTree a -> NTree a
subtreeNT :: forall a. NavTree a -> NTree a
subtreeNT (NT NTree a
nd Int
_ [NavTree a]
_ [NTree a]
_ [NTree a]
_) = NTree a
nd
dataNT :: NavTree a -> a
dataNT :: forall a. NavTree a -> a
dataNT (NT (NTree a
a NTrees a
_) Int
_ [NavTree a]
_ NTrees a
_ NTrees a
_) = a
a
childrenNT :: NavTree a -> [NTree a]
childrenNT :: forall a. NavTree a -> [NTree a]
childrenNT (NT (NTree a
_ NTrees a
cs) Int
_ [NavTree a]
_ NTrees a
_ NTrees a
_)
= NTrees a
cs
indexNT :: NavTree a -> Int
indexNT :: forall a. NavTree a -> Int
indexNT (NT NTree a
_ Int
ix [NavTree a]
_ [NTree a]
_ [NTree a]
_) = Int
ix
pathNT :: NavTree a -> [Int]
pathNT :: forall a. NavTree a -> [Int]
pathNT = [Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
tail ([Int] -> [Int]) -> (NavTree a -> [Int]) -> NavTree a -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> (NavTree a -> [Int]) -> NavTree a -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NavTree a -> Int) -> [NavTree a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map NavTree a -> Int
forall a. NavTree a -> Int
selfIndex ([NavTree a] -> [Int])
-> (NavTree a -> [NavTree a]) -> NavTree a -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavTree a -> [NavTree a]
forall a. NavTree a -> [NavTree a]
ancestorOrSelfAxis
upNT
, downNT
, leftNT
, rightNT :: NavTree a -> Maybe (NavTree a)
upNT :: forall a. NavTree a -> Maybe (NavTree a)
upNT (NT NTree a
_ Int
_ (NavTree a
p:[NavTree a]
_) [NTree a]
_ [NTree a]
_) = NavTree a -> Maybe (NavTree a)
forall a. a -> Maybe a
Just NavTree a
p
upNT (NT NTree a
_ Int
_ [] [NTree a]
_ [NTree a]
_) = Maybe (NavTree a)
forall a. Maybe a
Nothing
downNT :: forall a. NavTree a -> Maybe (NavTree a)
downNT t :: NavTree a
t@(NT (NTree a
_ (NTree a
c:[NTree a]
cs)) Int
_ [NavTree a]
u [NTree a]
_ [NTree a]
_) = NavTree a -> Maybe (NavTree a)
forall a. a -> Maybe a
Just (NTree a
-> Int -> [NavTree a] -> [NTree a] -> [NTree a] -> NavTree a
forall a.
NTree a
-> Int -> [NavTree a] -> [NTree a] -> [NTree a] -> NavTree a
NT NTree a
c Int
0 (NavTree a
tNavTree a -> [NavTree a] -> [NavTree a]
forall a. a -> [a] -> [a]
:[NavTree a]
u) [] [NTree a]
cs)
downNT (NT (NTree a
_ [] ) Int
_ [NavTree a]
_ [NTree a]
_ [NTree a]
_) = Maybe (NavTree a)
forall a. Maybe a
Nothing
leftNT :: forall a. NavTree a -> Maybe (NavTree a)
leftNT (NT NTree a
s Int
ix [NavTree a]
u (NTree a
l:[NTree a]
ls) [NTree a]
r) = NavTree a -> Maybe (NavTree a)
forall a. a -> Maybe a
Just (NTree a
-> Int -> [NavTree a] -> [NTree a] -> [NTree a] -> NavTree a
forall a.
NTree a
-> Int -> [NavTree a] -> [NTree a] -> [NTree a] -> NavTree a
NT NTree a
l (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [NavTree a]
u [NTree a]
ls (NTree a
sNTree a -> [NTree a] -> [NTree a]
forall a. a -> [a] -> [a]
:[NTree a]
r))
leftNT (NT NTree a
_ Int
_ [NavTree a]
_ [] [NTree a]
_) = Maybe (NavTree a)
forall a. Maybe a
Nothing
rightNT :: forall a. NavTree a -> Maybe (NavTree a)
rightNT (NT NTree a
s Int
ix [NavTree a]
u [NTree a]
l (NTree a
r:[NTree a]
rs)) = NavTree a -> Maybe (NavTree a)
forall a. a -> Maybe a
Just (NTree a
-> Int -> [NavTree a] -> [NTree a] -> [NTree a] -> NavTree a
forall a.
NTree a
-> Int -> [NavTree a] -> [NTree a] -> [NTree a] -> NavTree a
NT NTree a
r (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [NavTree a]
u (NTree a
sNTree a -> [NTree a] -> [NTree a]
forall a. a -> [a] -> [a]
:[NTree a]
l) [NTree a]
rs)
rightNT (NT NTree a
_ Int
_ [NavTree a]
_ [NTree a]
_ [] ) = Maybe (NavTree a)
forall a. Maybe a
Nothing
preorderNT :: NavTree a -> [NavTree a]
preorderNT :: forall a. NavTree a -> [NavTree a]
preorderNT = [NavTree a] -> NavTree a -> [NavTree a]
forall {a}. [NavTree a] -> NavTree a -> [NavTree a]
visit []
where
visit :: [NavTree a] -> NavTree a -> [NavTree a]
visit [NavTree a]
k NavTree a
t = NavTree a
t NavTree a -> [NavTree a] -> [NavTree a]
forall a. a -> [a] -> [a]
: [NavTree a]
-> (NavTree a -> [NavTree a]) -> Maybe (NavTree a) -> [NavTree a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [NavTree a]
k ([NavTree a] -> NavTree a -> [NavTree a]
visit' [NavTree a]
k) (NavTree a -> Maybe (NavTree a)
forall a. NavTree a -> Maybe (NavTree a)
downNT NavTree a
t)
visit' :: [NavTree a] -> NavTree a -> [NavTree a]
visit' [NavTree a]
k NavTree a
t = [NavTree a] -> NavTree a -> [NavTree a]
visit ([NavTree a]
-> (NavTree a -> [NavTree a]) -> Maybe (NavTree a) -> [NavTree a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [NavTree a]
k ([NavTree a] -> NavTree a -> [NavTree a]
visit' [NavTree a]
k) (NavTree a -> Maybe (NavTree a)
forall a. NavTree a -> Maybe (NavTree a)
rightNT NavTree a
t)) NavTree a
t
revPreorderNT :: NavTree a -> [NavTree a]
revPreorderNT :: forall a. NavTree a -> [NavTree a]
revPreorderNT NavTree a
t = NavTree a
t NavTree a -> [NavTree a] -> [NavTree a]
forall a. a -> [a] -> [a]
: (NavTree a -> [NavTree a]) -> [NavTree a] -> [NavTree a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NavTree a -> [NavTree a]
forall a. NavTree a -> [NavTree a]
revPreorderNT ([NavTree a] -> [NavTree a]
forall a. [a] -> [a]
reverse (NavTree a -> [NavTree a]
forall a. NavTree a -> [NavTree a]
children NavTree a
t))
where
children :: NavTree a -> [NavTree a]
children = [NavTree a]
-> (NavTree a -> [NavTree a]) -> Maybe (NavTree a) -> [NavTree a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((NavTree a -> Maybe (NavTree a)) -> NavTree a -> [NavTree a]
forall a. (a -> Maybe a) -> a -> [a]
maybeStar NavTree a -> Maybe (NavTree a)
forall a. NavTree a -> Maybe (NavTree a)
rightNT) (Maybe (NavTree a) -> [NavTree a])
-> (NavTree a -> Maybe (NavTree a)) -> NavTree a -> [NavTree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavTree a -> Maybe (NavTree a)
forall a. NavTree a -> Maybe (NavTree a)
downNT
getChildrenNT :: NavTree a -> [NavTree a]
getChildrenNT :: forall a. NavTree a -> [NavTree a]
getChildrenNT NavTree a
node = [NavTree a]
-> (NavTree a -> [NavTree a]) -> Maybe (NavTree a) -> [NavTree a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NavTree a -> [NavTree a]
forall a. NavTree a -> [NavTree a]
follow (NavTree a -> Maybe (NavTree a)
forall a. NavTree a -> Maybe (NavTree a)
downNT NavTree a
node)
where
follow :: NavTree a -> [NavTree a]
follow NavTree a
n = NavTree a
n NavTree a -> [NavTree a] -> [NavTree a]
forall a. a -> [a] -> [a]
: [NavTree a]
-> (NavTree a -> [NavTree a]) -> Maybe (NavTree a) -> [NavTree a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NavTree a -> [NavTree a]
follow (NavTree a -> Maybe (NavTree a)
forall a. NavTree a -> Maybe (NavTree a)
rightNT NavTree a
n)
o' :: (b -> [c]) -> (a -> [b]) -> (a -> [c])
b -> [c]
f o' :: forall b c a. (b -> [c]) -> (a -> [b]) -> a -> [c]
`o'` a -> [b]
g = \a
x -> a -> [b]
g a
x [b] -> (b -> [c]) -> [c]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> [c]
f
maybeStar, maybePlus :: (a -> Maybe a) -> a -> [a]
maybeStar :: forall a. (a -> Maybe a) -> a -> [a]
maybeStar a -> Maybe a
f a
a = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> (a -> [a]) -> Maybe a -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((a -> Maybe a) -> a -> [a]
forall a. (a -> Maybe a) -> a -> [a]
maybeStar a -> Maybe a
f) (a -> Maybe a
f a
a)
maybePlus :: forall a. (a -> Maybe a) -> a -> [a]
maybePlus a -> Maybe a
f a
a = [a] -> (a -> [a]) -> Maybe a -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((a -> Maybe a) -> a -> [a]
forall a. (a -> Maybe a) -> a -> [a]
maybeStar a -> Maybe a
f) (a -> Maybe a
f a
a)
parentAxis :: NavTree a -> [NavTree a]
parentAxis :: forall a. NavTree a -> [NavTree a]
parentAxis = Maybe (NavTree a) -> [NavTree a]
forall a. Maybe a -> [a]
maybeToList (Maybe (NavTree a) -> [NavTree a])
-> (NavTree a -> Maybe (NavTree a)) -> NavTree a -> [NavTree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavTree a -> Maybe (NavTree a)
forall a. NavTree a -> Maybe (NavTree a)
upNT
ancestorAxis :: NavTree a -> [NavTree a]
ancestorAxis :: forall a. NavTree a -> [NavTree a]
ancestorAxis = NavTree a -> [NavTree a]
forall a. NavTree a -> [NavTree a]
ancestors
ancestorOrSelfAxis :: NavTree a -> [NavTree a]
ancestorOrSelfAxis :: forall a. NavTree a -> [NavTree a]
ancestorOrSelfAxis NavTree a
t = NavTree a
t NavTree a -> [NavTree a] -> [NavTree a]
forall a. a -> [a] -> [a]
: NavTree a -> [NavTree a]
forall a. NavTree a -> [NavTree a]
ancestors NavTree a
t
childAxis :: NavTree a -> [NavTree a]
childAxis :: forall a. NavTree a -> [NavTree a]
childAxis = [NavTree a]
-> (NavTree a -> [NavTree a]) -> Maybe (NavTree a) -> [NavTree a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((NavTree a -> Maybe (NavTree a)) -> NavTree a -> [NavTree a]
forall a. (a -> Maybe a) -> a -> [a]
maybeStar NavTree a -> Maybe (NavTree a)
forall a. NavTree a -> Maybe (NavTree a)
rightNT) (Maybe (NavTree a) -> [NavTree a])
-> (NavTree a -> Maybe (NavTree a)) -> NavTree a -> [NavTree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavTree a -> Maybe (NavTree a)
forall a. NavTree a -> Maybe (NavTree a)
downNT
descendantAxis :: NavTree a -> [NavTree a]
descendantAxis :: forall a. NavTree a -> [NavTree a]
descendantAxis = [NavTree a] -> [NavTree a]
forall a. HasCallStack => [a] -> [a]
tail ([NavTree a] -> [NavTree a])
-> (NavTree a -> [NavTree a]) -> NavTree a -> [NavTree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavTree a -> [NavTree a]
forall a. NavTree a -> [NavTree a]
preorderNT
descendantOrSelfAxis :: NavTree a -> [NavTree a]
descendantOrSelfAxis :: forall a. NavTree a -> [NavTree a]
descendantOrSelfAxis = NavTree a -> [NavTree a]
forall a. NavTree a -> [NavTree a]
preorderNT
followingSiblingAxis :: NavTree a -> [NavTree a]
followingSiblingAxis :: forall a. NavTree a -> [NavTree a]
followingSiblingAxis = (NavTree a -> Maybe (NavTree a)) -> NavTree a -> [NavTree a]
forall a. (a -> Maybe a) -> a -> [a]
maybePlus NavTree a -> Maybe (NavTree a)
forall a. NavTree a -> Maybe (NavTree a)
rightNT
precedingSiblingAxis :: NavTree a -> [NavTree a]
precedingSiblingAxis :: forall a. NavTree a -> [NavTree a]
precedingSiblingAxis = (NavTree a -> Maybe (NavTree a)) -> NavTree a -> [NavTree a]
forall a. (a -> Maybe a) -> a -> [a]
maybePlus NavTree a -> Maybe (NavTree a)
forall a. NavTree a -> Maybe (NavTree a)
leftNT
selfAxis :: NavTree a -> [NavTree a]
selfAxis :: forall a. NavTree a -> [NavTree a]
selfAxis = (NavTree a -> [NavTree a] -> [NavTree a]
forall a. a -> [a] -> [a]
:[])
followingAxis :: NavTree a -> [NavTree a]
followingAxis :: forall a. NavTree a -> [NavTree a]
followingAxis = NavTree a -> [NavTree a]
forall a. NavTree a -> [NavTree a]
preorderNT (NavTree a -> [NavTree a])
-> (NavTree a -> [NavTree a]) -> NavTree a -> [NavTree a]
forall b c a. (b -> [c]) -> (a -> [b]) -> a -> [c]
`o'` NavTree a -> [NavTree a]
forall a. NavTree a -> [NavTree a]
followingSiblingAxis (NavTree a -> [NavTree a])
-> (NavTree a -> [NavTree a]) -> NavTree a -> [NavTree a]
forall b c a. (b -> [c]) -> (a -> [b]) -> a -> [c]
`o'` NavTree a -> [NavTree a]
forall a. NavTree a -> [NavTree a]
ancestorOrSelfAxis
precedingAxis :: NavTree a -> [NavTree a]
precedingAxis :: forall a. NavTree a -> [NavTree a]
precedingAxis = NavTree a -> [NavTree a]
forall a. NavTree a -> [NavTree a]
revPreorderNT (NavTree a -> [NavTree a])
-> (NavTree a -> [NavTree a]) -> NavTree a -> [NavTree a]
forall b c a. (b -> [c]) -> (a -> [b]) -> a -> [c]
`o'` NavTree a -> [NavTree a]
forall a. NavTree a -> [NavTree a]
precedingSiblingAxis (NavTree a -> [NavTree a])
-> (NavTree a -> [NavTree a]) -> NavTree a -> [NavTree a]
forall b c a. (b -> [c]) -> (a -> [b]) -> a -> [c]
`o'` NavTree a -> [NavTree a]
forall a. NavTree a -> [NavTree a]
ancestorOrSelfAxis
attributeAxis :: NavTree XNode -> [NavTree XNode]
attributeAxis :: NavTree XNode -> [NavTree XNode]
attributeAxis t :: NavTree XNode
t@(NT NTree XNode
xt Int
_ [NavTree XNode]
a [NTree XNode]
_ [NTree XNode]
_)
| NTree XNode -> Bool
forall a. XmlNode a => a -> Bool
isElem NTree XNode
xt
Bool -> Bool -> Bool
&&
Bool -> Bool
not (NTree XNode -> Bool
forall a. XmlNode a => a -> Bool
isRoot NTree XNode
xt) = ((Int, NTree XNode) -> [NavTree XNode] -> [NavTree XNode])
-> [NavTree XNode] -> [(Int, NTree XNode)] -> [NavTree XNode]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ (Int
ix, NTree XNode
attr) -> ((NTree XNode
-> Int
-> [NavTree XNode]
-> [NTree XNode]
-> [NTree XNode]
-> NavTree XNode
forall a.
NTree a
-> Int -> [NavTree a] -> [NTree a] -> [NTree a] -> NavTree a
NT NTree XNode
attr Int
ix (NavTree XNode
tNavTree XNode -> [NavTree XNode] -> [NavTree XNode]
forall a. a -> [a] -> [a]
:[NavTree XNode]
a) [] [])NavTree XNode -> [NavTree XNode] -> [NavTree XNode]
forall a. a -> [a] -> [a]
:)) [] [(Int, NTree XNode)]
al
| Bool
otherwise = []
where
aix :: [b] -> [(Int, b)]
aix [b]
xs = [Int] -> [b] -> [(Int, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- [b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
xs) .. (-Int
1)] [b]
xs
al :: [(Int, NTree XNode)]
al = ((Int, NTree XNode) -> Bool)
-> [(Int, NTree XNode)] -> [(Int, NTree XNode)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
xmlnsNamespace) (String -> Bool)
-> ((Int, NTree XNode) -> String) -> (Int, NTree XNode) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (QName -> String) -> Maybe QName -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" QName -> String
namespaceUri (Maybe QName -> String)
-> ((Int, NTree XNode) -> Maybe QName)
-> (Int, NTree XNode)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTree XNode -> Maybe QName
forall a. XmlNode a => a -> Maybe QName
getName (NTree XNode -> Maybe QName)
-> ((Int, NTree XNode) -> NTree XNode)
-> (Int, NTree XNode)
-> Maybe QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, NTree XNode) -> NTree XNode
forall a b. (a, b) -> b
snd)
([(Int, NTree XNode)] -> [(Int, NTree XNode)])
-> (NTree XNode -> [(Int, NTree XNode)])
-> NTree XNode
-> [(Int, NTree XNode)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NTree XNode] -> [(Int, NTree XNode)]
forall {b}. [b] -> [(Int, b)]
aix
([NTree XNode] -> [(Int, NTree XNode)])
-> (NTree XNode -> [NTree XNode])
-> NTree XNode
-> [(Int, NTree XNode)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NTree XNode] -> Maybe [NTree XNode] -> [NTree XNode]
forall a. a -> Maybe a -> a
fromMaybe []
(Maybe [NTree XNode] -> [NTree XNode])
-> (NTree XNode -> Maybe [NTree XNode])
-> NTree XNode
-> [NTree XNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTree XNode -> Maybe [NTree XNode]
forall a. XmlNode a => a -> Maybe [NTree XNode]
getAttrl (NTree XNode -> [(Int, NTree XNode)])
-> NTree XNode -> [(Int, NTree XNode)]
forall a b. (a -> b) -> a -> b
$ NTree XNode
xt