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)