src/Command/Shell.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

module Command.Shell (
    ShellCommand,
) where

import Control.Monad
import Control.Monad.IO.Class

import Data.Bifunctor
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 return =<<
        return . either (Left . textEvalError) (first T.pack . jobsetJobsEither) =<<
        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