diff options
Diffstat (limited to 'Biz/Bild.hs')
| -rw-r--r-- | Biz/Bild.hs | 71 |
1 files changed, 36 insertions, 35 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs index 19c8827..2dc1e64 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -193,24 +193,24 @@ move args = do root <- Env.getEnv "BIZ_ROOT" IO.hSetBuffering stdout IO.NoBuffering >> pure (Cli.getAllArgs args (Cli.argument "target")) - /> filter (not <. Namespace.isCab) - +> filterM Dir.doesFileExist - +> traverse Dir.makeAbsolute - /> map (Namespace.fromPath root) - /> catMaybes - +> foldM analyze mempty - /> Map.filter (namespace .> isBuildableNs) - +> printOrBuild - +> exitSummary + /> filter (not <. Namespace.isCab) + +> filterM Dir.doesFileExist + +> traverse Dir.makeAbsolute + /> map (Namespace.fromPath root) + /> catMaybes + +> foldM analyze mempty + /> Map.filter (namespace .> isBuildableNs) + +> printOrBuild + +> exitSummary where printOrBuild :: Analysis -> IO [ExitCode] printOrBuild targets | args `Cli.has` Cli.longOption "json" = - Log.wipe >> putJSON targets >> pure [Exit.ExitSuccess] + Log.wipe >> putJSON targets >> pure [Exit.ExitSuccess] | otherwise = do - root <- Env.getEnv "BIZ_ROOT" - createHier root - build isTest isLoud targets + root <- Env.getEnv "BIZ_ROOT" + createHier root + build isTest isLoud targets isTest = args `Cli.has` Cli.longOption "test" isLoud = args `Cli.has` Cli.longOption "loud" putJSON = Aeson.encode .> ByteString.toStrict .> Char8.putStrLn @@ -427,7 +427,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 @@ -613,11 +613,12 @@ analyze hmap ns = case Map.lookup ns hmap of ?: ( Nothing, [ "#!/usr/bin/env bash", "guile -C \"" - <> root </> intdir - <> "\" -e main " - <> "-s " - <> Namespace.toPath namespace - <> " \"$@\"" + <> root + </> intdir + <> "\" -e main " + <> "-s " + <> Namespace.toPath namespace + <> " \"$@\"" ] |> joinWith "\n" |> Text.pack @@ -806,15 +807,15 @@ run Proc {..} = do Async.Concurrently (loud ?: (puts stdout_, logs ns stdout_)) *> Async.Concurrently (loud ?: (puts stderr_, logs ns stderr_)) *> 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) + |> 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, ByteString) @@ -842,13 +843,13 @@ logs :: Namespace -> Conduit.ConduitT () ByteString (Conduit.ResourceT IO) () -> logs ns src = Conduit.runConduitRes <| src - .| Conduit.mapM_ - ( BS.filter (/= BSI.c2w '\n') - .> (\t -> Log.fmt ["info", "bild", nschunk ns, decodeUtf8 t]) - .> Text.take 77 - .> (<> "...\r") - .> putStr - ) + .| Conduit.mapM_ + ( BS.filter (/= BSI.c2w '\n') + .> (\t -> Log.fmt ["info", "bild", nschunk ns, decodeUtf8 t]) + .> Text.take 77 + .> (<> "...\r") + .> putStr + ) nschunk :: Namespace -> Text nschunk = Namespace.toPath .> Text.pack |