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

{- |
   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 :: (a -> Maybe a) -> a -> [a]
maybeStar a -> Maybe a
f a
x            = a
x 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
x)

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

maybePlus               :: (a -> Maybe a) -> (a -> [a])
maybePlus :: (a -> Maybe a) -> a -> [a]
maybePlus a -> Maybe a
f a
x           =      [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
x)

{-# INLINE maybePlus #-}

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

-- | XPath axis: parent

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

-- | XPath axis: ancestor

ancestorAxis            :: NavigatableTree t => t a -> [t a]
ancestorAxis :: t a -> [t a]
ancestorAxis            = (t a -> Maybe (t a)) -> t a -> [t a]
forall a. (a -> Maybe a) -> a -> [a]
maybePlus t a -> Maybe (t a)
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 :: t a -> [t a]
ancestorOrSelfAxis      = (t a -> Maybe (t a)) -> t a -> [t a]
forall a. (a -> Maybe a) -> a -> [a]
maybeStar t a -> Maybe (t a)
forall (t :: * -> *) a. NavigatableTree t => t a -> Maybe (t a)
mvUp
{-# INLINE ancestorOrSelfAxis #-}

-- | XPath axis: child

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

-- | XPath axis: descendant

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

-- | XPath axis: descendant or self

descendantOrSelfAxis    :: NavigatableTree t => t a -> [t a]
descendantOrSelfAxis :: t a -> [t a]
descendantOrSelfAxis    = [t a] -> t a -> [t a]
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 t a -> [t a] -> [t a]
forall a. a -> [a] -> [a]
: [t a] -> (t a -> [t a]) -> Maybe (t a) -> [t a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [t a]
k ([t a] -> t a -> [t a]
visit' [t a]
k) (t a -> Maybe (t a)
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 ([t a] -> (t a -> [t a]) -> Maybe (t a) -> [t a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [t a]
k ([t a] -> t a -> [t a]
visit' [t a]
k) (t a -> Maybe (t a)
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 :: t a -> [t a]
revDescendantOrSelfAxis t a
t
                        = t a
t t a -> [t a] -> [t a]
forall a. a -> [a] -> [a]
: (t a -> [t a]) -> [t a] -> [t a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap t a -> [t a]
forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
revDescendantOrSelfAxis ([t a] -> [t a]
forall a. [a] -> [a]
reverse ([t a] -> [t a]) -> [t a] -> [t a]
forall a b. (a -> b) -> a -> b
$ t a -> [t a]
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 :: t a -> [t a]
followingSiblingAxis    = (t a -> Maybe (t a)) -> t a -> [t a]
forall a. (a -> Maybe a) -> a -> [a]
maybePlus t a -> Maybe (t a)
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 :: t a -> [t a]
precedingSiblingAxis    = (t a -> Maybe (t a)) -> t a -> [t a]
forall a. (a -> Maybe a) -> a -> [a]
maybePlus t a -> Maybe (t a)
forall (t :: * -> *) a. NavigatableTree t => t a -> Maybe (t a)
mvLeft
{-# INLINE precedingSiblingAxis #-}

-- | XPath axis: self

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

-- | XPath axis: following

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

-- | XPath axis: preceding

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

-- | move to the root

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

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

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