diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 27 |
1 files changed, 19 insertions, 8 deletions
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 |