From 39cf8f9919ba953f4e782609562781daf3d13868 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Mon, 5 Dec 2022 22:07:27 +0100
Subject: Read job recipes from config file

---
 src/Job.hs | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 79 insertions(+)
 create mode 100644 src/Job.hs

(limited to 'src/Job.hs')

diff --git a/src/Job.hs b/src/Job.hs
new file mode 100644
index 0000000..db3f4d0
--- /dev/null
+++ b/src/Job.hs
@@ -0,0 +1,79 @@
+module Job (
+    Job(..),
+    JobOutput(..),
+    JobName(..), stringJobName,
+    ArtifactName(..),
+    runJob,
+) where
+
+import Control.Monad
+import Control.Monad.Except
+
+import Data.Text (Text)
+import Data.Text qualified as T
+
+import System.Directory
+import System.Exit
+import System.FilePath
+import System.IO
+import System.Process
+
+data Job = Job
+    { jobName :: JobName
+    , jobRecipe :: [CreateProcess]
+    , jobArtifacts :: [(ArtifactName, CreateProcess)]
+    }
+
+data JobOutput = JobOutput
+    { outName :: JobName
+    , outStatus :: Bool
+    , outArtifacts :: [(ArtifactName, FilePath)]
+    }
+    deriving (Show)
+
+data JobName = JobName Text
+    deriving (Eq, Ord, Show)
+
+stringJobName :: JobName -> String
+stringJobName (JobName name) = T.unpack name
+
+data ArtifactName = ArtifactName Text
+    deriving (Eq, Ord, Show)
+
+
+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, _, _, hp) <- liftIO $ createProcess_ "" p
+                { cwd = Just path
+                , std_in = CreatePipe
+                , std_out = UseHandle logs
+                , std_err = UseHandle logs
+                }
+            liftIO $ hClose hin
+            exit <- liftIO $ waitForProcess hp
+
+            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 ()
+        , outArtifacts = []
+        }
-- 
cgit v1.2.3