From b8e55c64a68763b0953945476cc75206f5354023 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Tue, 17 May 2022 22:06:01 +0200
Subject: Mergeable class with separate component type

---
 src/Storage/List.hs  |  7 ++-----
 src/Storage/Merge.hs | 13 +++++++------
 2 files changed, 9 insertions(+), 11 deletions(-)

(limited to 'src/Storage')

diff --git a/src/Storage/List.hs b/src/Storage/List.hs
index e112b46..2bef401 100644
--- a/src/Storage/List.hs
+++ b/src/Storage/List.hs
@@ -44,9 +44,6 @@ instance Storable a => Storable (List a) where
 instance Storable a => ZeroStorable (List a) where
     fromZero _ = ListNil
 
-instance Storable a => Mergeable (List a) where
-    mergeSorted xs = ListItem xs Nothing Nothing
-
 
 emptySList :: Storable a => Storage -> IO (StoredList a)
 emptySList st = wrappedStore st ListNil
@@ -78,10 +75,10 @@ groupsFromSLists = helperSelect S.empty . (:[])
     filterRemoved :: S.Set (StoredList a) -> [StoredList a] -> [StoredList a]
     filterRemoved rs = filter (S.null . S.intersection rs . ancestors . (:[]))
 
-fromSList :: Mergeable a => StoredList a -> [a]
+fromSList :: Mergeable a => StoredList (Component a) -> [a]
 fromSList = map merge . groupsFromSLists
 
-storedFromSList :: Mergeable a => StoredList a -> IO [Stored a]
+storedFromSList :: (Mergeable a, Storable a) => StoredList (Component a) -> IO [Stored a]
 storedFromSList = mapM storeMerge . groupsFromSLists
 
 slistAdd :: Storable a => a -> StoredList a -> IO (StoredList a)
diff --git a/src/Storage/Merge.hs b/src/Storage/Merge.hs
index a6ed3ba..6353dad 100644
--- a/src/Storage/Merge.hs
+++ b/src/Storage/Merge.hs
@@ -18,6 +18,7 @@ import Control.Concurrent.MVar
 
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.HashTable.IO as HT
+import Data.Kind
 import Data.List
 import Data.Maybe
 import Data.Set (Set)
@@ -29,17 +30,17 @@ import Storage
 import Storage.Internal
 import Util
 
-class Storable a => Mergeable a where
-    mergeSorted :: [Stored a] -> a
+class Storable (Component a) => Mergeable a where
+    type Component a :: Type
+    mergeSorted :: [Stored (Component a)] -> a
+    toComponents :: a -> [Stored (Component a)]
 
-merge :: Mergeable a => [Stored a] -> a
+merge :: Mergeable a => [Stored (Component a)] -> a
 merge [] = error "merge: empty list"
-merge [x] = fromStored x
 merge xs = mergeSorted $ filterAncestors xs
 
-storeMerge :: Mergeable a => [Stored a] -> IO (Stored a)
+storeMerge :: (Mergeable a, Storable a) => [Stored (Component a)] -> IO (Stored a)
 storeMerge [] = error "merge: empty list"
-storeMerge [x] = return x
 storeMerge xs@(Stored ref _ : _) = wrappedStore (refStorage ref) $ mergeSorted $ filterAncestors xs
 
 previous :: Storable a => Stored a -> [Stored a]
-- 
cgit v1.2.3