stdin

stdin

data Tree a        = EmptyTree | Node a (Tree a) (Tree a) deriving (Show, Eq)
data Crumb a       = LeftCrumb a (Tree a) | RightCrumb a (Tree a) deriving (Show)
type Breadcrumbs a = [Crumb a] 
type Zipper a      = (Tree a, Breadcrumbs a)

x -: f = f x


-- |Creates a tree of a single root node
createTree :: a -> Tree a
createTree x = Node x EmptyTree EmptyTree

-- |Insert a value into a binary tree
treeInsert :: (Ord a) => a -> Tree a -> Tree a
treeInsert x EmptyTree = createTree x
treeInsert x (Node a left right)
    | x == a = Node x left right
    | x < a  = Node a (treeInsert x left) right
    | x > a  = Node a left (treeInsert x right)


goLeft :: (Tree a, Breadcrumbs a) -> (Tree a, Breadcrumbs a)
goLeft (Node x l r, bc) = (l, LeftCrumb x r:bc)

goRight :: (Tree a, Breadcrumbs a) -> (Tree a, Breadcrumbs a)
goRight (Node x l r, bc) = (r, RightCrumb x l:bc)

goUp :: (Tree a, Breadcrumbs a) -> (Tree a, Breadcrumbs a)
goUp (t, LeftCrumb x r:bc)  = (Node x t r, bc)
goUp (t, RightCrumb x l:bc) = (Node x l t, bc)

-- |Returns a left subtree of the element
getLeftmost :: (Eq a) => Zipper a -> Zipper a
getLeftmost (Node x l r, bc)
    | l /= EmptyTree = getLeftmost . goLeft $ (Node x l r, bc)
    | otherwise      = (Node x l r, bc)


-- |Modify an element of a tree and return the result
modify :: (a -> a) -> Zipper a -> Zipper a
modify f (Node x l r, bc) = (Node (f x) l r, bc)
modify _ (EmptyTree, bc)  = (EmptyTree, bc)

-- |Attaches the tree at the currently selected node
attach :: Tree a -> Zipper a -> Zipper a
attach t (_, bc) = (t, bc)

-- |Goes to the topmost place in the tree
topMost :: Zipper a -> Zipper a
topMost (t, []) = (t, [])
topMost z       = topMost (goUp z)

-- |Finds an element in the tree
findElem :: (Ord a) => a -> Zipper a -> Zipper a
findElem a (EmptyTree, bc) = (EmptyTree, bc)
findElem a (Node x l r, bc)
    | a == x = (Node x l r, bc)
    | a < x  = findElem a $ goLeft (Node x l r, bc)
    | a > x  = findElem a $ goRight (Node x l r, bc)

-- |Gets a successor of the element
getSuccessor :: (Ord a) => a -> Zipper a -> Zipper a
getSuccessor a zipper 
    | r /= EmptyTree = getLeftmost . goRight $ (Node x l r, bc)
    | otherwise      = (EmptyTree, snd zipper)
    where 
        (Node x l r, bc) = findElem a zipper


-- | Fix the delete methods:P

-- |Removes a node which has no children
removeNode :: (Eq a) => Zipper a -> Zipper a
removeNode (Node x l r, (LeftCrumb a rt):bc)  = (Node a EmptyTree rt, bc)
removeNode (Node x l r, (RightCrumb a lt):bc) = (Node a lt EmptyTree, bc)
removeNode (_, []) = (EmptyTree, [])


-- |Removes a node with a single child
removeNode' :: (Eq a) => Zipper a -> Zipper a
removeNode' (Node x EmptyTree r, (LeftCrumb a rt):bc)  = (Node a r rt, bc)
removeNode' (Node x l EmptyTree, (LeftCrumb a rt):bc)  = (Node a l rt, bc)
removeNode' (Node x EmptyTree r, (RightCrumb a lt):bc) = (Node a lt r, bc)
removeNode' (Node x l EmptyTree, (RightCrumb a lt):bc) = (Node a lt l, bc)
removeNode' (Node x EmptyTree r, []) = (r, [])
removeNode' (Node x l EmptyTree, []) = (l, [])


-- |Removes a note with two children
removeNode'' :: (Ord a) => Zipper a -> Zipper a
removeNode'' (Node x l r, bc) = attach (removeElem s (Node s sl sr)) (EmptyTree, bc) 
-- ?? we want to delete the successor and put its value in current node
    where 
        (Node s sl sr, sc) = getSuccessor x (Node x l r, bc)


-- |Provides a new tree with the given element removed
removeElem :: (Ord a) => a -> Tree a -> Tree a
removeElem x tree
    | l == EmptyTree && r == EmptyTree = 
        fst . topMost . removeNode $ currentNode
    | l == EmptyTree || r == EmptyTree =
        fst . topMost . removeNode' $ currentNode
    | l /= EmptyTree && r /= EmptyTree =
        fst . topMost . removeNode'' $ currentNode
    | otherwise = tree
    where
        (Node a l r, bc) = findElem x (tree, [])
        currentNode = (Node a l r, bc)