diff options
Diffstat (limited to 'main')
| -rw-r--r-- | main/Test.hs | 35 |
1 files changed, 31 insertions, 4 deletions
diff --git a/main/Test.hs b/main/Test.hs index c3dca14..30f6356 100644 --- a/main/Test.hs +++ b/main/Test.hs @@ -117,9 +117,9 @@ runTestTool st = do getLineMb :: MonadIO m => m (Maybe Text) getLineMb = liftIO $ catchIOError (Just <$> T.getLine) (\e -> if isEOFError e then return Nothing else ioError e) -getLines :: MonadIO m => m [Text] -getLines = getLineMb >>= \case - Just line | not (T.null line) -> (line:) <$> getLines +getLines :: MonadIO m => Text -> m [ Text ] +getLines eof = getLineMb >>= \case + Just line | line /= eof -> (line :) <$> getLines eof _ -> return [] getHead :: CommandM (Head LocalState) @@ -268,7 +268,9 @@ type Command = CommandM () commands :: [ ( Text, Command ) ] commands = [ ( "store", cmdStore ) + , ( "store-raw", cmdStoreRaw ) , ( "load", cmdLoad ) + , ( "load-type", cmdLoadType ) , ( "stored-generation", cmdStoredGeneration ) , ( "stored-roots", cmdStoredRoots ) , ( "stored-set-add", cmdStoredSetAdd ) @@ -332,7 +334,7 @@ cmdStore = do st <- asks tiStorage pst <- liftIO $ derivePartialStorage st [otype] <- asks tiParams - ls <- getLines + ls <- getLines T.empty let cnt = encodeUtf8 $ T.unlines ls full = BL.fromChunks @@ -345,6 +347,18 @@ cmdStore = do Right ref -> cmdOut $ "store-done " ++ show (refDigest ref) Left _ -> cmdOut $ "store-failed" +cmdStoreRaw :: Command +cmdStoreRaw = do + st <- asks tiStorage + pst <- liftIO $ derivePartialStorage st + [ eof ] <- asks tiParams + ls <- getLines eof + + let full = BL.fromStrict $ BC.init $ encodeUtf8 $ T.unlines ls + liftIO (copyRef st =<< storeRawBytes pst full) >>= \case + Right ref -> cmdOut $ "store-done " ++ show (refDigest ref) + Left _ -> cmdOut $ "store-failed" + cmdLoad :: Command cmdLoad = do st <- asks tiStorage @@ -357,6 +371,19 @@ cmdLoad = do cmdOut $ "load-line " <> T.unpack (decodeUtf8 $ BL.toStrict line) cmdOut "load-done" +cmdLoadType :: Command +cmdLoadType = do + st <- asks tiStorage + [ tref ] <- asks tiParams + Just ref <- liftIO $ readRef st $ encodeUtf8 tref + let obj = load @Object ref + let otype = case obj of + Blob {} -> "blob" + Rec {} -> "rec" + ZeroObject {} -> "zero" + UnknownObject utype _ -> "unknown " <> decodeUtf8 utype + cmdOut $ "load-type " <> T.unpack otype + cmdStoredGeneration :: Command cmdStoredGeneration = do st <- asks tiStorage |