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

{- |
   Module     : Control.Arrow.ArrowNavigatableTree
   Copyright  : Copyright (C) 2010 Uwe Schmidt
   License    : MIT

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

   List arrows for navigatable trees

   Trees that implement the "Data.Tree.NavigatableTree.Class" interface, can be processed
   with these arrows.
-}

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

module Control.Arrow.ArrowNavigatableTree
where

import           Control.Arrow
import           Control.Arrow.ArrowList
import           Control.Arrow.ArrowIf

import           Data.Maybe

import           Data.Tree.NavigatableTree.Class        ( NavigatableTree
                                                        , NavigatableTreeToTree
                                                        , NavigatableTreeModify
                                                        )
import qualified Data.Tree.NavigatableTree.Class        as T
import qualified Data.Tree.NavigatableTree.XPathAxis    as T

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

-- | The interface for navigatable tree arrows
--
-- all functions have default implementations

class (ArrowList a) => ArrowNavigatableTree a where

    -- move one step towards the root
    moveUp              :: NavigatableTree t => a (t b) (t b)
    moveUp              = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ((t b -> [t b]) -> a (t b) (t b))
-> (t b -> [t b]) -> a (t b) (t b)
forall a b. (a -> b) -> a -> b
$ Maybe (t b) -> [t b]
forall a. Maybe a -> [a]
maybeToList (Maybe (t b) -> [t b]) -> (t b -> Maybe (t b)) -> t b -> [t b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> Maybe (t b)
forall (t :: * -> *) a. NavigatableTree t => t a -> Maybe (t a)
T.mvUp

    -- descend one step to the leftmost child
    moveDown            :: NavigatableTree t => a (t b) (t b)
    moveDown            = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ((t b -> [t b]) -> a (t b) (t b))
-> (t b -> [t b]) -> a (t b) (t b)
forall a b. (a -> b) -> a -> b
$ Maybe (t b) -> [t b]
forall a. Maybe a -> [a]
maybeToList (Maybe (t b) -> [t b]) -> (t b -> Maybe (t b)) -> t b -> [t b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> Maybe (t b)
forall (t :: * -> *) a. NavigatableTree t => t a -> Maybe (t a)
T.mvDown

    -- move to the left neighbour
    moveLeft            :: NavigatableTree t => a (t b) (t b)
    moveLeft            = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ((t b -> [t b]) -> a (t b) (t b))
-> (t b -> [t b]) -> a (t b) (t b)
forall a b. (a -> b) -> a -> b
$ Maybe (t b) -> [t b]
forall a. Maybe a -> [a]
maybeToList (Maybe (t b) -> [t b]) -> (t b -> Maybe (t b)) -> t b -> [t b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> Maybe (t b)
forall (t :: * -> *) a. NavigatableTree t => t a -> Maybe (t a)
T.mvLeft

    -- move to the right neighbour
    moveRight           :: NavigatableTree t => a (t b) (t b)
    moveRight           = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ((t b -> [t b]) -> a (t b) (t b))
-> (t b -> [t b]) -> a (t b) (t b)
forall a b. (a -> b) -> a -> b
$ Maybe (t b) -> [t b]
forall a. Maybe a -> [a]
maybeToList (Maybe (t b) -> [t b]) -> (t b -> Maybe (t b)) -> t b -> [t b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> Maybe (t b)
forall (t :: * -> *) a. NavigatableTree t => t a -> Maybe (t a)
T.mvRight

-- derived functions

parentAxis              :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
parentAxis :: a (t b) (t b)
parentAxis              = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL t b -> [t b]
forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.parentAxis

-- | XPath axis: ancestor

ancestorAxis            :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
ancestorAxis :: a (t b) (t b)
ancestorAxis            = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL t b -> [t b]
forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.ancestorAxis

-- | XPath axis: ancestor or self

ancestorOrSelfAxis      :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
ancestorOrSelfAxis :: a (t b) (t b)
ancestorOrSelfAxis      = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL t b -> [t b]
forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.ancestorOrSelfAxis

-- | XPath axis: child

childAxis               :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
childAxis :: a (t b) (t b)
childAxis               = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL t b -> [t b]
forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.childAxis

-- | XPath axis: descendant

descendantAxis          :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
descendantAxis :: a (t b) (t b)
descendantAxis          = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL t b -> [t b]
forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.descendantAxis

-- | XPath axis: descendant or self

descendantOrSelfAxis    :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
descendantOrSelfAxis :: a (t b) (t b)
descendantOrSelfAxis    = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL t b -> [t b]
forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.descendantOrSelfAxis

-- | not an XPath axis but useful: descendant or following

descendantOrFollowingAxis    :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
descendantOrFollowingAxis :: a (t b) (t b)
descendantOrFollowingAxis    = a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
descendantAxis a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
followingAxis

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

revDescendantOrSelfAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
revDescendantOrSelfAxis :: a (t b) (t b)
revDescendantOrSelfAxis = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL t b -> [t b]
forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.revDescendantOrSelfAxis

-- | XPath axis: following sibling

followingSiblingAxis    :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
followingSiblingAxis :: a (t b) (t b)
followingSiblingAxis    = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL t b -> [t b]
forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.followingSiblingAxis

-- | XPath axis: preceeding sibling

precedingSiblingAxis    :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
precedingSiblingAxis :: a (t b) (t b)
precedingSiblingAxis    = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL t b -> [t b]
forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.precedingSiblingAxis

-- | XPath axis: self

selfAxis                :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
selfAxis :: a (t b) (t b)
selfAxis                = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL t b -> [t b]
forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.selfAxis

-- | XPath axis: following

followingAxis           :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
followingAxis :: a (t b) (t b)
followingAxis           = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL t b -> [t b]
forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.followingAxis

-- | XPath axis: preceding

precedingAxis           :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
precedingAxis :: a (t b) (t b)
precedingAxis           = (t b -> [t b]) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL t b -> [t b]
forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.precedingAxis

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

-- | move to the root

moveToRoot              :: (Arrow a, NavigatableTree t) => a (t b) (t b)
moveToRoot :: a (t b) (t b)
moveToRoot              = (t b -> t b) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr t b -> t b
forall (t :: * -> *) a. NavigatableTree t => t a -> t a
T.mvToRoot

isAtRoot                :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
isAtRoot :: a (t b) (t b)
isAtRoot                = (t b -> Bool) -> a (t b) (t b)
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA ([t b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([t b] -> Bool) -> (t b -> [t b]) -> t b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> [t b]
forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.ancestorAxis)

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

-- | Conversion from a tree into a navigatable tree

addNav                  :: ( ArrowList a
                           , NavigatableTreeToTree nt t
                           ) =>
                           a (t b) (nt b)
addNav :: a (t b) (nt b)
addNav                  = (t b -> nt b) -> a (t b) (nt b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr t b -> nt b
forall (nt :: * -> *) (t :: * -> *) a.
NavigatableTreeToTree nt t =>
t a -> nt a
T.fromTree


-- | Conversion from a navigatable tree into an ordinary tree

remNav                  :: ( ArrowList a
                           , NavigatableTreeToTree nt t
                           ) =>
                           a (nt b) (t b)
remNav :: a (nt b) (t b)
remNav                  = (nt b -> t b) -> a (nt b) (t b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr nt b -> t b
forall (nt :: * -> *) (t :: * -> *) a.
NavigatableTreeToTree nt t =>
nt a -> t a
T.toTree

-- | apply an operation using navigation to an ordinary tree
--
-- This root and all children may be visited in arbitrary order

withNav                 :: ( ArrowList a
                           , NavigatableTreeToTree nt t
                           ) =>
                           a (nt b) (nt c) -> a (t b) (t c)
withNav :: a (nt b) (nt c) -> a (t b) (t c)
withNav a (nt b) (nt c)
f               = a (t b) (nt b)
forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t) =>
a (t b) (nt b)
addNav a (t b) (nt b) -> a (nt b) (t c) -> a (t b) (t c)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (nt b) (nt c)
f a (nt b) (nt c) -> a (nt c) (t c) -> a (nt b) (t c)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (nt c) (t c)
forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t) =>
a (nt b) (t b)
remNav


-- | apply a simple operation without use of navigation to a navigatable tree
--
-- This enables to apply arbitrary tree operations to navigatable trees

withoutNav              :: ( ArrowList a
                           , NavigatableTreeToTree nt t
                           , NavigatableTreeModify nt t
                           ) =>
                           a (t b) (t b) -> a (nt b) (nt b)
withoutNav :: a (t b) (t b) -> a (nt b) (nt b)
withoutNav a (t b) (t b)
f            = ( (a (nt b) (t b)
forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t) =>
a (nt b) (t b)
remNav a (nt b) (t b) -> a (t b) (t b) -> a (nt b) (t b)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (t b) (t b)
f)                      -- apply the simple arrow to the tree
                            a (nt b) (t b) -> a (nt b) (nt b) -> a (nt b) (t b, nt b)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                            a (nt b) (nt b)
forall (a :: * -> * -> *) b. ArrowList a => a b b
this                                -- remember the navigation context
                          )
                          a (nt b) (t b, nt b) -> a (t b, nt b) (nt b) -> a (nt b) (nt b)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((t b, nt b) -> nt b) -> a (t b, nt b) (nt b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((t b -> nt b -> nt b) -> (t b, nt b) -> nt b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry t b -> nt b -> nt b
forall (nt :: * -> *) (t :: * -> *) a.
NavigatableTreeModify nt t =>
t a -> nt a -> nt a
T.substThisTree)             -- resore the context
                             
-- ------------------------------------------------------------

-- | Filter an axis with an ordinary tree predicate
--
-- Example: In a tree of Ints find all nodes in the subtrees (in preorder) that have label 42
--
-- > descendantAxis >>> filterAxis (hasNode (== 42))
--
-- Example: In an XML Tree find the following nodes of a node with attribute id and value 42
--
-- > descendantAxis >>> filterAxis (hasAttrValue "id" (=="42")) >>> followingAxis

filterAxis              :: ( ArrowIf a
                           , NavigatableTreeToTree nt t
                           ) =>
                           a (t b) c -> a (nt b) (nt b)

filterAxis :: a (t b) c -> a (nt b) (nt b)
filterAxis a (t b) c
p            = (a (nt b) (t b)
forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t) =>
a (nt b) (t b)
remNav a (nt b) (t b) -> a (t b) c -> a (nt b) c
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (t b) c
p) a (nt b) c -> a (nt b) (nt b) -> a (nt b) (nt b)
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` a (nt b) (nt b)
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
{-# INLINE filterAxis #-}


-- | Move to the next tree on a given axis. Deterministic arrow
--
-- Example: Move to the next node in a preorder visit: next child or else next following
--
-- > moveOn descendantOrFollowingAxis

moveOn                  :: ( ArrowList a
                           , NavigatableTree t
                           ) =>
                           a (t b) (t b) -> a (t b) (t b)
moveOn :: a (t b) (t b) -> a (t b) (t b)
moveOn a (t b) (t b)
axis             = a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b c
single (a (t b) (t b) -> a (t b) (t b)) -> a (t b) (t b) -> a (t b) (t b)
forall a b. (a -> b) -> a -> b
$ a (t b) (t b)
axis
{-# INLINE moveOn #-}

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

-- | Change the current subtree of a navigatable tree.
--
-- The arrow for computing the changes should be deterministic. If it fails
-- nothing is changed.

changeThisTree          :: ( ArrowList a
                           , ArrowIf a
                           , NavigatableTreeToTree nt t
                           , NavigatableTreeModify nt t
                           ) =>
                           a (t b) (t b) -> a (nt b) (nt b)
changeThisTree :: a (t b) (t b) -> a (nt b) (nt b)
changeThisTree a (t b) (t b)
cf       = a (t b) (t b) -> a (nt b) (nt b)
forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t,
 NavigatableTreeModify nt t) =>
a (t b) (t b) -> a (nt b) (nt b)
withoutNav (a (t b) (t b) -> a (nt b) (nt b))
-> a (t b) (t b) -> a (nt b) (nt b)
forall a b. (a -> b) -> a -> b
$ a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b c
single a (t b) (t b)
cf a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` a (t b) (t b)
forall (a :: * -> * -> *) b. ArrowList a => a b b
this

-- | Substitute the current subtree of a navigatable tree by a given tree

substThisTree           :: ( ArrowList a
                           , ArrowIf a
                           , NavigatableTreeToTree nt t
                           , NavigatableTreeModify nt t
                           ) =>
                           t b -> a (nt b) (nt b)
substThisTree :: t b -> a (nt b) (nt b)
substThisTree t b
t         = a (t b) (t b) -> a (nt b) (nt b)
forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, ArrowIf a, NavigatableTreeToTree nt t,
 NavigatableTreeModify nt t) =>
a (t b) (t b) -> a (nt b) (nt b)
changeThisTree (t b -> a (t b) (t b)
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA t b
t)

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

-- | apply an ordinary arrow to the current subtree of a navigatabe tree and add the result trees in front of the current tree.
--
-- If this arrow is applied to the root, it will fail, because we want a tree as result, not a forest.

addToTheLeft            :: ( ArrowList a
                           , NavigatableTreeToTree nt t
                           , NavigatableTreeModify nt t
                           ) =>
                           a (t b) (t b) -> a (nt b) (nt b)
addToTheLeft :: a (t b) (t b) -> a (nt b) (nt b)
addToTheLeft            = (Maybe (nt b) -> [t b] -> Maybe (nt b))
-> a (t b) (t b) -> a (nt b) (nt b)
forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t,
 NavigatableTreeModify nt t) =>
(Maybe (nt b) -> [t b] -> Maybe (nt b))
-> a (t b) (t b) -> a (nt b) (nt b)
addToOneSide ((Maybe (nt b) -> [t b] -> Maybe (nt b))
 -> a (t b) (t b) -> a (nt b) (nt b))
-> (Maybe (nt b) -> [t b] -> Maybe (nt b))
-> a (t b) (t b)
-> a (nt b) (nt b)
forall a b. (a -> b) -> a -> b
$
                          (Maybe (nt b) -> t b -> Maybe (nt b))
-> Maybe (nt b) -> [t b] -> Maybe (nt b)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ Maybe (nt b)
acc t b
t -> Maybe (nt b)
acc Maybe (nt b) -> (nt b -> Maybe (nt b)) -> Maybe (nt b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t b -> nt b -> Maybe (nt b)
forall (nt :: * -> *) (t :: * -> *) a.
NavigatableTreeModify nt t =>
t a -> nt a -> Maybe (nt a)
T.addTreeLeft t b
t)
{-# INLINE addToTheLeft #-}

-- | apply an ordinary arrow to the current subtree of a navigatabe tree and add the result trees behind the current tree.
--
-- If this arrow is applied to the root, it will fail, because we want a tree as result, not a forest.

addToTheRight           :: ( ArrowList a
                           , NavigatableTreeToTree nt t
                           , NavigatableTreeModify nt t
                           ) =>
                           a (t b) (t b) -> a (nt b) (nt b)
addToTheRight :: a (t b) (t b) -> a (nt b) (nt b)
addToTheRight           = (Maybe (nt b) -> [t b] -> Maybe (nt b))
-> a (t b) (t b) -> a (nt b) (nt b)
forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t,
 NavigatableTreeModify nt t) =>
(Maybe (nt b) -> [t b] -> Maybe (nt b))
-> a (t b) (t b) -> a (nt b) (nt b)
addToOneSide ((Maybe (nt b) -> [t b] -> Maybe (nt b))
 -> a (t b) (t b) -> a (nt b) (nt b))
-> (Maybe (nt b) -> [t b] -> Maybe (nt b))
-> a (t b) (t b)
-> a (nt b) (nt b)
forall a b. (a -> b) -> a -> b
$
                          (t b -> Maybe (nt b) -> Maybe (nt b))
-> Maybe (nt b) -> [t b] -> Maybe (nt b)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ t b
t Maybe (nt b)
acc -> Maybe (nt b)
acc Maybe (nt b) -> (nt b -> Maybe (nt b)) -> Maybe (nt b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t b -> nt b -> Maybe (nt b)
forall (nt :: * -> *) (t :: * -> *) a.
NavigatableTreeModify nt t =>
t a -> nt a -> Maybe (nt a)
T.addTreeRight t b
t)
{-# INLINE addToTheRight #-}


-- | addToOneSide does the real work for 'addToTheLeft' and 'addToTheRight'

addToOneSide            :: ( ArrowList a
                           , NavigatableTreeToTree nt t
                           , NavigatableTreeModify nt t
                           ) =>
                           ( Maybe (nt b) -> [t b] -> Maybe (nt b) ) ->
                           a (t  b) (t  b) ->
                           a (nt b) (nt b)
addToOneSide :: (Maybe (nt b) -> [t b] -> Maybe (nt b))
-> a (t b) (t b) -> a (nt b) (nt b)
addToOneSide Maybe (nt b) -> [t b] -> Maybe (nt b)
side a (t b) (t b)
f     = ( ( a (nt b) (t b)
forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t) =>
a (nt b) (t b)
remNav a (nt b) (t b) -> a (t b) [t b] -> a (nt b) [t b]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (t b) (t b) -> a (t b) [t b]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA a (t b) (t b)
f )
                            a (nt b) [t b] -> a (nt b) (nt b) -> a (nt b) ([t b], nt b)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                            a (nt b) (nt b)
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
                          )
                          a (nt b) ([t b], nt b) -> a ([t b], nt b) (nt b) -> a (nt b) (nt b)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          (([t b], nt b) -> [nt b]) -> a ([t b], nt b) (nt b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ( ([t b] -> nt b -> Maybe (nt b)) -> ([t b], nt b) -> Maybe (nt b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (\ [t b]
ts nt b
nt -> Maybe (nt b) -> [t b] -> Maybe (nt b)
side (nt b -> Maybe (nt b)
forall a. a -> Maybe a
Just nt b
nt) [t b]
ts)
                                 (([t b], nt b) -> Maybe (nt b))
-> (Maybe (nt b) -> [nt b]) -> ([t b], nt b) -> [nt b]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                 Maybe (nt b) -> [nt b]
forall a. Maybe a -> [a]
maybeToList
                               )

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

-- | drop the direct left sibling tree of the given navigatable tree
--
-- If this arrow is applied to the root or a leftmost tree, it will fail, because there is nothing to remove

dropFromTheLeft         :: ( ArrowList a
                           -- , NavigatableTreeToTree nt t
                           , NavigatableTreeModify nt t
                           ) =>
                           a (nt b) (nt b)
dropFromTheLeft :: a (nt b) (nt b)
dropFromTheLeft            = (nt b -> [nt b]) -> a (nt b) (nt b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ((nt b -> [nt b]) -> a (nt b) (nt b))
-> (nt b -> [nt b]) -> a (nt b) (nt b)
forall a b. (a -> b) -> a -> b
$ nt b -> Maybe (nt b)
forall (nt :: * -> *) (t :: * -> *) a.
NavigatableTreeModify nt t =>
nt a -> Maybe (nt a)
T.dropTreeLeft (nt b -> Maybe (nt b))
-> (Maybe (nt b) -> [nt b]) -> nt b -> [nt b]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Maybe (nt b) -> [nt b]
forall a. Maybe a -> [a]
maybeToList
{-# INLINE dropFromTheLeft #-}

-- | drop the direct left sibling tree of the given navigatable tree
--
-- If this arrow is applied to the root or a rightmost tree, it will fail, because there is nothing to remove

dropFromTheRight        :: ( ArrowList a
                           , NavigatableTreeModify nt t
                           ) =>
                           a (nt b) (nt b)
dropFromTheRight :: a (nt b) (nt b)
dropFromTheRight            = (nt b -> [nt b]) -> a (nt b) (nt b)
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ((nt b -> [nt b]) -> a (nt b) (nt b))
-> (nt b -> [nt b]) -> a (nt b) (nt b)
forall a b. (a -> b) -> a -> b
$ nt b -> Maybe (nt b)
forall (nt :: * -> *) (t :: * -> *) a.
NavigatableTreeModify nt t =>
nt a -> Maybe (nt a)
T.dropTreeRight (nt b -> Maybe (nt b))
-> (Maybe (nt b) -> [nt b]) -> nt b -> [nt b]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Maybe (nt b) -> [nt b]
forall a. Maybe a -> [a]
maybeToList
{-# INLINE dropFromTheRight #-}

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