set.hs

class Set t where
    new :: t a
    insert :: Eq a => Ord a => t a -> a -> t a
    delete :: Eq a => Ord a => t a -> a -> t a
    contains :: Eq a => Ord a => t a -> a -> Bool
    items :: t a -> [a]

data ListSet a = ListSet [a] deriving Show


instance Set ListSet where
    new = ListSet []
    insert (ListSet xs) item = ListSet $ item:xs
    contains (ListSet (x:xs)) item = if x == item
                                   then True
                                   else contains (ListSet xs) item
    contains (ListSet []) _ = False
    delete (ListSet (x:xs)) item = if x == item
                                  then ListSet xs
                                  else delete (ListSet xs) item
    delete (ListSet []) _ = ListSet []
    items (ListSet xs) = xs

data BinTree a = Leaf | Node (BinTree a) a (BinTree a) deriving Show

takeMax :: Eq a => Ord a => BinTree a -> (BinTree a, Maybe a)
takeMax Leaf = (Leaf, Nothing)
takeMax (Node _ a right) = case takeMax right of
                        (node, Nothing) -> (node, Just a)
                        (node, Just b) -> (delete node b, Just b)

items' :: [a] -> BinTree a -> [a]
items' accum Leaf = accum
items' accum (Node left a right) = items' (a : (items' accum right)) left

instance Set BinTree where
    new = Leaf
    insert Leaf a = Node Leaf a Leaf
    insert (Node left a right) val = if a > val
                                     then Node (insert left val) a right
                                     else Node left a (insert right val)
    contains Leaf _ = False
    contains (Node left a right) val | a == val = True
                                     | a > val = contains left val
                                     | a < val = contains right val
    delete Leaf _ = Leaf
    delete (Node left a right) val | a == val = case takeMax left of
                                                (left', Nothing) -> right
                                                (left', Just b) -> Node left' b right
                                   | a > val = Node (delete left val) a right
                                   | a < val = Node left a (delete right val)

    items = items' []

mylist :: BinTree Integer
mylist = delete (insert (insert (insert (insert ( insert new 1) 17 ) 8 ) 4 ) 9) 8

main = putStr $ show $ items mylist