diff options
| -rw-r--r-- | src/Storage/Merge.hs | 4 | ||||
| -rw-r--r-- | src/Test.hs | 10 |
2 files changed, 13 insertions, 1 deletions
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 |