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)