1. {-# LANGUAGE GADTs #-}
2.
3. import Prelude hiding (foldr)
4. import Data.Monoid
5. import Data.Foldable
6.
7. class Heap h where
8. empty :: Ord a => h a
9. isEmpty :: Ord a => h a -> Bool
10. insert :: Ord a => a -> h a -> h a
11. findMin :: Ord a => h a -> a
12. deleteMin :: Ord a => h a -> h a
13.
14. data ListHeap a where
15. LH :: Ord a => [a] -> ListHeap a
16.
17. insertOrdered :: Ord a => a -> [a] -> [a]
18. insertOrdered a [] = [a]
19. insertOrdered a (x:xs) = if a < x then a:x:xs else x:(insertOrdered a xs)
20.
21. instance Show a => Show (ListHeap a) where
22. show (LH xs) = "ListHeap " ++ (show xs)
23.
24. instance Heap ListHeap where
25. empty = LH []
26.
27. isEmpty (LH xs) = null xs
28.
29. insert a (LH xs) = LH \$ insertOrdered a xs
30.
31. findMin (LH []) = error "Empty heap"
32. findMin (LH (x:xs)) = x
33.
34. deleteMin (LH []) = error "Empty heap"
35. deleteMin (LH (x:xs)) = LH xs
36.
37. -- Suppose the inner structure is complex so we don't want
38. -- to use it directy, but we still have to pattern-match on it
39. instance Foldable ListHeap where
40. foldMap f h@(LH _)
41. | isEmpty h = mempty
42. | otherwise = f (findMin h) `mappend` foldMap f (deleteMin h)
43.
44. -- Yep, we are foldable!
45. fromList :: Ord a => [a] -> ListHeap a
46. fromList = foldr insert empty
47.
48. main = do let h = fromList [1, 5, 3, 7, 9]
49. print \$ insert 10 h
Success #stdin #stdout 0.01s 3600KB
stdin
Standard input is empty
stdout
ListHeap [1,3,5,7,9,10]