summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Biz/Bild.hs22
1 files changed, 14 insertions, 8 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index f8385c8..cc10782 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -208,16 +208,14 @@ move args =
/> filter isBuildableNs
+> foldM analyze mempty
+> printOrBuild
- +> exitSummary
- -- convert minutes to microseconds
- |> Timeout.timeout (minutes * 60_000_000)
+ |> Timeout.timeout (toMillis minutes)
+> \case
Nothing ->
- Log.wipe
+ Log.br
>> Log.fail ["bild", "timeout after " <> tshow minutes <> " minutes"]
+ >> Log.br
>> exitWith (ExitFailure 124)
- Just _ ->
- pure ()
+ Just s -> exitSummary s
where
minutes =
Cli.getArgWithDefault args "10" (Cli.longOption "time")
@@ -951,12 +949,17 @@ data Proc = Proc
onSuccess :: IO ()
}
+-- | Convert minutes to milliseconds.
+toMillis :: Num a => a -> a
+toMillis mins = mins * 60_000_000
+
-- | Run a subprocess, streaming output if --loud is set.
run :: Proc -> IO (Exit.ExitCode, ByteString)
run Proc {..} = do
IO.hSetBuffering stdout IO.NoBuffering
loud ?| Log.info ["proc", unwords <| map str <| cmd : args]
Conduit.proc cmd args
+ |> (\proc -> proc {Process.create_group = True})
|> Conduit.streamingProcess
+> \(Conduit.UseProvidedHandle, stdout_, stderr_, hdl) ->
(,,) </ Async.Concurrently (Conduit.waitForStreamingProcess hdl)
@@ -965,11 +968,14 @@ run Proc {..} = do
|> Async.runConcurrently
+> \case
(Exit.ExitFailure n, output, outerr) ->
- putStr outerr
+ Conduit.closeStreamingProcessHandle hdl
+ >> putStr outerr
>> onFailure
>> pure (Exit.ExitFailure n, output)
(Exit.ExitSuccess, output, _) ->
- onSuccess >> pure (Exit.ExitSuccess, output)
+ Conduit.closeStreamingProcessHandle hdl
+ >> onSuccess
+ >> pure (Exit.ExitSuccess, output)
-- | Helper for running a standard bild subprocess.
proc ::