BST in Haskell

bintree.hs

module BinTree where

data BinTree k v = BinTree { key   :: k
                           , value :: v
                           , left  :: Maybe (BinTree k v)
                           , right :: Maybe (BinTree k v) }
                           deriving (Show)

insert :: (Ord k) => k -> v -> Maybe (BinTree k v) -> Maybe (BinTree k v)
insert k' v' Nothing = Just $ BinTree k' v' Nothing Nothing
insert k' v' (Just (BinTree k v l r))
  | k' <  k = insert k' v' l >>= \e -> Just $ BinTree k v (Just e) r
  | k' >  k = insert k' v' r >>= \e -> Just $ BinTree k v l (Just e)
  | k' == k = Nothing

retrieve :: (Ord k) => k -> Maybe (BinTree k v) -> Maybe v
retrieve k' Nothing = Nothing
retrieve k' (Just (BinTree k v l r))
  | k' <  k = retrieve k' l
  | k' >  k = retrieve k' r
  | k' == k = Just v

delete :: (Ord k) => k -> Maybe (BinTree k v) -> Maybe (Maybe (BinTree k v))
delete k' Nothing = Nothing
delete k' (Just (BinTree k v l r))
  | k' <  k = delete k' l >>= \e -> Just $ Just $ BinTree k v e r
  | k' >  k = delete k' r >>= \e -> Just $ Just $ BinTree k v l e
  | k' == k = Just $ maybe l
                           (\(k'', v'', t) -> Just $ BinTree k'' v'' l t)
                           (takeFromLeft r)

takeFromLeft :: Maybe (BinTree k v) -> Maybe (k, v, Maybe (BinTree k v))
takeFromLeft Nothing = Nothing
takeFromLeft (Just (BinTree k v Nothing r)) = Just (k, v, r)
takeFromLeft (Just (BinTree k v l r)) =
  takeFromLeft l
  >>= \(k', v', l') -> Just (k', v', Just $ BinTree k v l' r)

prettyPrint :: (Show k, Show v) => Maybe (BinTree k v) -> IO ()
prettyPrint t = prettyPrint' t 0

prettyPrint' :: (Show k, Show v) => Maybe (BinTree k v) -> Int -> IO ()
prettyPrint' Nothing i = return $ ()
prettyPrint' (Just (BinTree k v l r)) i = 
  prettyPrint' r (i + 1)
  >> prettyPrint'' k v i
  >> prettyPrint' l (i + 1)

prettyPrint'' :: (Show k, Show v) => k -> v -> Int -> IO ()
prettyPrint'' k v i = 
  putStr (take i $ repeat ' ')
  >> putStr (show k)
  >> putChar ':'
  >> putStrLn (show v)