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
class (ArrowList a) => ArrowNavigatableTree a where
moveUp :: NavigatableTree t => a (t b) (t b)
moveUp = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall a b. (a -> b) -> a -> b
$ 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)
T.mvUp
moveDown :: NavigatableTree t => a (t b) (t b)
moveDown = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall a b. (a -> b) -> a -> b
$ 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)
T.mvDown
moveLeft :: NavigatableTree t => a (t b) (t b)
moveLeft = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall a b. (a -> b) -> a -> b
$ 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)
T.mvLeft
moveRight :: NavigatableTree t => a (t b) (t b)
moveRight = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall a b. (a -> b) -> a -> b
$ 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)
T.mvRight
parentAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
parentAxis :: forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
parentAxis = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.parentAxis
ancestorAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
ancestorAxis :: forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
ancestorAxis = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.ancestorAxis
ancestorOrSelfAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
ancestorOrSelfAxis :: forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
ancestorOrSelfAxis = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.ancestorOrSelfAxis
childAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
childAxis :: forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
childAxis = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.childAxis
descendantAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
descendantAxis :: forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
descendantAxis = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.descendantAxis
descendantOrSelfAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
descendantOrSelfAxis :: forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
descendantOrSelfAxis = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.descendantOrSelfAxis
descendantOrFollowingAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
descendantOrFollowingAxis :: forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
descendantOrFollowingAxis = forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
descendantAxis forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
followingAxis
revDescendantOrSelfAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
revDescendantOrSelfAxis :: forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
revDescendantOrSelfAxis = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.revDescendantOrSelfAxis
followingSiblingAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
followingSiblingAxis :: forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
followingSiblingAxis = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.followingSiblingAxis
precedingSiblingAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
precedingSiblingAxis :: forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
precedingSiblingAxis = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.precedingSiblingAxis
selfAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
selfAxis :: forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
selfAxis = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.selfAxis
followingAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
followingAxis :: forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
followingAxis = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.followingAxis
precedingAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
precedingAxis :: forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
precedingAxis = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
T.precedingAxis
moveToRoot :: (Arrow a, NavigatableTree t) => a (t b) (t b)
moveToRoot :: forall (a :: * -> * -> *) (t :: * -> *) b.
(Arrow a, NavigatableTree t) =>
a (t b) (t b)
moveToRoot = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall (t :: * -> *) a. NavigatableTree t => t a -> t a
T.mvToRoot
isAtRoot :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
isAtRoot :: forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b)
isAtRoot = forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (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]
T.ancestorAxis)
addNav :: ( ArrowList a
, NavigatableTreeToTree nt t
) =>
a (t b) (nt b)
addNav :: forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t) =>
a (t b) (nt b)
addNav = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall (nt :: * -> *) (t :: * -> *) a.
NavigatableTreeToTree nt t =>
t a -> nt a
T.fromTree
remNav :: ( ArrowList a
, NavigatableTreeToTree nt t
) =>
a (nt b) (t b)
remNav :: forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t) =>
a (nt b) (t b)
remNav = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall (nt :: * -> *) (t :: * -> *) a.
NavigatableTreeToTree nt t =>
nt a -> t a
T.toTree
withNav :: ( ArrowList a
, NavigatableTreeToTree nt t
) =>
a (nt b) (nt c) -> a (t b) (t c)
withNav :: forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b c.
(ArrowList a, NavigatableTreeToTree nt t) =>
a (nt b) (nt c) -> a (t b) (t c)
withNav a (nt b) (nt c)
f = forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t) =>
a (t b) (nt b)
addNav 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 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t) =>
a (nt b) (t b)
remNav
withoutNav :: ( ArrowList a
, NavigatableTreeToTree nt t
, NavigatableTreeModify nt t
) =>
a (t b) (t b) -> a (nt b) (nt b)
withoutNav :: 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)
f = ( (forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t) =>
a (nt b) (t b)
remNav 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)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (nt :: * -> *) (t :: * -> *) a.
NavigatableTreeModify nt t =>
t a -> nt a -> nt a
T.substThisTree)
filterAxis :: ( ArrowIf a
, NavigatableTreeToTree nt t
) =>
a (t b) c -> a (nt b) (nt b)
filterAxis :: forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b c.
(ArrowIf a, NavigatableTreeToTree nt t) =>
a (t b) c -> a (nt b) (nt b)
filterAxis a (t b) c
p = (forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t) =>
a (nt b) (t b)
remNav 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) forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` forall (a :: * -> * -> *) b. ArrowList a => a b b
this
{-# INLINE filterAxis #-}
moveOn :: ( ArrowList a
, NavigatableTree t
) =>
a (t b) (t b) -> a (t b) (t b)
moveOn :: forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTree t) =>
a (t b) (t b) -> a (t b) (t b)
moveOn a (t b) (t b)
axis = forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b c
single forall a b. (a -> b) -> a -> b
$ a (t b) (t b)
axis
{-# INLINE moveOn #-}
changeThisTree :: ( ArrowList a
, ArrowIf a
, NavigatableTreeToTree nt t
, NavigatableTreeModify nt t
) =>
a (t b) (t b) -> a (nt b) (nt b)
changeThisTree :: 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 a (t b) (t b)
cf = forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t,
NavigatableTreeModify nt t) =>
a (t b) (t b) -> a (nt b) (nt b)
withoutNav forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b c
single a (t b) (t b)
cf forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` forall (a :: * -> * -> *) b. ArrowList a => a b b
this
substThisTree :: ( ArrowList a
, ArrowIf a
, NavigatableTreeToTree nt t
, NavigatableTreeModify nt t
) =>
t b -> a (nt b) (nt b)
substThisTree :: forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, ArrowIf a, NavigatableTreeToTree nt t,
NavigatableTreeModify nt t) =>
t b -> a (nt b) (nt b)
substThisTree t b
t = 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 (forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA t b
t)
addToTheLeft :: ( ArrowList a
, NavigatableTreeToTree nt t
, NavigatableTreeModify nt t
) =>
a (t b) (t b) -> a (nt b) (nt b)
addToTheLeft :: forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t,
NavigatableTreeModify nt t) =>
a (t b) (t b) -> a (nt b) (nt b)
addToTheLeft = 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 forall a b. (a -> b) -> a -> 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (nt :: * -> *) (t :: * -> *) a.
NavigatableTreeModify nt t =>
t a -> nt a -> Maybe (nt a)
T.addTreeLeft t b
t)
{-# INLINE addToTheLeft #-}
addToTheRight :: ( ArrowList a
, NavigatableTreeToTree nt t
, NavigatableTreeModify nt t
) =>
a (t b) (t b) -> a (nt b) (nt b)
addToTheRight :: forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t,
NavigatableTreeModify nt t) =>
a (t b) (t b) -> a (nt b) (nt b)
addToTheRight = 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 forall a b. (a -> b) -> a -> 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (nt :: * -> *) (t :: * -> *) a.
NavigatableTreeModify nt t =>
t a -> nt a -> Maybe (nt a)
T.addTreeRight t b
t)
{-# INLINE 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 :: 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)
side a (t b) (t b)
f = ( ( forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeToTree nt t) =>
a (nt b) (t b)
remNav forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA a (t b) (t b)
f )
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ( 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 (forall a. a -> Maybe a
Just nt b
nt) [t b]
ts)
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
)
dropFromTheLeft :: ( ArrowList a
, NavigatableTreeModify nt t
) =>
a (nt b) (nt b)
dropFromTheLeft :: forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeModify nt t) =>
a (nt b) (nt b)
dropFromTheLeft = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall a b. (a -> b) -> a -> b
$ forall (nt :: * -> *) (t :: * -> *) a.
NavigatableTreeModify nt t =>
nt a -> Maybe (nt a)
T.dropTreeLeft 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
{-# INLINE dropFromTheLeft #-}
dropFromTheRight :: ( ArrowList a
, NavigatableTreeModify nt t
) =>
a (nt b) (nt b)
dropFromTheRight :: forall (a :: * -> * -> *) (nt :: * -> *) (t :: * -> *) b.
(ArrowList a, NavigatableTreeModify nt t) =>
a (nt b) (nt b)
dropFromTheRight = forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall a b. (a -> b) -> a -> b
$ forall (nt :: * -> *) (t :: * -> *) a.
NavigatableTreeModify nt t =>
nt a -> Maybe (nt a)
T.dropTreeRight 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
{-# INLINE dropFromTheRight #-}