]> gitweb @ CieloNegro.org - hs-rrdtool.git/blob - Data/HList/Heap.hs
acd479fb962091308158adf6f2fd36987ce3bb2a
[hs-rrdtool.git] / Data / HList / Heap.hs
1 {-# LANGUAGE
2   EmptyDataDecls,
3   TypeFamilies,
4   TypeOperators,
5   UndecidableInstances
6   #-}
7 module Data.HList.Heap
8     ( Heap
9
10     , Empty
11     , Unit
12     , Insert
13     , Merge
14     , MergeAll
15     , IsEmpty
16     , FindMin
17     , DeleteMin
18     , SplitMin
19     )
20     where
21
22 import Data.HList
23 import Types.Data.Bool
24 import Types.Data.Ord
25
26
27 data Empty
28 data Node key value heaps
29
30 class Heap h
31 instance Heap Empty
32 instance Heap hs => Heap (Node k v hs)
33
34 type Unit k v = Node k v Nil
35
36 type family   IsEmpty h
37 type instance IsEmpty Empty         = True
38 type instance IsEmpty (Node k v hs) = False
39
40 type Insert k v h = Merge (Unit k v) h
41
42 type family   Merge h1 h2
43 type instance Merge h1 Empty = h1
44 type instance Merge Empty h2 = h2
45 type instance Merge (Node k1 v1 hs1) (Node k2 v2 hs2)
46     = If (k1 :<: k2)
47         (Node k1 v1 (Cons (Node k2 v2 hs2) hs1))
48         (Node k2 v2 (Cons (Node k1 v1 hs1) hs2))
49
50 type family   MergeAll hs
51 type instance MergeAll Nil          = Empty
52 type instance MergeAll (Cons h Nil) = h
53 type instance MergeAll (Cons h (Cons h' hs))
54     = Merge (Merge h h') (MergeAll hs)
55
56 type family   FindMin h
57 type instance FindMin (Node k v hs) = Cons k v
58
59 type family   DeleteMin h
60 type instance DeleteMin Empty         = Empty
61 type instance DeleteMin (Node k v hs) = MergeAll hs
62
63 type family   SplitMin h
64 type instance SplitMin (Node k v hs) = Cons k (Cons v (MergeAll hs))