{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS -fno-warn-orphans #-}
module Data.Tree.NTree.Zipper.TypeDefs
where
import Data.Tree.Class
import Data.Tree.NavigatableTree.Class
import Data.Tree.NavigatableTree.XPathAxis ( childAxis )
import Data.Tree.NTree.TypeDefs
data NTZipper a = NTZ
{ forall a. NTZipper a -> NTree a
ntree :: (NTree a)
, forall a. NTZipper a -> NTBreadCrumbs a
context :: (NTBreadCrumbs a)
}
deriving (Int -> NTZipper a -> ShowS
forall a. Show a => Int -> NTZipper a -> ShowS
forall a. Show a => [NTZipper a] -> ShowS
forall a. Show a => NTZipper a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NTZipper a] -> ShowS
$cshowList :: forall a. Show a => [NTZipper a] -> ShowS
show :: NTZipper a -> String
$cshow :: forall a. Show a => NTZipper a -> String
showsPrec :: Int -> NTZipper a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NTZipper a -> ShowS
Show)
type NTBreadCrumbs a = [NTCrumb a]
data NTCrumb a = NTC
(NTrees a)
a
(NTrees a)
deriving (Int -> NTCrumb a -> ShowS
forall a. Show a => Int -> NTCrumb a -> ShowS
forall a. Show a => [NTCrumb a] -> ShowS
forall a. Show a => NTCrumb a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NTCrumb a] -> ShowS
$cshowList :: forall a. Show a => [NTCrumb a] -> ShowS
show :: NTCrumb a -> String
$cshow :: forall a. Show a => NTCrumb a -> String
showsPrec :: Int -> NTCrumb a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NTCrumb a -> ShowS
Show)
toNTZipper :: NTree a -> NTZipper a
toNTZipper :: forall a. NTree a -> NTZipper a
toNTZipper NTree a
t = forall a. NTree a -> NTBreadCrumbs a -> NTZipper a
NTZ NTree a
t []
{-# INLINE toNTZipper #-}
fromNTZipper :: NTZipper a -> NTree a
fromNTZipper :: forall a. NTZipper a -> NTree a
fromNTZipper = forall a. NTZipper a -> NTree a
ntree
{-# INLINE fromNTZipper #-}
up :: NTZipper a -> Maybe (NTZipper a)
up :: forall a. NTZipper a -> Maybe (NTZipper a)
up NTZipper a
z
| forall a. NTZipper a -> Bool
isTop NTZipper a
z = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. NTree a -> NTBreadCrumbs a -> NTZipper a
NTZ (forall a. NTree a -> NTCrumb a -> NTree a
up1 NTree a
t NTCrumb a
bc) [NTCrumb a]
bcs
where
NTZ NTree a
t (NTCrumb a
bc : [NTCrumb a]
bcs) = NTZipper a
z
{-# INLINE up #-}
down :: NTZipper a -> Maybe (NTZipper a)
down :: forall a. NTZipper a -> Maybe (NTZipper a)
down (NTZ (NTree a
n NTrees a
cs) NTBreadCrumbs a
bcs)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null NTrees a
cs = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. NTree a -> NTBreadCrumbs a -> NTZipper a
NTZ (forall a. [a] -> a
head NTrees a
cs) (forall a. NTrees a -> a -> NTrees a -> NTCrumb a
NTC [] a
n (forall a. [a] -> [a]
tail NTrees a
cs) forall a. a -> [a] -> [a]
: NTBreadCrumbs a
bcs)
{-# INLINE down #-}
toTheRight :: NTZipper a -> Maybe (NTZipper a)
toTheRight :: forall a. NTZipper a -> Maybe (NTZipper a)
toTheRight NTZipper a
z
| forall a. NTZipper a -> Bool
isTop NTZipper a
z
Bool -> Bool -> Bool
||
forall (t :: * -> *) a. Foldable t => t a -> Bool
null NTrees a
rs = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. NTree a -> NTBreadCrumbs a -> NTZipper a
NTZ NTree a
t' (NTCrumb a
bc' forall a. a -> [a] -> [a]
: [NTCrumb a]
bcs)
where
(NTZ NTree a
t (NTCrumb a
bc : [NTCrumb a]
bcs)) = NTZipper a
z
(NTC NTrees a
ls a
n NTrees a
rs) = NTCrumb a
bc
t' :: NTree a
t' = forall a. [a] -> a
head NTrees a
rs
bc' :: NTCrumb a
bc' = forall a. NTrees a -> a -> NTrees a -> NTCrumb a
NTC (NTree a
t forall a. a -> [a] -> [a]
: NTrees a
ls) a
n (forall a. [a] -> [a]
tail NTrees a
rs)
{-# INLINE toTheRight #-}
toTheLeft :: NTZipper a -> Maybe (NTZipper a)
toTheLeft :: forall a. NTZipper a -> Maybe (NTZipper a)
toTheLeft NTZipper a
z
| forall a. NTZipper a -> Bool
isTop NTZipper a
z
Bool -> Bool -> Bool
||
forall (t :: * -> *) a. Foldable t => t a -> Bool
null NTrees a
ls = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. NTree a -> NTBreadCrumbs a -> NTZipper a
NTZ NTree a
t' (NTCrumb a
bc' forall a. a -> [a] -> [a]
: [NTCrumb a]
bcs)
where
(NTZ NTree a
t (NTCrumb a
bc : [NTCrumb a]
bcs)) = NTZipper a
z
(NTC NTrees a
ls a
n NTrees a
rs) = NTCrumb a
bc
t' :: NTree a
t' = forall a. [a] -> a
head NTrees a
ls
bc' :: NTCrumb a
bc' = forall a. NTrees a -> a -> NTrees a -> NTCrumb a
NTC (forall a. [a] -> [a]
tail NTrees a
ls) a
n (NTree a
t forall a. a -> [a] -> [a]
: NTrees a
rs)
{-# INLINE toTheLeft #-}
addToTheLeft :: NTree a -> NTZipper a -> Maybe (NTZipper a)
addToTheLeft :: forall a. NTree a -> NTZipper a -> Maybe (NTZipper a)
addToTheLeft NTree a
t NTZipper a
z
| forall a. NTZipper a -> Bool
isTop NTZipper a
z = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. NTree a -> NTBreadCrumbs a -> NTZipper a
NTZ NTree a
t' (forall a. NTrees a -> a -> NTrees a -> NTCrumb a
NTC (NTree a
tforall a. a -> [a] -> [a]
:[NTree a]
ls) a
n [NTree a]
rs forall a. a -> [a] -> [a]
: [NTCrumb a]
bcs)
where
(NTZ NTree a
t' (NTCrumb a
bc : [NTCrumb a]
bcs)) = NTZipper a
z
(NTC [NTree a]
ls a
n [NTree a]
rs) = NTCrumb a
bc
{-# INLINE addToTheLeft #-}
addToTheRight :: NTree a -> NTZipper a -> Maybe (NTZipper a)
addToTheRight :: forall a. NTree a -> NTZipper a -> Maybe (NTZipper a)
addToTheRight NTree a
t NTZipper a
z
| forall a. NTZipper a -> Bool
isTop NTZipper a
z = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. NTree a -> NTBreadCrumbs a -> NTZipper a
NTZ NTree a
t' (forall a. NTrees a -> a -> NTrees a -> NTCrumb a
NTC NTrees a
ls a
n (NTree a
tforall a. a -> [a] -> [a]
:NTrees a
rs) forall a. a -> [a] -> [a]
: [NTCrumb a]
bcs)
where
(NTZ NTree a
t' (NTCrumb a
bc : [NTCrumb a]
bcs)) = NTZipper a
z
(NTC NTrees a
ls a
n NTrees a
rs) = NTCrumb a
bc
{-# INLINE addToTheRight #-}
dropFromTheLeft :: NTZipper a -> Maybe (NTZipper a)
dropFromTheLeft :: forall a. NTZipper a -> Maybe (NTZipper a)
dropFromTheLeft NTZipper a
z
| forall a. NTZipper a -> Bool
isTop NTZipper a
z = forall a. Maybe a
Nothing
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null NTrees a
ls = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. NTree a -> NTBreadCrumbs a -> NTZipper a
NTZ NTree a
t' (forall a. NTrees a -> a -> NTrees a -> NTCrumb a
NTC (forall a. [a] -> [a]
tail NTrees a
ls) a
n NTrees a
rs forall a. a -> [a] -> [a]
: [NTCrumb a]
bcs)
where
(NTZ NTree a
t' (NTCrumb a
bc : [NTCrumb a]
bcs)) = NTZipper a
z
(NTC NTrees a
ls a
n NTrees a
rs) = NTCrumb a
bc
{-# INLINE dropFromTheLeft #-}
dropFromTheRight :: NTZipper a -> Maybe (NTZipper a)
dropFromTheRight :: forall a. NTZipper a -> Maybe (NTZipper a)
dropFromTheRight NTZipper a
z
| forall a. NTZipper a -> Bool
isTop NTZipper a
z = forall a. Maybe a
Nothing
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null NTrees a
rs = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. NTree a -> NTBreadCrumbs a -> NTZipper a
NTZ NTree a
t' (forall a. NTrees a -> a -> NTrees a -> NTCrumb a
NTC NTrees a
ls a
n (forall a. [a] -> [a]
tail NTrees a
rs) forall a. a -> [a] -> [a]
: [NTCrumb a]
bcs)
where
(NTZ NTree a
t' (NTCrumb a
bc : [NTCrumb a]
bcs)) = NTZipper a
z
(NTC NTrees a
ls a
n NTrees a
rs) = NTCrumb a
bc
{-# INLINE dropFromTheRight #-}
isTop :: NTZipper a -> Bool
isTop :: forall a. NTZipper a -> Bool
isTop = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NTZipper a -> NTBreadCrumbs a
context
{-# INLINE isTop #-}
up1 :: NTree a -> NTCrumb a -> NTree a
up1 :: forall a. NTree a -> NTCrumb a -> NTree a
up1 NTree a
t (NTC NTrees a
ls a
n NTrees a
rs) = forall a. a -> NTrees a -> NTree a
NTree a
n (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) (NTree a
t forall a. a -> [a] -> [a]
: NTrees a
rs) NTrees a
ls)
{-# INLINE up1 #-}
instance Functor NTZipper where
fmap :: forall a b. (a -> b) -> NTZipper a -> NTZipper b
fmap a -> b
f (NTZ NTree a
t NTBreadCrumbs a
xs) = forall a. NTree a -> NTBreadCrumbs a -> NTZipper a
NTZ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f NTree a
t) (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) NTBreadCrumbs a
xs)
{-# INLINE fmap #-}
instance Functor NTCrumb where
fmap :: forall a b. (a -> b) -> NTCrumb a -> NTCrumb b
fmap a -> b
f (NTC NTrees a
xs a
x NTrees a
ys)= forall a. NTrees a -> a -> NTrees a -> NTCrumb a
NTC (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) NTrees a
xs) (a -> b
f a
x) (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) NTrees a
ys)
{-# INLINE fmap #-}
instance Tree NTZipper where
mkTree :: forall a. a -> [NTZipper a] -> NTZipper a
mkTree a
n [NTZipper a]
cl = forall a. NTree a -> NTZipper a
toNTZipper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Tree t => a -> [t a] -> t a
mkTree a
n forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. NTZipper a -> NTree a
ntree [NTZipper a]
cl
getNode :: forall a. NTZipper a -> a
getNode = forall (t :: * -> *) a. Tree t => t a -> a
getNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NTZipper a -> NTree a
ntree
{-# INLINE getNode #-}
getChildren :: forall a. NTZipper a -> [NTZipper a]
getChildren = forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
childAxis
{-# INLINE getChildren #-}
changeNode :: forall a. (a -> a) -> NTZipper a -> NTZipper a
changeNode a -> a
cf NTZipper a
t = NTZipper a
t { ntree :: NTree a
ntree = forall (t :: * -> *) a. Tree t => (a -> a) -> t a -> t a
changeNode a -> a
cf (forall a. NTZipper a -> NTree a
ntree NTZipper a
t) }
changeChildren :: forall a.
([NTZipper a] -> [NTZipper a]) -> NTZipper a -> NTZipper a
changeChildren [NTZipper a] -> [NTZipper a]
cf NTZipper a
t = NTZipper a
t { ntree :: NTree a
ntree = forall (t :: * -> *) a. Tree t => [t a] -> t a -> t a
setChildren (forall a b. (a -> b) -> [a] -> [b]
map forall a. NTZipper a -> NTree a
ntree forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NTZipper a] -> [NTZipper a]
cf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. NavigatableTree t => t a -> [t a]
childAxis forall a b. (a -> b) -> a -> b
$ NTZipper a
t) (forall a. NTZipper a -> NTree a
ntree NTZipper a
t) }
foldTree :: forall a b. (a -> [b] -> b) -> NTZipper a -> b
foldTree a -> [b] -> b
f = forall (t :: * -> *) a b. Tree t => (a -> [b] -> b) -> t a -> b
foldTree a -> [b] -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NTZipper a -> NTree a
ntree
{-# INLINE foldTree #-}
instance NavigatableTree NTZipper where
mvDown :: forall a. NTZipper a -> Maybe (NTZipper a)
mvDown = forall a. NTZipper a -> Maybe (NTZipper a)
down
{-# INLINE mvDown #-}
mvUp :: forall a. NTZipper a -> Maybe (NTZipper a)
mvUp = forall a. NTZipper a -> Maybe (NTZipper a)
up
{-# INLINE mvUp #-}
mvLeft :: forall a. NTZipper a -> Maybe (NTZipper a)
mvLeft = forall a. NTZipper a -> Maybe (NTZipper a)
toTheLeft
{-# INLINE mvLeft #-}
mvRight :: forall a. NTZipper a -> Maybe (NTZipper a)
mvRight = forall a. NTZipper a -> Maybe (NTZipper a)
toTheRight
{-# INLINE mvRight #-}
instance NavigatableTreeToTree NTZipper NTree where
fromTree :: forall a. NTree a -> NTZipper a
fromTree = forall a. NTree a -> NTZipper a
toNTZipper
{-# INLINE fromTree #-}
toTree :: forall a. NTZipper a -> NTree a
toTree = forall a. NTZipper a -> NTree a
fromNTZipper
{-# INLINE toTree #-}
instance NavigatableTreeModify NTZipper NTree where
addTreeLeft :: forall a. NTree a -> NTZipper a -> Maybe (NTZipper a)
addTreeLeft = forall a. NTree a -> NTZipper a -> Maybe (NTZipper a)
addToTheLeft
{-# INLINE addTreeLeft #-}
addTreeRight :: forall a. NTree a -> NTZipper a -> Maybe (NTZipper a)
addTreeRight = forall a. NTree a -> NTZipper a -> Maybe (NTZipper a)
addToTheRight
{-# INLINE addTreeRight #-}
dropTreeLeft :: forall a. NTZipper a -> Maybe (NTZipper a)
dropTreeLeft = forall a. NTZipper a -> Maybe (NTZipper a)
dropFromTheLeft
{-# INLINE dropTreeLeft #-}
dropTreeRight :: forall a. NTZipper a -> Maybe (NTZipper a)
dropTreeRight = forall a. NTZipper a -> Maybe (NTZipper a)
dropFromTheRight
{-# INLINE dropTreeRight #-}
substThisTree :: forall a. NTree a -> NTZipper a -> NTZipper a
substThisTree NTree a
t NTZipper a
nt = NTZipper a
nt { ntree :: NTree a
ntree = NTree a
t }
{-# INLINE substThisTree #-}