From ee8f0753c818d7f22824caebba2a3a3e710367b7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Tue, 26 Nov 2019 22:22:59 +0100
Subject: wip: storage ref set

---
 src/Storage.hs | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/src/Storage.hs b/src/Storage.hs
index 47f8af0..0edfa54 100644
--- a/src/Storage.hs
+++ b/src/Storage.hs
@@ -179,6 +179,7 @@ copyObject' st (Rec rs) = fmap Rec . sequence <$> mapM copyItem rs
               RecDate x -> return $ return $ RecDate x
               RecJson x -> return $ return $ RecJson x
               RecRef x -> fmap RecRef <$> copyRef' st x
+copyObject' st (RefSet ost rs) = fmap (RefSet st . S.fromAscList . map refDigest) . sequence <$> mapM (copyRef' st . Ref ost) (S.toAscList rs)
 copyObject' _ ZeroObject = return $ return ZeroObject
 
 copyRef :: forall c c' m. (StorageCompleteness c, StorageCompleteness c', MonadIO m) => Storage' c' -> Ref' c -> m (LoadResult c (Ref' c'))
@@ -197,6 +198,7 @@ partialRefFromDigest st dgst = Ref st dgst
 data Object' c
     = Blob ByteString
     | Rec [(ByteString, RecItem' c)]
+    | RefSet (Storage' c) (Set RefDigest)
     | ZeroObject
     deriving (Show)
 
@@ -220,6 +222,8 @@ serializeObject = \case
     Blob cnt -> BL.fromChunks [BC.pack "blob ", BC.pack (show $ B.length cnt), BC.singleton '\n', cnt]
     Rec rec -> let cnt = BL.fromChunks $ concatMap (uncurry serializeRecItem) rec
                 in BL.fromChunks [BC.pack "rec ", BC.pack (show $ BL.length cnt), BC.singleton '\n'] `BL.append` cnt
+    RefSet _ rs -> let cnt = BL.fromChunks $ concatMap (\x -> [showRefDigest x, BC.singleton '\n']) $ S.toAscList rs
+                    in BL.fromChunks [BC.pack "set.b2 ", BC.pack (show $ BL.length cnt), BC.singleton '\n'] `BL.append` cnt
     ZeroObject -> BL.empty
 
 unsafeStoreObject :: Storage' c -> Object' c -> IO (Ref' c)
@@ -286,6 +290,8 @@ unsafeDeserializeObject st bytes =
                  _ | otype == BC.pack "blob" -> return $ Blob content
                    | otype == BC.pack "rec" -> maybe (throwError $ "Malformed record item ")
                                                    (return . Rec) $ sequence $ map parseRecLine $ mergeCont [] $ BC.lines content
+                   | otype == BC.pack "set.b2" -> maybe (throwError $ "Malformed set item ")
+                                                      (return . RefSet st . S.fromAscList) $ mapM readRefDigest $ BC.lines content
                    | otherwise -> throwError $ "Unknown object type"
         _ -> throwError $ "Malformed object"
     where splitObjPrefix line = do
@@ -448,11 +454,13 @@ class Storable a => ZeroStorable a where
 
 data Store = StoreBlob ByteString
            | StoreRec (forall c. StorageCompleteness c => Storage' c -> [IO [(ByteString, RecItem' c)]])
+           | StoreSet (forall c. StorageCompleteness c => Storage' c -> [IO (Set RefDigest)])
            | StoreZero
 
 evalStore :: StorageCompleteness c => Storage' c -> Store -> IO (Object' c)
 evalStore _ (StoreBlob x) = return $ Blob x
 evalStore s (StoreRec f) = Rec . concat <$> sequence (f s)
+evalStore s (StoreSet f) = RefSet s . S.unions <$> sequence (f s)
 evalStore _ StoreZero = return ZeroObject
 
 type StoreRec c = ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
@@ -468,6 +476,9 @@ instance Storable Object where
     store' (Rec xs) = StoreRec $ \st -> return $ do
         Rec xs' <- copyObject st (Rec xs)
         return xs'
+    store' rs@(RefSet {}) = StoreSet $ \st -> return $ do
+        RefSet _ rs' <- copyObject st rs
+        return rs'
     store' ZeroObject = StoreZero
 
     load' = asks snd
-- 
cgit v1.2.3