import Html exposing (..)
import Debug
main = text <| toString newTree
newTree = (freeTree, []) |> goLeft |> goRight |> modify (\_ -> 'P') |>
attach (Node 'Z' Empty Empty) |> goUp |> modify (\_ -> 'X') |> topMost
type Tree a = Empty | Node a (Tree a) (Tree a)
freeTree : Tree Char
freeTree =
Node 'P'
(Node 'O'
(Node 'L'
(Node 'N' Empty Empty)
(Node 'T' Empty Empty)
)
(Node 'Y'
(Node 'S' Empty Empty)
(Node 'A' Empty Empty)
)
)
(Node 'L'
(Node 'W'
(Node 'C' Empty Empty)
(Node 'R' Empty Empty)
)
(Node 'A'
(Node 'A' Empty Empty)
(Node 'C' Empty Empty)
)
)
type Direction = L | R
type alias Directions = List Direction
changeToP : Directions -> Tree Char -> Tree Char
changeToP dir tree =
case (dir, tree) of
( L::ds, Node x l r ) -> Node x (changeToP ds l) r
( R::ds, Node x l r ) -> Node x l (changeToP ds r)
( [], Node _ l r ) -> Node 'P' l r
_ -> Debug.crash "Can't change to P!"
elemAt : Directions -> Tree a -> Maybe a
elemAt dir tree =
case (dir, tree) of
( L::ds, Node _ l _ ) -> elemAt ds l
( R::ds, Node _ _ r ) -> elemAt ds r
( [] , Node x _ _ ) -> Just x
_ -> Nothing
type Crumb a = LeftCrumb a (Tree a)
| RightCrumb a (Tree a)
type alias Breadcrumbs a = List (Crumb a)
type alias Zipper a = (Tree a, Breadcrumbs a)
goLeft : Zipper a -> Zipper a
goLeft (tree, bs) =
case (tree, bs) of
( Node x l r, bs) -> ( l, LeftCrumb x r::bs )
_ -> Debug.crash "Doesn't exist Left"
goRight : Zipper a -> Zipper a
goRight (tree, bs) =
case (tree, bs) of
( Node x l r, bs) -> ( r, RightCrumb x l::bs )
_ -> Debug.crash "Doesn't exist Right"
goUp : Zipper a -> Zipper a
goUp (tree, bs) =
case (tree, bs) of
(t, LeftCrumb x r::bs) -> (Node x t r, bs)
(t, RightCrumb x l::bs) -> (Node x l t, bs)
_ -> Debug.crash "Doesn't exist Up"
modify : (a -> a) -> Zipper a -> Zipper a
modify f (tree, bs) =
case (tree, bs) of
(Node x l r, bs) -> (Node (f x) l r, bs)
(Empty, bs) -> (Empty, bs)
attach : Tree a -> Zipper a -> Zipper a
attach t (_, bs) = (t, bs)
topMost : Zipper a -> Zipper a
topMost ((tree, bs) as z) =
case z of
(t, []) -> (t, [])
z -> topMost (goUp z)