From 7baa631f3c227b29fe702053a20f1ea98fc1f51e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Mon, 8 Aug 2022 22:22:09 +0200
Subject: Test: stored generation

---
 src/Storage/Merge.hs |  4 ++++
 src/Test.hs          | 10 +++++++++-
 2 files changed, 13 insertions(+), 1 deletion(-)

diff --git a/src/Storage/Merge.hs b/src/Storage/Merge.hs
index c28d290..02b29f7 100644
--- a/src/Storage/Merge.hs
+++ b/src/Storage/Merge.hs
@@ -3,6 +3,7 @@ module Storage.Merge (
     merge, storeMerge,
 
     Generation,
+    showGeneration,
     compareGeneration, generationMax,
     storedGeneration,
 
@@ -69,6 +70,9 @@ nextGeneration = foldl' helper (Generation 0)
     where helper (Generation c) (Generation n) | c <= n    = Generation (n + 1)
                                                | otherwise = Generation c
 
+showGeneration :: Generation -> String
+showGeneration (Generation x) = show x
+
 compareGeneration :: Generation -> Generation -> Maybe Ordering
 compareGeneration (Generation x) (Generation y) = Just $ compare x y
 
diff --git a/src/Test.hs b/src/Test.hs
index 8c26f5e..b3c7345 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -205,6 +205,7 @@ type Command = CommandM ()
 commands :: [(Text, Command)]
 commands = map (T.pack *** id)
     [ ("store", cmdStore)
+    , ("stored-generation", cmdStoredGeneration)
     , ("stored-roots", cmdStoredRoots)
     , ("stored-set-add", cmdStoredSetAdd)
     , ("stored-set-list", cmdStoredSetList)
@@ -233,12 +234,19 @@ cmdStore = do
     ref <- liftIO $ unsafeStoreRawBytes st $ BL.fromChunks [encodeUtf8 otype, BC.singleton ' ', BC.pack (show $ B.length cnt), BC.singleton '\n', cnt]
     cmdOut $ "store-done " ++ show (refDigest ref)
 
+cmdStoredGeneration :: Command
+cmdStoredGeneration = do
+    st <- asks tiStorage
+    [tref] <- asks tiParams
+    Just ref <- liftIO $ readRef st (encodeUtf8 tref)
+    cmdOut $ "stored-generation " ++ T.unpack tref ++ " " ++ showGeneration (storedGeneration $ wrappedLoad @Object ref)
+
 cmdStoredRoots :: Command
 cmdStoredRoots = do
     st <- asks tiStorage
     [tref] <- asks tiParams
     Just ref <- liftIO $ readRef st (encodeUtf8 tref)
-    cmdOut $ "stored-roots" ++ concatMap ((' ':) . show . refDigest . storedRef) (storedRoots $ wrappedLoad @Object ref)
+    cmdOut $ "stored-roots " ++ T.unpack tref ++ concatMap ((' ':) . show . refDigest . storedRef) (storedRoots $ wrappedLoad @Object ref)
 
 cmdStoredSetAdd :: Command
 cmdStoredSetAdd = do
-- 
cgit v1.2.3