From a675117ab8a6d62edfe7438f25d82d80df3b8f6a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Fri, 2 Dec 2022 21:51:30 +0100
Subject: Write recipe output and status to log files

---
 src/Main.hs | 27 +++++++++++++++++++--------
 1 file changed, 19 insertions(+), 8 deletions(-)

(limited to 'src')

diff --git a/src/Main.hs b/src/Main.hs
index 32c0288..e2d458f 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -8,6 +8,7 @@ import Data.Text qualified as T
 
 import System.Directory
 import System.Exit
+import System.FilePath
 import System.IO
 import System.Process
 
@@ -30,31 +31,41 @@ data JobName = JobName Text
 data ArtifactName = ArtifactName Text
     deriving (Eq, Ord, Show)
 
+stringJobName :: JobName -> String
+stringJobName (JobName name) = T.unpack name
 
-runJob :: String -> Job -> IO JobOutput
-runJob cid job = do
+
+runJob :: FilePath -> String -> Job -> IO JobOutput
+runJob dir cid job = do
     [path] <- lines <$> readProcess "mktemp" ["-d", "-t", "minici.XXXXXXXXXX"] ""
 
     "" <- readProcess "git" ["--work-tree=" <> path, "restore", "--source=" <> cid, "--", "."] ""
+    ["tree", tid]:_  <- map words . lines <$> readProcess "git" ["cat-file", "-p", cid] ""
+
+    let jdir = dir </> "jobs" </> tid </> stringJobName (jobName job)
+    createDirectoryIfMissing True jdir
+    logs <- openFile (jdir </> "log") WriteMode
 
     res <- runExceptT $ do
         forM_ (jobRecipe job) $ \p -> do
-            (Just hin, Just hout, Just herr, hp) <- liftIO $ createProcess p
+            (Just hin, _, _, hp) <- liftIO $ createProcess_ "" p
                 { cwd = Just path
                 , std_in = CreatePipe
-                , std_out = CreatePipe
-                , std_err = CreatePipe
+                , std_out = UseHandle logs
+                , std_err = UseHandle logs
                 }
             liftIO $ hClose hin
             exit <- liftIO $ waitForProcess hp
-            liftIO $ hClose hout
-            liftIO $ hClose herr
 
             when (exit /= ExitSuccess) $
                 throwError ()
 
+    hClose logs
     removeDirectoryRecursive $ path
 
+    writeFile (jdir </> "status") $
+        if res == Right () then "success\n" else "failure\n"
+
     return JobOutput
         { outName = jobName job
         , outStatus = res == Right ()
@@ -81,7 +92,7 @@ main = do
 
         putStr $ shortCid <> " " <> desc' <> " "
         hFlush stdout
-        runJob cid (cabalJob (JobName "build") $ map (ArtifactName . T.pack) []) >>= \case
+        runJob "./.minici" cid (cabalJob (JobName "build") $ map (ArtifactName . T.pack) []) >>= \case
             out | outStatus out -> do
                 putStr "\ESC[92m✓\ESC[0m"
             _ -> do
-- 
cgit v1.2.3