52 lines
1.8 KiB
Haskell
52 lines
1.8 KiB
Haskell
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)
|