summaryrefslogtreecommitdiff
path: root/src/Storage/Merge.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2019-12-07 22:35:55 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2019-12-07 22:35:55 +0100
commit35347e4cfbd9070d1065b1ff9600013d648c5e6e (patch)
tree0f09520e841012b0a702ec4ea068b89983a0aa2a /src/Storage/Merge.hs
parent51bc5cd6948985ab294ed3216345d046f4aefc85 (diff)
Mergeable stored list
Diffstat (limited to 'src/Storage/Merge.hs')
-rw-r--r--src/Storage/Merge.hs26
1 files changed, 26 insertions, 0 deletions
diff --git a/src/Storage/Merge.hs b/src/Storage/Merge.hs
index ac80c96..74b88d7 100644
--- a/src/Storage/Merge.hs
+++ b/src/Storage/Merge.hs
@@ -1,7 +1,12 @@
module Storage.Merge (
+ Mergeable(..),
+ merge, storeMerge,
+ uniq,
+
generations,
ancestors,
precedes,
+ filterAncestors,
) where
import qualified Data.ByteString.Char8 as BC
@@ -13,6 +18,24 @@ import qualified Data.Set as S
import Storage
import Storage.Internal
+class Storable a => Mergeable a where
+ mergeSorted :: [Stored a] -> a
+
+merge :: Mergeable a => [Stored 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 [] = error "merge: empty list"
+storeMerge [x] = return x
+storeMerge xs@(Stored ref _ : _) = wrappedStore (refStorage ref) $ mergeSorted $ filterAncestors xs
+
+uniq :: Eq a => [a] -> [a]
+uniq (x:x':xs) | x == x' = uniq (x:xs)
+ | otherwise = x : uniq (x':xs)
+uniq xs = xs
+
previous :: Storable a => Stored a -> [Stored a]
previous (Stored ref _) = case load ref of
Rec items | Just (RecRef dref) <- lookup (BC.pack "SDATA") items
@@ -38,3 +61,6 @@ ancestors = last . (S.empty:) . generations
precedes :: Storable a => Stored a -> Stored a -> Bool
precedes x y = x `S.member` ancestors [y]
+
+filterAncestors :: Storable a => [Stored a] -> [Stored a]
+filterAncestors xs = uniq $ sort $ filter (`S.notMember` ancestors xs) xs