diff options
Diffstat (limited to 'src/Command')
-rw-r--r-- | src/Command/Extract.hs | 5 | ||||
-rw-r--r-- | src/Command/JobId.hs | 2 | ||||
-rw-r--r-- | src/Command/Log.hs | 2 | ||||
-rw-r--r-- | src/Command/Run.hs | 37 | ||||
-rw-r--r-- | src/Command/Shell.hs | 46 |
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 |