Log command

Changelog: Added `log` command to show job log

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")
diff --git a/src/Job.hs b/src/Job.hs
index 61ddbb5..706471b 100644
--- a/src/Job.hs
+++ b/src/Job.hs
@@ -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