diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Command/Shell.hs | 46 | ||||
-rw-r--r-- | src/Job.hs | 1 | ||||
-rw-r--r-- | src/Main.hs | 2 |
3 files changed, 49 insertions, 0 deletions
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 @@ -8,6 +8,7 @@ module Job ( jobStatusFinished, jobStatusFailed, JobManager(..), newJobManager, cancelAllJobs, runJobs, + prepareJob, jobStorageSubdir, copyRecursive, diff --git a/src/Main.hs b/src/Main.hs index ec03acb..83b0ab3 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -25,6 +25,7 @@ import Command.Extract import Command.JobId import Command.Log import Command.Run +import Command.Shell import Command.Subtree import Config import Output @@ -93,6 +94,7 @@ commands = , SC $ Proxy @ExtractCommand , SC $ Proxy @JobIdCommand , SC $ Proxy @LogCommand + , SC $ Proxy @ShellCommand , SC $ Proxy @SubtreeCommand ] |