summaryrefslogtreecommitdiff
path: root/src/Command
diff options
context:
space:
mode:
Diffstat (limited to 'src/Command')
-rw-r--r--src/Command/Extract.hs5
-rw-r--r--src/Command/JobId.hs2
-rw-r--r--src/Command/Log.hs2
-rw-r--r--src/Command/Run.hs37
-rw-r--r--src/Command/Shell.hs46
5 files changed, 78 insertions, 14 deletions
diff --git a/src/Command/Extract.hs b/src/Command/Extract.hs
index 8a0a035..b21c63c 100644
--- a/src/Command/Extract.hs
+++ b/src/Command/Extract.hs
@@ -14,6 +14,7 @@ import System.FilePath
import Command
import Eval
+import Job
import Job.Types
@@ -78,7 +79,7 @@ cmdExtract (ExtractCommand ExtractOptions {..} ExtractArguments {..}) = do
_ -> return False
forM_ extractArtifacts $ \( ref, ArtifactName aname ) -> do
- jid@(JobId ids) <- either (tfail . textEvalError) (return . jobId) =<<
+ jid@(JobId ids) <- either (tfail . textEvalError) (return . jobId . fst) =<<
liftIO (runEval (evalJobReference ref) einput)
let jdir = joinPath $ (storageDir :) $ ("jobs" :) $ map (T.unpack . textJobIdPart) ids
@@ -103,4 +104,4 @@ cmdExtract (ExtractCommand ExtractOptions {..} ExtractArguments {..}) = do
liftIO (doesPathExist tpath) >>= \case
True -> tfail $ "destination ‘" <> T.pack tpath <> "’ already exists"
False -> return ()
- liftIO $ copyFile (adir </> afile) tpath
+ liftIO $ copyRecursiveForce (adir </> afile) tpath
diff --git a/src/Command/JobId.hs b/src/Command/JobId.hs
index 173f543..096ed56 100644
--- a/src/Command/JobId.hs
+++ b/src/Command/JobId.hs
@@ -52,7 +52,7 @@ cmdJobId :: JobIdCommand -> CommandExec ()
cmdJobId (JobIdCommand JobIdOptions {..} ref) = do
einput <- getEvalInput
out <- getOutput
- JobId ids <- either (tfail . textEvalError) (return . jobId) =<<
+ JobId ids <- either (tfail . textEvalError) (return . jobId . fst) =<<
liftIO (runEval (evalJobReference ref) einput)
outputMessage out $ textJobId $ JobId ids
diff --git a/src/Command/Log.hs b/src/Command/Log.hs
index 25bfc06..e48ce8f 100644
--- a/src/Command/Log.hs
+++ b/src/Command/Log.hs
@@ -37,7 +37,7 @@ instance Command LogCommand where
cmdLog :: LogCommand -> CommandExec ()
cmdLog (LogCommand ref) = do
einput <- getEvalInput
- jid <- either (tfail . textEvalError) (return . jobId) =<<
+ jid <- either (tfail . textEvalError) (return . jobId . fst) =<<
liftIO (runEval (evalJobReference ref) einput)
output <- getOutput
storageDir <- getStorageDir
diff --git a/src/Command/Run.hs b/src/Command/Run.hs
index 9652529..a80e15d 100644
--- a/src/Command/Run.hs
+++ b/src/Command/Run.hs
@@ -126,7 +126,7 @@ mergeSources sources = do
argumentJobSource :: [ JobName ] -> CommandExec JobSource
argumentJobSource [] = emptyJobSource
argumentJobSource names = do
- ( config, jobsetCommit ) <- getJobRoot >>= \case
+ ( config, jcommit ) <- getJobRoot >>= \case
JobRootConfig config -> do
commit <- sequence . fmap createWipCommit =<< tryGetDefaultRepo
return ( config, commit )
@@ -135,29 +135,46 @@ argumentJobSource names = do
config <- either fail return =<< loadConfigForCommit =<< getCommitTree commit
return ( config, Just commit )
- jobtree <- case jobsetCommit of
+ jobtree <- case jcommit of
Just commit -> (: []) <$> getCommitTree commit
Nothing -> return []
let cidPart = map (JobIdTree Nothing "" . treeId) jobtree
- jobsetJobsEither <- fmap Right $ forM names $ \name ->
+ forM_ names $ \name ->
case find ((name ==) . jobName) (configJobs config) of
- Just job -> return job
+ Just _ -> return ()
Nothing -> tfail $ "job ‘" <> textJobName name <> "’ not found"
- oneshotJobSource . (: []) =<<
- cmdEvalWith (\ei -> ei { eiCurrentIdRev = cidPart ++ eiCurrentIdRev ei })
- (evalJobSet (map ( Nothing, ) jobtree) JobSet {..})
+
+ jset <- cmdEvalWith (\ei -> ei { eiCurrentIdRev = cidPart ++ eiCurrentIdRev ei }) $ do
+ fullSet <- evalJobSet (map ( Nothing, ) jobtree) JobSet
+ { jobsetId = ()
+ , jobsetCommit = jcommit
+ , jobsetJobsEither = Right (configJobs config)
+ }
+ let selectedSet = fullSet { jobsetJobsEither = fmap (filter ((`elem` names) . jobName)) (jobsetJobsEither fullSet) }
+ fillInDependencies selectedSet
+ oneshotJobSource [ jset ]
refJobSource :: [ JobRef ] -> CommandExec JobSource
refJobSource [] = emptyJobSource
refJobSource refs = do
- jobs <- cmdEvalWith id $ mapM evalJobReference refs
- oneshotJobSource . map (JobSet Nothing . Right . (: [])) $ jobs
+ jobs <- foldl' addJobToList [] <$> cmdEvalWith id (mapM evalJobReference refs)
+ sets <- cmdEvalWith id $ do
+ forM jobs $ \( sid, js ) -> do
+ fillInDependencies $ JobSet sid Nothing (Right $ reverse js)
+ oneshotJobSource sets
+ where
+ addJobToList :: [ ( JobSetId, [ Job ] ) ] -> ( Job, JobSetId ) -> [ ( JobSetId, [ Job ] ) ]
+ addJobToList (( sid, js ) : rest ) ( job, jsid )
+ | sid == jsid = ( sid, job : js ) : rest
+ | otherwise = ( sid, js ) : addJobToList rest ( job, jsid )
+ addJobToList [] ( job, jsid ) = [ ( jsid, [ job ] ) ]
loadJobSetFromRoot :: (MonadIO m, MonadFail m) => JobRoot -> Commit -> m DeclaredJobSet
loadJobSetFromRoot root commit = case root of
JobRootRepo _ -> loadJobSetForCommit commit
JobRootConfig config -> return JobSet
- { jobsetCommit = Just commit
+ { jobsetId = ()
+ , jobsetCommit = Just commit
, jobsetJobsEither = Right $ configJobs config
}
diff --git a/src/Command/Shell.hs b/src/Command/Shell.hs
new file mode 100644
index 0000000..4cd2b7e
--- /dev/null
+++ b/src/Command/Shell.hs
@@ -0,0 +1,46 @@
+module Command.Shell (
+ ShellCommand,
+) where
+
+import Control.Monad
+import Control.Monad.IO.Class
+
+import Data.Maybe
+import Data.Text (Text)
+import Data.Text qualified as T
+
+import System.Environment
+import System.Process hiding (ShellCommand)
+
+import Command
+import Eval
+import Job
+import Job.Types
+
+
+data ShellCommand = ShellCommand JobRef
+
+instance Command ShellCommand where
+ commandName _ = "shell"
+ commandDescription _ = "Open a shell prepared for given job"
+
+ type CommandArguments ShellCommand = Text
+
+ commandUsage _ = T.unlines $
+ [ "Usage: minici shell <job ref>"
+ ]
+
+ commandInit _ _ = ShellCommand . parseJobRef
+ commandExec = cmdShell
+
+
+cmdShell :: ShellCommand -> CommandExec ()
+cmdShell (ShellCommand ref) = do
+ einput <- getEvalInput
+ job <- either (tfail . textEvalError) (return . fst) =<<
+ liftIO (runEval (evalJobReference ref) einput)
+ sh <- fromMaybe "/bin/sh" <$> liftIO (lookupEnv "SHELL")
+ storageDir <- getStorageDir
+ prepareJob storageDir job $ \checkoutPath _ -> do
+ liftIO $ withCreateProcess (proc sh []) { cwd = Just checkoutPath } $ \_ _ _ ph -> do
+ void $ waitForProcess ph