diff options
Diffstat (limited to 'Biz/Bild.hs')
| -rw-r--r-- | Biz/Bild.hs | 44 |
1 files changed, 23 insertions, 21 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs index 1ca0a2c..bae0328 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -198,7 +198,8 @@ test_bildExamples = move :: Cli.Arguments -> IO () move args = IO.hSetBuffering stdout IO.NoBuffering - >> Env.getEnv "CODEROOT" +> \root -> + >> Env.getEnv "CODEROOT" + +> \root -> Cli.getAllArgs args (Cli.argument "target") |> filterM Dir.doesFileExist +> filterM (\x -> isGitIgnored x /> don't) @@ -344,7 +345,7 @@ data Compiler | Sbcl deriving (Eq, Show, Generic) -compilerExe :: IsString a => Compiler -> a +compilerExe :: (IsString a) => Compiler -> a compilerExe = \case Copy -> "cp" CPython -> "python" @@ -534,7 +535,7 @@ analyze hmap ns = case Map.lookup ns hmap of withFile abspath ReadMode <| \h -> IO.hSetEncoding h IO.utf8_bom >> Text.IO.hGetContents h - /> Text.lines + /> Text.lines case ext of -- basically we don't support building these Namespace.Css -> pure Nothing @@ -724,10 +725,10 @@ analyze hmap ns = case Map.lookup ns hmap of "guile -C \"" <> root </> intdir - <> "\" -e main " - <> "-s " - <> Namespace.toPath namespace - <> " \"$@\"" + <> "\" -e main " + <> "-s " + <> Namespace.toPath namespace + <> " \"$@\"" ] |> joinWith "\n" |> Text.pack @@ -950,7 +951,7 @@ data Proc = Proc } -- | Convert minutes to milliseconds. -toMillis :: Num a => a -> a +toMillis :: (Num a) => a -> a toMillis mins = mins * 60_000_000 -- | Run a subprocess, streaming output if --loud is set. @@ -959,23 +960,24 @@ 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}) + |> (\proc_ -> proc_ {Process.create_group = True}) |> Conduit.streamingProcess +> \(Conduit.UseProvidedHandle, stdout_, stderr_, hdl) -> - (,,) </ Async.Concurrently (Conduit.waitForStreamingProcess hdl) + (,,) + </ Async.Concurrently (Conduit.waitForStreamingProcess hdl) <*> Async.Concurrently (loud ?: (puts stdout_, logs ns stdout_)) <*> Async.Concurrently (loud ?: (puts stderr_, logs ns stderr_)) - |> Async.runConcurrently - +> \case - (Exit.ExitFailure n, output, outerr) -> - Conduit.closeStreamingProcessHandle hdl - >> putStr outerr - >> onFailure - >> pure (Exit.ExitFailure n, output) - (Exit.ExitSuccess, output, _) -> - Conduit.closeStreamingProcessHandle hdl - >> onSuccess - >> pure (Exit.ExitSuccess, output) + |> Async.runConcurrently + +> \case + (Exit.ExitFailure n, output, outerr) -> + Conduit.closeStreamingProcessHandle hdl + >> putStr outerr + >> onFailure + >> pure (Exit.ExitFailure n, output) + (Exit.ExitSuccess, output, _) -> + Conduit.closeStreamingProcessHandle hdl + >> onSuccess + >> pure (Exit.ExitSuccess, output) -- | Helper for running a standard bild subprocess. proc :: |