module Zipper where

data Tree a = Item a
            | Section [Tree a]
   deriving (Show, Eq)

data Path a = Top
            | Node [Tree a] (Path a) [Tree a]
   deriving (Show, Eq)

data Location a = Loc (Tree a) (Path a)
   deriving (Show, Eq)

goLeft :: Location a -> Location a
goLeft (Loc _ Top) = error "Can't go left of top"
goLeft (Loc t (Node (l:left) up right)) = Loc l (Node left up (t:right))
goLeft (Loc _ (Node [] _ _)) = error "Can't go left of first"

goRight :: Location a -> Location a
goRight (Loc _ Top) = error "Can't go right of top"
goRight (Loc t (Node left up (r:right))) = Loc r (Node (t:left) up right)
goRight _           = error "Can't go right of last"

goUp :: Location a -> Location a
goUp (Loc _ Top) = error "Can't go up from top"
goUp (Loc t (Node left up right)) = Loc (Section (reverse left ++ t:right)) up

goDown :: Location a -> Location a
goDown (Loc (Item _) _) = error "Can't go down from item"
goDown (Loc (Section (t1:trees)) p) = Loc t1 (Node [] p trees)

nth :: Location a -> Int -> Location a
nth loc = go
  where go 1             = goDown loc
        go n | n > 0     = goRight (go (n-1))
             | otherwise = error "nth expects a positive int"

replace :: Location a -> Tree a -> Location a
replace (Loc _ p) t = Loc t p

insertRight :: Location a -> Tree a -> Location a
insertRight (Loc _ Top) _ = error "Can't insert right of top"
insertRight (Loc t (Node left up right)) r = Loc t (Node left up (r:right))

insertLeft :: Location a -> Tree a -> Location a
insertLeft (Loc _ Top) _ = error "Can't insert left of top"
insertLeft (Loc t (Node left up right)) l = Loc t (Node (l:left) up right)

insertDown :: Location a -> Tree a -> Location a
insertDown (Loc (Item _) _) _ = error "Can't insert down of an item"
insertDown (Loc (Section sons) p) t1 = Loc t1 (Node [] p sons)