okasaki

commit a96d53bb8633c9f0590f46a9f45e32379737d25c
parent b561ca30f9b8c2e0ddbeb22983726f6556322151
Author: Jared Tobin <jared@jtobin.io>
Date:   Thu,  6 Apr 2023 18:31:35 +0400

Generics work.

Diffstat:
M
lib/Okasaki/Heap/Class.hs
 | 
65
++++++++++++++++++++++++++++++++++++++++++++++++++++++-----------

1 file changed, 54 insertions(+), 11 deletions(-)
diff --git a/lib/Okasaki/Heap/Class.hs b/lib/Okasaki/Heap/Class.hs
@@ -1,18 +1,61 @@
+{-# OPTIONS_GHC -Wall #-}
 
 module Okasaki.Heap.Class where
 
+import Data.Kind (Type)
 import qualified Okasaki.Heap.Binomial as B
-import qualified Okasaki.Heap.Leftist as L
-import qualified Okasaki.Heap.Leftist.Weighted as W
 
-class Heap (h :: * -> *) where
-  bot :: Ord a => h a -> Maybe a
-  put :: Ord a => a -> h a -> h a
-  mer :: Ord a => h a -> h a -> h a
-  cut :: Ord a => h a -> h a
+-- NB these need to be newtyped to be made proper instances
+-- import qualified Okasaki.Heap.Leftist as L
+-- import qualified Okasaki.Heap.Leftist.Weighted as W
+
+-- exercise 3.7: generic explicit-min heap
+class Heap (h :: Type -> Type) where
+  data Pile h :: Type -> Type
+
+  via :: Ord a => h a -> Pile h a
+  bot :: Ord a => Pile h a -> Maybe a
+  put :: Ord a => a -> Pile h a -> Pile h a
+  cut :: Ord a => Pile h a -> Pile h a
+  mer :: Ord a => Pile h a -> Pile h a -> Pile h a
+  out :: Pile h a -> h a
 
 instance Heap B.Heap where
-  bot = B.bot
-  put = B.put
-  mer = B.mer
-  cut = B.cut
+  data Pile B.Heap a =
+      Nib
+    | Bin a (B.Heap a)
+
+  via = \case
+    B.Heap [] -> Nib
+    h -> let b = B.bot h
+         in  case b of
+               Nothing -> Nib
+               Just a  -> Bin a h
+
+  bot = \case
+    Nib     -> Nothing
+    Bin a _ -> Just a
+
+  put a = \case
+    Nib -> Bin a (B.put a B.lef)
+    Bin m h
+      | a < m     -> Bin a (B.put a h)
+      | otherwise -> Bin m (B.put a h)
+
+  cut h = case h of
+    Nib -> Nib
+    Bin _ t ->
+      let c = B.cut t
+      in  case B.bot c of
+            Nothing -> Nib
+            Just a  -> Bin a c
+
+  mer h l = case (h, l) of
+    (Nib, _) -> l
+    (_, Nib) -> h
+    (Bin a s, Bin b t) -> Bin (min a b) (B.mer s t)
+
+  out = \case
+    Nib -> B.lef
+    Bin _ h -> h
+