diff options
-rw-r--r-- | Biz/Bild.hs | 22 |
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 :: |