XPathAxis.hs

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

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

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

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

{-# INLINE maybePlus #-}

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

-- | XPath axis: parent

parentAxis              :: NavigatableTree t => t a -> [t a]
parentAxis              = maybeToList . mvUp
{-# INLINE parentAxis #-}

-- | XPath axis: ancestor

ancestorAxis            :: NavigatableTree t => t a -> [t a]
ancestorAxis            = maybePlus mvUp
{-# INLINE ancestorAxis #-}

-- | XPath axis: ancestor or self

ancestorOrSelfAxis      :: NavigatableTree t => t a -> [t a]
ancestorOrSelfAxis      = maybeStar mvUp
{-# INLINE ancestorOrSelfAxis #-}

-- | XPath axis: child

childAxis               :: NavigatableTree t => t a -> [t a]
childAxis               = (mvDown >>> maybeToList) >=> maybeStar mvRight
{-# INLINE childAxis #-}

-- | XPath axis: descendant

descendantAxis          :: NavigatableTree t => t a -> [t a]
descendantAxis          = descendantOrSelfAxis >>> tail
{-# INLINE descendantAxis #-}

-- | XPath axis: descendant or self

descendantOrSelfAxis    :: NavigatableTree t => t a -> [t a]
descendantOrSelfAxis    = visit []
    where
    visit  k t          = t : maybe k (visit' k) (mvDown t)
    visit' k t          = visit (maybe k (visit' k) (mvRight t)) 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
                        = t : concatMap revDescendantOrSelfAxis (reverse $ childAxis t)

-- | XPath axis: following sibling

followingSiblingAxis    :: NavigatableTree t => t a -> [t a]
followingSiblingAxis    = maybePlus mvRight
{-# INLINE followingSiblingAxis #-}

-- | XPath axis: preceeding sibling

precedingSiblingAxis    :: NavigatableTree t => t a -> [t a]
precedingSiblingAxis    = maybePlus mvLeft
{-# INLINE precedingSiblingAxis #-}

-- | XPath axis: self

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

-- | XPath axis: following

followingAxis           :: NavigatableTree t => t a -> [t a]
followingAxis           = ancestorOrSelfAxis >=> followingSiblingAxis >=> descendantOrSelfAxis

-- | XPath axis: preceding

precedingAxis           :: NavigatableTree t => t a -> [t a]
precedingAxis           = ancestorOrSelfAxis >=> precedingSiblingAxis >=> revDescendantOrSelfAxis

-- | move to the root

mvToRoot                :: NavigatableTree t => t a -> t a
mvToRoot                = ancestorOrSelfAxis >>> last
{-# INLINE mvToRoot #-}

isAtRoot                :: NavigatableTree t => t a -> Bool
isAtRoot                = null . ancestorAxis
{-# INLINE isAtRoot #-}

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