Extract command

Changelog: Added `extract` command to extract artifacts

5 files changed, 152 insertions, 0 deletions

diff --git a/minici.cabal b/minici.cabal
index b7e01e9..4ecf2bc 100644
--- a/minici.cabal
+++ b/minici.cabal
@@ -49,6 +49,7 @@ executable minici
     other-modules:
         Command
         Command.Checkout
+        Command.Extract
         Command.JobId
         Command.Log
         Command.Run
diff --git a/src/Command/Extract.hs b/src/Command/Extract.hs
new file mode 100644
index 0000000..b24a1af
--- /dev/null
+++ b/src/Command/Extract.hs
@@ -0,0 +1,105 @@
+module Command.Extract (
+    ExtractCommand,
+) where
+
+import Control.Monad
+import Control.Monad.Except
+import Control.Monad.IO.Class
+
+import Data.Text qualified as T
+
+import System.Console.GetOpt
+import System.Directory
+import System.FilePath
+
+import Command
+import Eval
+import Job.Types
+
+
+data ExtractCommand = ExtractCommand ExtractOptions ExtractArguments
+
+data ExtractArguments = ExtractArguments
+    { extractArtifacts :: [ ( JobRef, ArtifactName ) ]
+    , extractDestination :: FilePath
+    }
+
+instance CommandArgumentsType ExtractArguments where
+    argsFromStrings = \case
+        args@(_:_:_) -> do
+            extractArtifacts <- mapM toArtifactRef (init args)
+            extractDestination <- return (last args)
+            return ExtractArguments {..}
+          where
+            toArtifactRef tref = case T.splitOn "." (T.pack tref) of
+                parts@(_:_:_) -> return ( JobRef (init parts), ArtifactName (last parts) )
+                _             -> throwError $ "too few parts in artifact ref ‘" <> tref <> "’"
+        _ -> throwError "too few arguments"
+
+data ExtractOptions = ExtractOptions
+    { extractForce :: Bool
+    }
+
+instance Command ExtractCommand where
+    commandName _ = "extract"
+    commandDescription _ = "Extract artifacts generated by jobs"
+
+    type CommandArguments ExtractCommand = ExtractArguments
+
+    commandUsage _ = T.pack $ unlines $
+        [ "Usage: minici jobid [<option>...] <job ref>.<artifact>... <destination>"
+        ]
+
+    type CommandOptions ExtractCommand = ExtractOptions
+    defaultCommandOptions _ = ExtractOptions
+        { extractForce = False
+        }
+
+    commandOptions _ =
+        [ Option [ 'f' ] [ "force" ]
+            (NoArg $ \opts -> opts { extractForce = True })
+            "owerwrite existing files"
+        ]
+
+    commandInit _ = ExtractCommand
+    commandExec = cmdExtract
+
+
+cmdExtract :: ExtractCommand -> CommandExec ()
+cmdExtract (ExtractCommand ExtractOptions {..} ExtractArguments {..}) = do
+    einput <- getEvalInput
+    storageDir <- getStorageDir
+
+    isdir <- liftIO (doesDirectoryExist extractDestination) >>= \case
+        True -> return True
+        False -> case extractArtifacts of
+            _:_:_ -> tfail $ "destination ‘" <> T.pack extractDestination <> "’ is not a directory"
+            _     -> return False
+
+    forM_ extractArtifacts $ \( ref, ArtifactName aname ) -> do
+        jid@(JobId ids) <- either (tfail . textEvalError) return =<<
+            liftIO (runEval (evalJobReference ref) einput)
+
+        let jdir = joinPath $ (storageDir :) $ ("jobs" :) $ map (T.unpack . textJobIdPart) ids
+            adir = jdir </> "artifacts" </> T.unpack aname
+
+        liftIO (doesDirectoryExist jdir) >>= \case
+            True -> return ()
+            False -> tfail $ "job ‘" <> textJobId jid <> "’ not yet executed"
+
+        liftIO (doesDirectoryExist adir) >>= \case
+            True -> return ()
+            False -> tfail $ "artifact ‘" <> aname <> "’ of job ‘" <> textJobId jid <> "’ not found"
+
+        afile <- liftIO (listDirectory adir) >>= \case
+            [ file ] -> return file
+            []       -> tfail $ "artifact ‘" <> aname <> "’ of job ‘" <> textJobId jid <> "’ not found"
+            _:_:_    -> tfail $ "unexpected files in ‘" <> T.pack adir <> "’"
+
+        let tpath | isdir = extractDestination </> afile
+                  | otherwise = extractDestination
+        when (not extractForce) $ do
+            liftIO (doesPathExist tpath) >>= \case
+                True -> tfail $ "destination ‘" <> T.pack tpath <> "’ already exists"
+                False -> return ()
+        liftIO $ copyFile (adir </> afile) tpath
diff --git a/src/Main.hs b/src/Main.hs
index 89fab39..0227e74 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -21,6 +21,7 @@ import System.IO
 
 import Command
 import Command.Checkout
+import Command.Extract
 import Command.JobId
 import Command.Log
 import Command.Run
@@ -88,6 +89,7 @@ commands :: NE.NonEmpty SomeCommandType
 commands =
     ( SC $ Proxy @RunCommand) NE.:|
     [ SC $ Proxy @CheckoutCommand
+    , SC $ Proxy @ExtractCommand
     , SC $ Proxy @JobIdCommand
     , SC $ Proxy @LogCommand
     ]
diff --git a/test/asset/artifact/minici.yaml b/test/asset/artifact/minici.yaml
new file mode 100644
index 0000000..065ae84
--- /dev/null
+++ b/test/asset/artifact/minici.yaml
@@ -0,0 +1,17 @@
+job generate:
+  checkout: null
+
+  shell:
+    - echo "content 1" > f1
+    - mkdir subdir
+    - echo "content 2" > subdir/f2
+    - echo "content 3" > f3
+
+  artifact first:
+    path: f1
+
+  artifact second:
+    path: subdir/f2
+
+  artifact third:
+    path: f3
diff --git a/test/script/artifact.et b/test/script/artifact.et
new file mode 100644
index 0000000..f1fc74e
--- /dev/null
+++ b/test/script/artifact.et
@@ -0,0 +1,27 @@
+module artifact
+
+asset scripts:
+    path: ../asset/artifact
+
+
+test ExtractArtifact:
+    node n
+    local:
+        spawn on n as p args [ "${scripts.path}/minici.yaml", "run", "generate" ]
+        expect /job-finish generate done/ from p
+
+    local:
+        spawn on n as p args [ "${scripts.path}/minici.yaml", "extract", "generate.first", "extracted" ]
+    local:
+        shell on n as s:
+            cat ./extracted
+        expect /content 1/ from s
+
+    local:
+        spawn on n as p args [ "${scripts.path}/minici.yaml", "extract", "generate.second", "generate.third", "." ]
+    local:
+        shell on n as s:
+            cat ./f2
+            cat ./f3
+        expect /content 2/ from s
+        expect /content 3/ from s