import Data.List

data BinTree a = Empty
                | Node a (BinTree a) (BinTree a)
                deriving (Eq, Ord)
                -- declare BinTree a to be an instance of Show
                instance (Show a) => Show (BinTree a) where
                  -- will start by a '<' before the root
                  -- and put a : a begining of line
                  show t = "< " ++ replace '\n' "\n: " (treeshow "" t)
                  where
                    -- treeshow pref Tree
                    --   shows a tree and starts each line with pref
                    -- We don't display the Empty tree
                    treeshow pref Empty = ""
                    -- Leaf
                    treeshow pref (Node x Empty Empty) =
                      (pshow pref x)

                      -- Right branch is empty
                      treeshow pref (Node x left Empty) =
                        (pshow pref x) ++ "\n" ++
                        (showSon pref "`--" "   " left)

                        -- Left branch is empty
                        treeshow pref (Node x Empty right) =
                          (pshow pref x) ++ "\n" ++
                          (showSon pref "`--" "   " right)

                          -- Tree with left and right children non empty
                          treeshow pref (Node x left right) =
                            (pshow pref x) ++ "\n" ++
                            (showSon pref "|--" "|  " left) ++ "\n" ++
                            (showSon pref "`--" "   " right)

                            -- shows a tree using some prefixes to make it nice
                            showSon pref before next t =
                              pref ++ before ++ treeshow (pref ++ next) t

                              -- pshow replaces "\n" by "\n"++pref
                              pshow pref x = replace '\n' ("\n"++pref) (show x)

                              -- replaces one char by another string
                              replace c new string =
                                concatMap (change c new) string
                                where
                                  change c new x
                                  | x == c = new
                                  | otherwise = x:[] -- "x"

treeFromList :: (Ord a) => [a] -> BinTree a
treeFromList [] = Empty
treeFromList (x:xs) = Node x (treeFromList (filter (<x) xs))
                             (treeFromList (filter (>x) xs))


main = print $ treeFromList [7,2,4,8]
