Implementation of Binomial heap from the book Purely functional data structures by Chris Okasaki

BinomialHeap.hs

data BTree a = Node Int a [(BTree a)] deriving Show

data BHeap a = Heap [BTree a] deriving Show

empty :: BHeap a
empty = Heap []

link :: Ord a => BTree a -> BTree a -> BTree a
link t1@(Node r x1 c1) t2@(Node _ x2 c2) =
    if x1 < x2 then
        Node (r+1) x1 (t2:c1)
    else
        Node (r+1) x2 (t1:c2)

rank :: BTree a -> Int
rank (Node r _ _) = r

telem :: BTree a -> a
telem (Node _ x _) = x

insTree :: Ord a => BTree a -> [BTree a] -> [BTree a]
insTree t [] = [t]
insTree t ts1@(t1':ts1') =
    if rank t < rank t1' then
        t:ts1 
    else
        insTree (link t t1') ts1'

insert :: Ord a => BHeap a -> a -> BHeap a
insert (Heap ts) x = Heap $ insTree (Node 0 x []) ts

removeMinTree :: Ord a => [BTree a] -> (BTree a,[BTree a])
removeMinTree [] = error "Cannot remove from empty heap"
removeMinTree [t] = (t, [])
removeMinTree (t:ts) = 
    let 
        (t',ts') = removeMinTree ts
    in
        if telem t < telem t' then
            (t,ts)
        else
            (t',t:ts') 

findMin :: Ord a => BHeap a -> a
findMin (Heap ts) =
    let
        (t,_) = removeMinTree ts
    in
        telem t

merge :: Ord a => [BTree a] -> [BTree a] -> [BTree a]
merge [] ts = ts
merge ts [] = ts
merge ts1@(t1:ts1') ts2@(t2:ts2') =
    if rank t1 < rank t2 then
        t1 : merge ts1' ts2
    else if rank t2 < rank t1 then
        t2 : merge ts1 ts2'
    else
        insTree (link t1 t2) (merge ts1' ts2') 

deleteMin :: Ord a => BHeap a -> BHeap a
deleteMin (Heap ts) =
    let
        ((Node _ _ c) ,ts') = removeMinTree ts
    in
        Heap $ merge (reverse c) ts'


sampleHeap :: BHeap Int
sampleHeap = foldl insert empty [20,2,5,84,-5]