module Zipper
where
import Data.Tree
import Control.Monad.State --(State,modify,gets)
data Context a = Top { pointer :: Int}
| Child { node :: a,
parent :: Context a,
left_siblings :: [Tree a],
right_siblings :: [Tree a],
pointer :: Int
}
deriving (Show, Eq)
data TreeLoc a = Loc { tree :: Tree a,
context :: Context a
}
deriving (Show, Eq)
down :: TreeLoc a -> TreeLoc a
down (Loc (Node v []) c) = Loc (Node v []) c
down (Loc (Node v (x:xs)) c) = let (t:ls,rs) = split [] (x:xs) (pointer c)
c' = Child v c ls rs 1
in Loc t c'
up :: TreeLoc a -> TreeLoc a
up (Loc loc (Top p)) = Loc loc (Top p)
up (Loc loc (Child n c ls rs p)) = Loc (Node n (combine ls loc rs)) c
turnRight :: TreeLoc a -> TreeLoc a
turnRight (Loc t c) = Loc t c{pointer = 1+(((pointer c) + 1) `mod` childLength)}
where childLength = length (subForest t)
turnLeft :: TreeLoc a -> TreeLoc a
turnLeft (Loc t c) = Loc t c{pointer = 1+(((pointer c) - 1) `mod` childLength)}
where childLength = length (subForest t)
getNode :: TreeLoc a -> a
getNode = rootLabel . tree
split :: (Num t) => [t1] -> [t1] -> t -> ([t1], [t1])
split acc xs 0 = (acc,xs)
split acc (x:xs) n = split (x:acc) xs $! n-1
combine :: [a] -> a -> [a] -> [a]
combine ls t rs = foldl (flip (:)) (t:rs) ls
addZipper :: Tree a -> TreeLoc a
addZipper = flip Loc (Top 1)