module ELynx.Tree.Zipper
(
TreePos (..),
fromTree,
toTree,
goParent,
goParentUnsafe,
goRoot,
goLeft,
goRight,
goChild,
goChildUnsafe,
Path,
goPath,
goPathUnsafe,
getSubTreeUnsafe,
isValidPath,
isLeafPath,
insertTree,
modifyTree,
insertBranch,
insertLabel,
)
where
import Data.Foldable
import ELynx.Tree.Rooted
data TreePos e a = Pos
{
forall e a. TreePos e a -> Tree e a
current :: Tree e a,
forall e a. TreePos e a -> Forest e a
before :: Forest e a,
forall e a. TreePos e a -> Forest e a
after :: Forest e a,
forall e a. TreePos e a -> [(Forest e a, e, a, Forest e a)]
parents :: [([Tree e a], e, a, [Tree e a])]
}
deriving (Int -> TreePos e a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> TreePos e a -> ShowS
forall e a. (Show e, Show a) => [TreePos e a] -> ShowS
forall e a. (Show e, Show a) => TreePos e a -> String
showList :: [TreePos e a] -> ShowS
$cshowList :: forall e a. (Show e, Show a) => [TreePos e a] -> ShowS
show :: TreePos e a -> String
$cshow :: forall e a. (Show e, Show a) => TreePos e a -> String
showsPrec :: Int -> TreePos e a -> ShowS
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> TreePos e a -> ShowS
Show, TreePos e a -> TreePos e a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a. (Eq e, Eq a) => TreePos e a -> TreePos e a -> Bool
/= :: TreePos e a -> TreePos e a -> Bool
$c/= :: forall e a. (Eq e, Eq a) => TreePos e a -> TreePos e a -> Bool
== :: TreePos e a -> TreePos e a -> Bool
$c== :: forall e a. (Eq e, Eq a) => TreePos e a -> TreePos e a -> Bool
Eq)
fromTree :: Tree e a -> TreePos e a
fromTree :: forall e a. Tree e a -> TreePos e a
fromTree Tree e a
t = Pos {current :: Tree e a
current = Tree e a
t, before :: Forest e a
before = [], after :: Forest e a
after = [], parents :: [(Forest e a, e, a, Forest e a)]
parents = []}
toTree :: TreePos e a -> Tree e a
toTree :: forall e a. TreePos e a -> Tree e a
toTree = forall e a. TreePos e a -> Tree e a
current forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. TreePos e a -> TreePos e a
goRoot
getForest :: TreePos e a -> Forest e a
getForest :: forall e a. TreePos e a -> Forest e a
getForest TreePos e a
pos = 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 (:)) (forall e a. TreePos e a -> Tree e a
current TreePos e a
pos forall a. a -> [a] -> [a]
: forall e a. TreePos e a -> Forest e a
after TreePos e a
pos) (forall e a. TreePos e a -> Forest e a
before TreePos e a
pos)
goParent :: TreePos e a -> Maybe (TreePos e a)
goParent :: forall e a. TreePos e a -> Maybe (TreePos e a)
goParent TreePos e a
pos = case forall e a. TreePos e a -> [(Forest e a, e, a, Forest e a)]
parents TreePos e a
pos of
([Tree e a]
ls, e
br, a
lb, [Tree e a]
rs) : [([Tree e a], e, a, [Tree e a])]
ps ->
forall a. a -> Maybe a
Just
Pos
{ current :: Tree e a
current = forall e a. e -> a -> Forest e a -> Tree e a
Node e
br a
lb forall a b. (a -> b) -> a -> b
$ forall e a. TreePos e a -> Forest e a
getForest TreePos e a
pos,
before :: [Tree e a]
before = [Tree e a]
ls,
after :: [Tree e a]
after = [Tree e a]
rs,
parents :: [([Tree e a], e, a, [Tree e a])]
parents = [([Tree e a], e, a, [Tree e a])]
ps
}
[] -> forall a. Maybe a
Nothing
goParentUnsafe :: TreePos e a -> TreePos e a
goParentUnsafe :: forall e a. TreePos e a -> TreePos e a
goParentUnsafe TreePos e a
pos = case forall e a. TreePos e a -> [(Forest e a, e, a, Forest e a)]
parents TreePos e a
pos of
([Tree e a]
ls, e
br, a
lb, [Tree e a]
rs) : [([Tree e a], e, a, [Tree e a])]
ps ->
Pos
{ current :: Tree e a
current = forall e a. e -> a -> Forest e a -> Tree e a
Node e
br a
lb forall a b. (a -> b) -> a -> b
$ forall e a. TreePos e a -> Forest e a
getForest TreePos e a
pos,
before :: [Tree e a]
before = [Tree e a]
ls,
after :: [Tree e a]
after = [Tree e a]
rs,
parents :: [([Tree e a], e, a, [Tree e a])]
parents = [([Tree e a], e, a, [Tree e a])]
ps
}
[] -> forall a. HasCallStack => String -> a
error String
"goUpUnsafe: No parent found."
goRoot :: TreePos e a -> TreePos e a
goRoot :: forall e a. TreePos e a -> TreePos e a
goRoot TreePos e a
pos = forall b a. b -> (a -> b) -> Maybe a -> b
maybe TreePos e a
pos forall e a. TreePos e a -> TreePos e a
goRoot (forall e a. TreePos e a -> Maybe (TreePos e a)
goParent TreePos e a
pos)
goLeft :: TreePos e a -> Maybe (TreePos e a)
goLeft :: forall e a. TreePos e a -> Maybe (TreePos e a)
goLeft TreePos e a
pos =
case forall e a. TreePos e a -> Forest e a
before TreePos e a
pos of
Tree e a
t : [Tree e a]
ts ->
forall a. a -> Maybe a
Just
TreePos e a
pos
{ current :: Tree e a
current = Tree e a
t,
before :: [Tree e a]
before = [Tree e a]
ts,
after :: [Tree e a]
after = forall e a. TreePos e a -> Tree e a
current TreePos e a
pos forall a. a -> [a] -> [a]
: forall e a. TreePos e a -> Forest e a
after TreePos e a
pos
}
[] -> forall a. Maybe a
Nothing
goRight :: TreePos e a -> Maybe (TreePos e a)
goRight :: forall e a. TreePos e a -> Maybe (TreePos e a)
goRight TreePos e a
pos =
case forall e a. TreePos e a -> Forest e a
after TreePos e a
pos of
Tree e a
t : [Tree e a]
ts ->
forall a. a -> Maybe a
Just
TreePos e a
pos
{ current :: Tree e a
current = Tree e a
t,
before :: [Tree e a]
before = forall e a. TreePos e a -> Tree e a
current TreePos e a
pos forall a. a -> [a] -> [a]
: forall e a. TreePos e a -> Forest e a
before TreePos e a
pos,
after :: [Tree e a]
after = [Tree e a]
ts
}
[] -> forall a. Maybe a
Nothing
goChild :: Int -> TreePos e a -> Maybe (TreePos e a)
goChild :: forall e a. Int -> TreePos e a -> Maybe (TreePos e a)
goChild Int
n TreePos e a
pos = case forall e a. TreePos e a -> Tree e a
current TreePos e a
pos of
(Node e
br a
lb Forest e a
ts)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null Forest e a
ts -> forall a. Maybe a
Nothing
| forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest e a
ts forall a. Ord a => a -> a -> Bool
<= Int
n -> forall a. Maybe a
Nothing
| Bool
otherwise ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
Pos
{ current :: Tree e a
current = forall a. [a] -> a
head Forest e a
rs',
before :: Forest e a
before = forall a. [a] -> [a]
reverse Forest e a
ls',
after :: Forest e a
after = forall a. [a] -> [a]
tail Forest e a
rs',
parents :: [(Forest e a, e, a, Forest e a)]
parents = (forall e a. TreePos e a -> Forest e a
before TreePos e a
pos, e
br, a
lb, forall e a. TreePos e a -> Forest e a
after TreePos e a
pos) forall a. a -> [a] -> [a]
: forall e a. TreePos e a -> [(Forest e a, e, a, Forest e a)]
parents TreePos e a
pos
}
where
(Forest e a
ls', Forest e a
rs') = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n Forest e a
ts
goChildUnsafe :: Int -> TreePos e a -> TreePos e a
goChildUnsafe :: forall e a. Int -> TreePos e a -> TreePos e a
goChildUnsafe Int
n TreePos e a
pos = case forall e a. TreePos e a -> Tree e a
current TreePos e a
pos of
(Node e
br a
lb Forest e a
ts)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null Forest e a
ts -> forall a. HasCallStack => String -> a
error String
"goChildUnsafe: Forest is empty."
| forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest e a
ts forall a. Ord a => a -> a -> Bool
<= Int
n -> forall a. HasCallStack => String -> a
error String
"goChildUnsafe: Forest is too short."
| Bool
otherwise ->
Pos
{ current :: Tree e a
current = forall a. [a] -> a
head Forest e a
rs',
before :: Forest e a
before = forall a. [a] -> [a]
reverse Forest e a
ls',
after :: Forest e a
after = forall a. [a] -> [a]
tail Forest e a
rs',
parents :: [(Forest e a, e, a, Forest e a)]
parents = (forall e a. TreePos e a -> Forest e a
before TreePos e a
pos, e
br, a
lb, forall e a. TreePos e a -> Forest e a
after TreePos e a
pos) forall a. a -> [a] -> [a]
: forall e a. TreePos e a -> [(Forest e a, e, a, Forest e a)]
parents TreePos e a
pos
}
where
(Forest e a
ls', Forest e a
rs') = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n Forest e a
ts
type Path = [Int]
goPath :: Path -> TreePos e a -> Maybe (TreePos e a)
goPath :: forall e a. Path -> TreePos e a -> Maybe (TreePos e a)
goPath Path
pos TreePos e a
pth = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e a. Int -> TreePos e a -> Maybe (TreePos e a)
goChild) TreePos e a
pth Path
pos
isValidPath :: Tree e a -> Path -> Bool
isValidPath :: forall e a. Tree e a -> Path -> Bool
isValidPath Tree e a
t Path
p = case forall e a. Path -> TreePos e a -> Maybe (TreePos e a)
goPath Path
p (forall e a. Tree e a -> TreePos e a
fromTree Tree e a
t) of
Maybe (TreePos e a)
Nothing -> Bool
False
Just TreePos e a
_ -> Bool
True
isLeafPath :: Tree e a -> Path -> Bool
isLeafPath :: forall e a. Tree e a -> Path -> Bool
isLeafPath Tree e a
t Path
p = case forall e a. Path -> TreePos e a -> Maybe (TreePos e a)
goPath Path
p (forall e a. Tree e a -> TreePos e a
fromTree Tree e a
t) of
Maybe (TreePos e a)
Nothing -> Bool
False
Just TreePos e a
pos -> forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall e a. Tree e a -> Forest e a
forest (forall e a. TreePos e a -> Tree e a
current TreePos e a
pos)
goPathUnsafe :: Path -> TreePos e a -> TreePos e a
goPathUnsafe :: forall e a. Path -> TreePos e a -> TreePos e a
goPathUnsafe Path
pos TreePos e a
pth =
{-# SCC "goPathUnsafe" #-}
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 forall e a. Int -> TreePos e a -> TreePos e a
goChildUnsafe) TreePos e a
pth Path
pos
getSubTreeUnsafe :: Path -> Tree e a -> Tree e a
getSubTreeUnsafe :: forall e a. Path -> Tree e a -> Tree e a
getSubTreeUnsafe Path
p = forall e a. TreePos e a -> Tree e a
current forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Path -> TreePos e a -> TreePos e a
goPathUnsafe Path
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Tree e a -> TreePos e a
fromTree
insertTree :: Tree e a -> TreePos e a -> TreePos e a
insertTree :: forall e a. Tree e a -> TreePos e a -> TreePos e a
insertTree Tree e a
t TreePos e a
pos = TreePos e a
pos {current :: Tree e a
current = Tree e a
t}
modifyTree :: (Tree e a -> Tree e a) -> TreePos e a -> TreePos e a
modifyTree :: forall e a. (Tree e a -> Tree e a) -> TreePos e a -> TreePos e a
modifyTree Tree e a -> Tree e a
f TreePos e a
pos = TreePos e a
pos {current :: Tree e a
current = Tree e a -> Tree e a
f Tree e a
t}
where
t :: Tree e a
t = forall e a. TreePos e a -> Tree e a
current TreePos e a
pos
insertBranch :: e -> TreePos e a -> TreePos e a
insertBranch :: forall e a. e -> TreePos e a -> TreePos e a
insertBranch e
br TreePos e a
pos = case forall e a. TreePos e a -> Tree e a
current TreePos e a
pos of
Node e
_ a
lb Forest e a
ts -> TreePos e a
pos {current :: Tree e a
current = forall e a. e -> a -> Forest e a -> Tree e a
Node e
br a
lb Forest e a
ts}
insertLabel :: a -> TreePos e a -> TreePos e a
insertLabel :: forall a e. a -> TreePos e a -> TreePos e a
insertLabel a
lb TreePos e a
pos = case forall e a. TreePos e a -> Tree e a
current TreePos e a
pos of
Node e
br a
_ Forest e a
ts -> TreePos e a
pos {current :: Tree e a
current = forall e a. e -> a -> Forest e a -> Tree e a
Node e
br a
lb Forest e a
ts}