red-black tree

import System.IO
--import Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set

data Color = Red | Black deriving (Eq)
instance Show(Color) where
    show c
        | c == Red = "0"
        | otherwise = "1"

data BinTree a = Node Color a (BinTree a) (BinTree a) | Leaf deriving (Eq)

instance Show a => Show(BinTree a) where
    show t = show1 t 0 where
        show1 Leaf _ = "\n"
        show1 (Node c x l r) n =
            show1 l (n + 2) ++ (replicate n ' ') ++ (show c)++ show1 r (n + 2)

empty :: BinTree a
empty = Leaf

include :: Ord a => a -> BinTree a -> Bool
include _ Leaf = False
include x (Node _ a left right)
    | x == a = True
    | x > a = include x right
    | otherwise = include x left

insert :: Ord a => BinTree a -> a -> BinTree a
insert tree x = insertOne $ insertLeaf tree x

insertOne :: BinTree a -> BinTree a
insertOne (Node color x left right) = Node Black x left right

insertLeaf :: Ord a => BinTree a -> a -> BinTree a
insertLeaf Leaf x = Node Red x Leaf Leaf
insertLeaf (Node color a left right) x
    | x == a = Node color a left right
    | x > a = balance_ins color a left (insertLeaf right x)
    | otherwise = balance_ins color a (insertLeaf left x) right

delete :: Ord a => BinTree a -> a -> BinTree a
delete (Node color a left right) x
    | a == x = delete_current (Node color a left right)
    | x > a = balance color a left (delete right x)
    | otherwise = balance color a (delete left x) right

delete_current :: Ord a => BinTree a -> BinTree a
delete_current (Node color a left right)
    | left == Leaf && right == Leaf = Leaf
    | left == Leaf = right
    | right == Leaf = left
    | otherwise = do
        let next = find_next right
        balance color next left (delete right next)


find_next (Node _ a left _)
    | left == Leaf = a
    | otherwise = find_next left

--bal :: Color -> a -> BinTree a -> BinTree a -> BinTree a
--bal Black y (Node Red x a@(Node Red _ _ _) b) (Node Red z c d) = Node Red y (Node Black x a b) (Node Black z c d)
--bal Black y (Node Red x a b@(Node Red _ _ _)) (Node Red z c d) = Node Red y (Node Black x a b) (Node Black z c d)
--bal Black y (Node Red x a b) (Node Red z c@(Node Red _ _ _) d) = Node Red y (Node Black x a b) (Node Black z c d)
--bal Black y (Node Red x a b) (Node Red z c d@(Node Red _ _ _)) = Node Red y (Node Black x a b) (Node Black z c d)

--bal Black y (Node Red x a@(Node Red _ _ _) b) c = Node Black x a (Node Red y b c)
--bal Black x a (Node Red y b c@(Node Red _ _ _)) = Node Black y (Node Red x a b) c

--bal Black z (Node Red x a (Node Red y b c)) d = Node Black y (Node Red x a b) (Node Red z c d)
--bal Black x a (Node Red z (Node Red y b c) d) = Node Black y (Node Red x a b) (Node Red z c d)

--bal color a x b = Node color a x b

balance_ins :: Color -> a -> BinTree a -> BinTree a -> BinTree a
balance_ins Black b (Node Red a (Node Red x Leaf Leaf) Leaf) (Node Red c Leaf Leaf) = Node Red b (Node Black a (Node Red x Leaf Leaf) Leaf) (Node Black c Leaf Leaf)
balance_ins Black b (Node Red a (Node Red x Leaf Leaf) Leaf) Leaf = Node Red b (Node Black a (Node Red x Leaf Leaf) Leaf) Leaf

balance_ins Black b (Node Red c Leaf Leaf) (Node Red a Leaf (Node Red x Leaf Leaf)) = Node Red b (Node Black c Leaf Leaf) (Node Black a Leaf (Node Red x Leaf Leaf))
balance_ins Black b Leaf (Node Red a Leaf (Node Red x Leaf Leaf)) = Node Red b Leaf (Node Black a Leaf (Node Red x Leaf Leaf))

balance_ins Black b (Node Red a (Node Red x left right) right1) c = Node Black a (Node Red x left right) (Node Red b right1 c)
balance_ins Black b (Node Red a (Node Red x left right) right1) c = Node Black a (Node Red x left right) (Node Red b right1 c)
balance_ins c a b z = Node c a b z

balance_del :: Color -> a -> BinTree a -> BinTree a -> BinTree a
balance_del Black a (Node Black x l r) (Node Red b c d) = Node Black b (Node Red a (Node Black x l r) c) d
balance_del color a (Node Black x l r) (Node Black b c@(Node Black _ _ _) d@(Node Black _ _ _)) = Node Black a (Node Black x l r) (Node Red b c d)
balance_del color a (Node Black x l r) (Node Black b (Node Red c l1 r1) d@(Node Black _ _ _)) = Node color a (Node Black x l r) (Node Black c l1 (Node Red b r1 d))
balance_del color a (Node Black x l r) (Node Black b (Node color2 c l1 r1) d) = Node color b (Node Black a (Node Black x l r) (Node color2 c l1 r1)) d
balance_del color a x b = Node color a x b

balance :: Color -> a -> BinTree a -> BinTree a -> BinTree a
balance Black z (Node Red y (Node Red x a b) c) d = Node Red y (Node Black x a b) (Node Black z c d)
balance Black z (Node Red x a (Node Red y b c)) d = Node Red y (Node Black x a b) (Node Black z c d)
balance Black x a (Node Red y b (Node Red z c d)) = Node Red y (Node Black x a b) (Node Black z c d)
balance Black x a (Node Red z (Node Red y b c) d) = Node Red y (Node Black x a b) (Node Black z c d)
balance color a x b = Node color a x b

listToTree::Ord a => [a] -> BinTree a
listToTree xs = foldl insert Leaf xs

treeToList:: BinTree a -> [a]
treeToList Leaf = []
treeToList (Node _ x l r) = (treeToList l)++[x]++(treeToList r)

treeSort:: Ord a => [a] -> [a]
treeSort = treeToList.listToTree

height:: BinTree a -> Int
height Leaf = 0
height (Node _ _ l r) = 1 + max (height l) (height r)

main = do
    let tree = listToTree [x | x <- [1..13]]
    print $ tree
    let tree0 = insert tree 18
    print $ tree0
    --let tree1 = delete tree 10
    --print $ tree1
    --let tree2 = delete tree1 4
    --print $ tree2
    --let tree3 = delete tree2 13
    --print $ tree3
    --let tree4 = insert tree3 10
    --print $ tree4
    --let new_tree = insert tree 7
    --print $ new_tree