diff options
Diffstat (limited to 'Biz')
| -rw-r--r-- | Biz/Bild.hs | 72 |
1 files changed, 40 insertions, 32 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs index 562f43a..0747cf5 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -657,7 +657,7 @@ isSuccess :: Exit.ExitCode -> Bool isSuccess Exit.ExitSuccess = True isSuccess _ = False -test :: Bool -> Target -> IO Exit.ExitCode +test :: Bool -> Target -> IO (Exit.ExitCode, ByteString) test loud Target {..} = case compiler of Ghc -> do root <- Env.getEnv "BIZ_ROOT" @@ -673,13 +673,13 @@ test loud Target {..} = case compiler of _ -> Log.warn ["test", nschunk namespace, "unavailable"] >> Log.br - >> pure (Exit.ExitFailure 1) + >> pure (Exit.ExitFailure 1, mempty) build :: Bool -> Bool -> Analysis -> IO [Exit.ExitCode] build andTest loud analysis = Env.getEnv "BIZ_ROOT" +> \root -> - forM (Map.elems analysis) <| \target@Target {..} -> do - case compiler of + forM (Map.elems analysis) <| \target@Target {..} -> + fst </ case compiler of Gcc -> Log.info ["bild", label, "gcc", nschunk namespace] >> proc loud namespace (toNixFlag compiler) compilerFlags @@ -688,13 +688,13 @@ build andTest loud analysis = Meta.Bin _ -> "bin" _ -> "lib" Ghc -> case out of - Meta.None -> pure Exit.ExitSuccess + Meta.None -> pure (Exit.ExitSuccess, mempty) Meta.Bin _ -> do Log.info ["bild", "dev", "ghc-exe", nschunk namespace] - exitcode <- proc loud namespace (toNixFlag compiler) compilerFlags - if andTest && isSuccess exitcode + result <- proc loud namespace (toNixFlag compiler) compilerFlags + if andTest && (isSuccess <| fst result) then test loud target - else pure exitcode + else pure result Meta.Lib _ -> do Log.info ["bild", "dev", "ghc-lib", nschunk namespace] proc loud namespace (toNixFlag compiler) compilerFlags @@ -702,12 +702,12 @@ build andTest loud analysis = Log.info ["bild", "dev", "guile", nschunk namespace] _ <- proc loud namespace (toNixFlag compiler) compilerFlags case wrapper of - Nothing -> pure Exit.ExitSuccess + Nothing -> pure (Exit.ExitSuccess, mempty) Just content -> do writeFile (root </> outToPath out) content p <- Dir.getPermissions <| root </> outToPath out Dir.setPermissions (root </> outToPath out) (Dir.setOwnerExecutable True p) - pure Exit.ExitSuccess + pure (Exit.ExitSuccess, mempty) NixBuild -> do Log.info ["bild", "nix", toLog builder, nschunk namespace] proc loud namespace (toNixFlag compiler) compilerFlags @@ -716,7 +716,7 @@ build andTest loud analysis = toLog (Remote u h) = u <> "@" <> h Copy -> do Log.warn ["bild", "copy", "not implemented yet", nschunk namespace] - pure Exit.ExitSuccess + pure (Exit.ExitSuccess, mempty) Rustc -> do Log.info ["bild", "dev", "rust", nschunk namespace] proc loud namespace (toNixFlag compiler) compilerFlags @@ -734,32 +734,40 @@ data Proc = Proc } -- | Run a subprocess, streaming output if --loud is set. -run :: Proc -> IO Exit.ExitCode +run :: Proc -> IO (Exit.ExitCode, ByteString) run Proc {..} = - Conduit.proc cmd args |> Conduit.streamingProcess + Conduit.proc cmd args + |> Conduit.streamingProcess +> \(Conduit.UseProvidedHandle, stdout_, stderr_, hdl) -> - Async.Concurrently (loud ?: (puts stdout_, logs ns stdout_)) - *> Async.Concurrently (loud ?: (puts stderr_, logs ns stderr_)) - *> Async.Concurrently (putsToTmp stdout_ "/tmp/bild-log.out") - *> Async.Concurrently (putsToTmp stderr_ "/tmp/bild-log.err") - *> Async.Concurrently (Conduit.waitForStreamingProcess hdl) - |> Async.runConcurrently - +> \case - Exit.ExitFailure n -> puts stderr_ >> onFailure >> pure (Exit.ExitFailure n) - Exit.ExitSuccess -> onSuccess >> pure Exit.ExitSuccess + Conduit.runConduitRes (stdout_ .| Conduit.foldC) + +> \output -> + Async.Concurrently (loud ?: (puts stdout_, logs ns stdout_)) + *> Async.Concurrently (loud ?: (puts stderr_, logs ns stderr_)) + *> Async.Concurrently (putsToTmp stdout_ "/tmp/bild-log.out") + *> Async.Concurrently (putsToTmp stderr_ "/tmp/bild-log.err") + *> Async.Concurrently (Conduit.waitForStreamingProcess hdl) + |> Async.runConcurrently + +> \case + Exit.ExitFailure n -> + puts stderr_ + >> onFailure + >> pure (Exit.ExitFailure n, output) + Exit.ExitSuccess -> + onSuccess + >> pure (Exit.ExitSuccess, output) -- | Helper for running a standard bild subprocess. -proc :: Bool -> Namespace -> String -> [Text] -> IO Exit.ExitCode +proc :: Bool -> Namespace -> String -> [Text] -> IO (Exit.ExitCode, ByteString) proc loud namespace cmd args = - run - <| Proc - { loud = loud, - ns = namespace, - cmd = cmd, - args = map Text.unpack args, - onFailure = Log.fail ["bild", nschunk namespace] >> Log.br, - onSuccess = Log.good ["bild", nschunk namespace] >> Log.br - } + Proc + { loud = loud, + ns = namespace, + cmd = cmd, + args = map Text.unpack args, + onFailure = Log.fail ["bild", nschunk namespace] >> Log.br, + onSuccess = Log.good ["bild", nschunk namespace] >> Log.br + } + |> run -- | Helper for printing during a subprocess puts :: Conduit.ConduitT () ByteString (Conduit.ResourceT IO) () -> IO () |