From a0fbbe270135d9541a1a0d88bc980a6deab35a4a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Mon, 6 May 2019 21:06:45 +0200
Subject: Generic collecting of objects through references

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

(limited to 'src/Storage.hs')

diff --git a/src/Storage.hs b/src/Storage.hs
index c31230e..b3c2619 100644
--- a/src/Storage.hs
+++ b/src/Storage.hs
@@ -8,6 +8,7 @@ module Storage (
     Object(..), RecItem(..),
     serializeObject, deserializeObject, deserializeObjects,
     storeRawBytes, lazyLoadBytes,
+    collectObjects, collectStoredObjects,
 
     Head,
     headName, headRef, headObject,
@@ -73,6 +74,8 @@ import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe
 import Data.Ratio
+import Data.Set (Set)
+import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding
@@ -263,6 +266,21 @@ deserializeObjects st bytes = do (obj, rest) <- deserializeObject st bytes
                                  (obj:) <$> deserializeObjects st rest
 
 
+collectObjects :: Object -> [Object]
+collectObjects obj = obj : map fromStored (fst $ collectOtherStored S.empty obj)
+
+collectStoredObjects :: Stored Object -> [Stored Object]
+collectStoredObjects obj = obj : (fst $ collectOtherStored S.empty $ fromStored obj)
+
+collectOtherStored :: Set Ref -> Object -> ([Stored Object], Set Ref)
+collectOtherStored seen (Rec items) = foldr helper ([], seen) $ map snd items
+    where helper (RecRef r) (xs, s) | r `S.notMember` s = let o = wrappedLoad r
+                                                              (xs', s') = collectOtherStored (S.insert r s) $ fromStored o
+                                                           in ((o : xs') ++ xs, s')
+          helper _          (xs, s) = (xs, s)
+collectOtherStored seen _ = ([], seen)
+
+
 data Head = Head String Ref
     deriving (Show)
 
-- 
cgit v1.2.3