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

{- |
   Module     : Data.Tree.NavigatableTree.XPathAxis
   Copyright  : Copyright (C) 2010 Uwe Schmidt
   License    : MIT

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

   Navigatable trees need to have operations to move up, down, left and right.
   With these elementary operations, the XPath axises can be defined.
-}

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

module Data.Tree.NavigatableTree.XPathAxis
where

import Data.Maybe               ( maybeToList )
import Data.Tree.NavigatableTree.Class

import Control.Arrow            ( (>>>) )
import Control.Monad            ( (>=>) )

-- ------------------------------------------------------------
--
-- mothers little helpers

-- | collect all trees by moving into one direction, starting tree is included

maybeStar               :: (a -> Maybe a) -> (a -> [a])
maybeStar :: forall a. (a -> Maybe a) -> a -> [a]
maybeStar a -> Maybe a
f a
x            = a
x forall a. a -> [a] -> [a]
: forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. (a -> Maybe a) -> a -> [a]
maybeStar a -> Maybe a
f) (a -> Maybe a
f a
x)

-- | collect all trees by moving into one direction, starting tree is not included

maybePlus               :: (a -> Maybe a) -> (a -> [a])
maybePlus :: forall a. (a -> Maybe a) -> a -> [a]
maybePlus a -> Maybe a
f a
x           =      forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. (a -> Maybe a) -> a -> [a]
maybeStar a -> Maybe a
f) (a -> Maybe a
f a
x)

{-# INLINE maybePlus #-}

-- ------------------------------------------------------------
-- XPath axis

-- | XPath axis: parent

parentAxis              :: NavigatableTree t => t a -> [t a]
parentAxis :: forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
parentAxis              = forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. NavigatableTree t => t a -> Maybe (t a)
mvUp
{-# INLINE parentAxis #-}

-- | XPath axis: ancestor

ancestorAxis            :: NavigatableTree t => t a -> [t a]
ancestorAxis :: forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
ancestorAxis            = forall a. (a -> Maybe a) -> a -> [a]
maybePlus forall (t :: * -> *) a. NavigatableTree t => t a -> Maybe (t a)
mvUp
{-# INLINE ancestorAxis #-}

-- | XPath axis: ancestor or self

ancestorOrSelfAxis      :: NavigatableTree t => t a -> [t a]
ancestorOrSelfAxis :: forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
ancestorOrSelfAxis      = forall a. (a -> Maybe a) -> a -> [a]
maybeStar forall (t :: * -> *) a. NavigatableTree t => t a -> Maybe (t a)
mvUp
{-# INLINE ancestorOrSelfAxis #-}

-- | XPath axis: child

childAxis               :: NavigatableTree t => t a -> [t a]
childAxis :: forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
childAxis               = (forall (t :: * -> *) a. NavigatableTree t => t a -> Maybe (t a)
mvDown forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. Maybe a -> [a]
maybeToList) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. (a -> Maybe a) -> a -> [a]
maybeStar forall (t :: * -> *) a. NavigatableTree t => t a -> Maybe (t a)
mvRight
{-# INLINE childAxis #-}

-- | XPath axis: descendant

descendantAxis          :: NavigatableTree t => t a -> [t a]
descendantAxis :: forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
descendantAxis          = forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
descendantOrSelfAxis forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. [a] -> [a]
tail
{-# INLINE descendantAxis #-}

-- | XPath axis: descendant or self

descendantOrSelfAxis    :: NavigatableTree t => t a -> [t a]
descendantOrSelfAxis :: forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
descendantOrSelfAxis    = forall {t :: * -> *} {a}.
NavigatableTree t =>
[t a] -> t a -> [t a]
visit []
    where
    visit :: [t a] -> t a -> [t a]
visit  [t a]
k t a
t          = t a
t forall a. a -> [a] -> [a]
: forall b a. b -> (a -> b) -> Maybe a -> b
maybe [t a]
k ([t a] -> t a -> [t a]
visit' [t a]
k) (forall (t :: * -> *) a. NavigatableTree t => t a -> Maybe (t a)
mvDown t a
t)
    visit' :: [t a] -> t a -> [t a]
visit' [t a]
k t a
t          = [t a] -> t a -> [t a]
visit (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [t a]
k ([t a] -> t a -> [t a]
visit' [t a]
k) (forall (t :: * -> *) a. NavigatableTree t => t a -> Maybe (t a)
mvRight t a
t)) t a
t

-- | not an official XPath axis but useful: reverse descendant or self, used in preceding axis

revDescendantOrSelfAxis :: NavigatableTree t => t a -> [t a]
revDescendantOrSelfAxis :: forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
revDescendantOrSelfAxis t a
t
                        = t a
t forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
revDescendantOrSelfAxis (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
childAxis t a
t)

-- | XPath axis: following sibling

followingSiblingAxis    :: NavigatableTree t => t a -> [t a]
followingSiblingAxis :: forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
followingSiblingAxis    = forall a. (a -> Maybe a) -> a -> [a]
maybePlus forall (t :: * -> *) a. NavigatableTree t => t a -> Maybe (t a)
mvRight
{-# INLINE followingSiblingAxis #-}

-- | XPath axis: preceeding sibling

precedingSiblingAxis    :: NavigatableTree t => t a -> [t a]
precedingSiblingAxis :: forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
precedingSiblingAxis    = forall a. (a -> Maybe a) -> a -> [a]
maybePlus forall (t :: * -> *) a. NavigatableTree t => t a -> Maybe (t a)
mvLeft
{-# INLINE precedingSiblingAxis #-}

-- | XPath axis: self

selfAxis                :: NavigatableTree t => t a -> [t a]
selfAxis :: forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
selfAxis                = (forall a. a -> [a] -> [a]
:[])
{-# INLINE selfAxis #-}

-- | XPath axis: following

followingAxis           :: NavigatableTree t => t a -> [t a]
followingAxis :: forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
followingAxis           = forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
ancestorOrSelfAxis forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
followingSiblingAxis forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
descendantOrSelfAxis

-- | XPath axis: preceding

precedingAxis           :: NavigatableTree t => t a -> [t a]
precedingAxis :: forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
precedingAxis           = forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
ancestorOrSelfAxis forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
precedingSiblingAxis forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
revDescendantOrSelfAxis

-- | move to the root

mvToRoot                :: NavigatableTree t => t a -> t a
mvToRoot :: forall (t :: * -> *) a. NavigatableTree t => t a -> t a
mvToRoot                = forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
ancestorOrSelfAxis forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. [a] -> a
last
{-# INLINE mvToRoot #-}

isAtRoot                :: NavigatableTree t => t a -> Bool
isAtRoot :: forall (t :: * -> *) a. NavigatableTree t => t a -> Bool
isAtRoot                = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
ancestorAxis
{-# INLINE isAtRoot #-}

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