diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2022-12-02 21:51:30 +0100 | 
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2022-12-02 21:51:30 +0100 | 
| commit | a675117ab8a6d62edfe7438f25d82d80df3b8f6a (patch) | |
| tree | 1eb9eb3a074edc04e8223786579e8ed9744c0a24 /src | |
| parent | 55cead7b8d31f5e5fe09df0588abf736a465c0eb (diff) | |
Write recipe output and status to log files
Diffstat (limited to 'src')
| -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 |