diff options
Diffstat (limited to 'src/Storage')
-rw-r--r-- | src/Storage/List.hs | 7 | ||||
-rw-r--r-- | src/Storage/Merge.hs | 13 |
2 files changed, 9 insertions, 11 deletions
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] |