diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Command/Log.hs | 45 | ||||
| -rw-r--r-- | src/Job.hs | 7 | ||||
| -rw-r--r-- | src/Main.hs | 2 |
3 files changed, 52 insertions, 2 deletions
diff --git a/src/Command/Log.hs b/src/Command/Log.hs new file mode 100644 index 0000000..92866d4 --- /dev/null +++ b/src/Command/Log.hs @@ -0,0 +1,45 @@ +module Command.Log ( + LogCommand, +) where + +import Control.Monad.IO.Class + +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Lazy qualified as TL +import Data.Text.Lazy.IO qualified as TL + +import System.FilePath + +import Command +import Eval +import Job +import Job.Types +import Output + + +data LogCommand = LogCommand JobRef + +instance Command LogCommand where + commandName _ = "log" + commandDescription _ = "Show log for the given job" + + type CommandArguments LogCommand = Text + + commandUsage _ = T.pack $ unlines $ + [ "Usage: minici log <job ref>" + ] + + commandInit _ _ = LogCommand . JobRef . T.splitOn "." + commandExec = cmdLog + + +cmdLog :: LogCommand -> CommandExec () +cmdLog (LogCommand ref) = do + einput <- getEvalInput + jid <- either (tfail . textEvalError) return =<< + liftIO (runEval (evalJobReference ref) einput) + output <- getOutput + storageDir <- getStorageDir + liftIO $ mapM_ (outputEvent output . OutputMessage . TL.toStrict) . TL.lines =<< + TL.readFile (storageDir </> jobStorageSubdir jid </> "log") @@ -8,6 +8,7 @@ module Job ( jobStatusFinished, jobStatusFailed, JobManager(..), newJobManager, cancelAllJobs, runJobs, + jobStorageSubdir, ) where import Control.Concurrent @@ -284,6 +285,9 @@ updateStatusFile path outVar = void $ liftIO $ forkIO $ loop Nothing T.writeFile path $ textJobStatus status <> "\n" when (not (jobStatusFinished status)) $ loop $ Just status +jobStorageSubdir :: JobId -> FilePath +jobStorageSubdir (JobId jidParts) = "jobs" </> joinPath (map (T.unpack . textJobIdPart) (jidParts)) + prepareJob :: (MonadIO m, MonadMask m, MonadFail m) => FilePath -> Maybe Commit -> Job -> (FilePath -> FilePath -> m a) -> m a prepareJob dir mbCommit job inner = do withSystemTempDirectory "minici" $ \checkoutPath -> do @@ -301,8 +305,7 @@ prepareJob dir mbCommit job inner = do subtree <- maybe return (getSubtree Nothing . makeRelative (treeSubdir tree)) mbsub $ tree checkoutAt subtree $ checkoutPath </> fromMaybe "" dest - let JobId jidParts = jobId job - jdir = dir </> "jobs" </> joinPath (map (T.unpack . textJobIdPart) (jidParts)) + let jdir = dir </> jobStorageSubdir (jobId job) liftIO $ createDirectoryIfMissing True jdir inner checkoutPath jdir diff --git a/src/Main.hs b/src/Main.hs index 49aa290..5fdd128 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -22,6 +22,7 @@ import System.IO import Command import Command.Checkout import Command.JobId +import Command.Log import Command.Run import Config import Output @@ -88,6 +89,7 @@ commands = ( SC $ Proxy @RunCommand) NE.:| [ SC $ Proxy @CheckoutCommand , SC $ Proxy @JobIdCommand + , SC $ Proxy @LogCommand ] lookupCommand :: String -> Maybe SomeCommandType |