summaryrefslogtreecommitdiff
path: root/Biz
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2021-01-19 12:20:53 -0500
committerBen Sima <ben@bsima.me>2021-01-22 07:19:33 -0500
commite9578a7bb7c116cf71aea0313e64e64abb650f9e (patch)
tree253d199fd579b458b2d9e6adadd655fe23cbdc67 /Biz
parentefa278aa35816f2906e288ffef82d1100181b1e1 (diff)
Add --loud feature to bild
Diffstat (limited to 'Biz')
-rw-r--r--Biz/Bild.hs210
1 files changed, 129 insertions, 81 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index 0182a39..68ae588 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -128,7 +128,7 @@ import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.String as String
import qualified Data.Text as Text
-import Rainbow (chunk, fore, green, putChunkLn, red)
+import Rainbow (Chunk, chunk, fore, green, putChunkLn, red)
import qualified System.Directory as Dir
import qualified System.Environment as Env
import qualified System.Exit as Exit
@@ -146,7 +146,12 @@ main = Cli.main <| Cli.Plan help move test
/> catMaybes
/> filter isBuildableNs
>>= mapM analyze
- >>= mapM_ (build (args `Cli.has` Cli.longOption "test"))
+ >>= mapM
+ ( build
+ (args `Cli.has` Cli.longOption "test")
+ (args `Cli.has` Cli.longOption "loud")
+ )
+ >>= exitSummary
help :: Cli.Docopt
help =
@@ -155,12 +160,23 @@ bild
Usage:
bild test
- bild [--test] <target>...
+ bild --help
+ bild [--test] [--loud] <target>...
Options:
--test Run tests on a target after building.
+ --loud Show all output from compiler.
+ --help Print this info
|]
+exitSummary :: [Exit.ExitCode] -> IO ()
+exitSummary exits =
+ if failures > 0
+ then Exit.die <| show failures
+ else Exit.exitSuccess
+ where
+ failures = length <| filter isFailure exits
+
type Dep = String
type Out = String
@@ -290,8 +306,12 @@ detectGhcCompiler _ content
jsSuffix :: String -> Bool
jsSuffix = List.isSuffixOf ".js"
-build :: Bool -> Target -> IO ()
-build andTest target@Target {..} = do
+isFailure :: Exit.ExitCode -> Bool
+isFailure (Exit.ExitFailure _) = True
+isFailure Exit.ExitSuccess = False
+
+build :: Bool -> Bool -> Target -> IO Exit.ExitCode
+build andTest loud target@Target {..} = do
root <- Env.getEnv "BIZ_ROOT"
case compiler of
GhcExe -> do
@@ -299,119 +319,147 @@ build andTest target@Target {..} = do
let outDir = root </> "_/bild/dev/bin"
Dir.createDirectoryIfMissing True outDir
putText <| "bild: dev: bilder: " <> Text.pack builder
- Process.callProcess
- "ghc"
- [ "-Werror",
- "-i" <> root,
- "-odir",
- root </> "_/bild/int",
- "-hidir",
- root </> "_/bild/int",
- "--make",
- path,
- "-main-is",
- Namespace.toHaskellModule namespace,
- "-o",
- outDir </> out
- ]
+ exitcode <-
+ proc
+ loud
+ "ghc"
+ [ "-Werror",
+ "-i" <> root,
+ "-odir",
+ root </> "_/bild/int",
+ "-hidir",
+ root </> "_/bild/int",
+ "--make",
+ path,
+ "-main-is",
+ Namespace.toHaskellModule namespace,
+ "-o",
+ outDir </> out
+ ]
putChunkLn <| fore green <| "bilt: " <> nschunk namespace
when andTest <| do
Process.readProcessWithExitCode (outDir </> out) ["test"] "" >>= \case
(Exit.ExitSuccess, _, _) ->
putChunkLn <| fore green <| "test: " <> nschunk namespace
- (Exit.ExitFailure _, out, err) -> do
+ (Exit.ExitFailure _, stdout_, stderr_) -> do
putChunkLn <| fore red <| "test: " <> nschunk namespace
- when (out /= mempty) <| putStr out
- when (err /= mempty) <| putStr err
+ when (stdout_ /= mempty) <| putStr stdout_
+ when (stderr_ /= mempty) <| putStr stderr_
+ return exitcode
GhcLib -> do
putStrLn <| "bild: dev: ghc-lib: " <> Namespace.toPath namespace
putText <| "bild: dev: bilder: " <> Text.pack builder
- Process.callProcess
- "ghc"
- [ "-Werror",
- "-i" <> root,
- "-odir",
- root </> "_/bild/int",
- "-hidir",
- root </> "_/bild/int",
- "--make",
- path
- ]
+ exitcode <-
+ proc
+ loud
+ "ghc"
+ [ "-Werror",
+ "-i" <> root,
+ "-odir",
+ root </> "_/bild/int",
+ "-hidir",
+ root </> "_/bild/int",
+ "--make",
+ path
+ ]
putChunkLn <| fore green <| "bilt: " <> nschunk namespace
+ return exitcode
GhcjsExe -> do
putStrLn <| "bild: dev: ghcjs-exe: " <> Namespace.toPath namespace
let outDir = root </> "_/bild/dev/static"
Dir.createDirectoryIfMissing True outDir
putText <| "bild: dev: local: " <> Text.pack builder
- Process.callProcess
- "ghcjs"
- [ "-Werror",
- "-i" <> root,
- "-odir",
- root </> "_/bild/int",
- "-hidir",
- root </> "_/bild/int",
- "--make",
- path,
- "-main-is",
- Namespace.toHaskellModule namespace,
- "-o",
- outDir </> out
- ]
+ exitcode <-
+ proc
+ loud
+ "ghcjs"
+ [ "-Werror",
+ "-i" <> root,
+ "-odir",
+ root </> "_/bild/int",
+ "-hidir",
+ root </> "_/bild/int",
+ "--make",
+ path,
+ "-main-is",
+ Namespace.toHaskellModule namespace,
+ "-o",
+ outDir </> out
+ ]
putChunkLn <| fore green <| "bilt: " <> nschunk namespace
+ return exitcode
GhcjsLib -> do
putStrLn <| "bild: dev: ghcjs-lib: " <> Namespace.toPath namespace
putText <| "bild: dev: local: " <> Text.pack builder
- Process.callProcess
- "ghcjs"
- [ "-Werror",
- "-i" <> root,
- "-odir",
- root </> "_/bild/int",
- "-hidir",
- root </> "_/bild/int",
- "--make",
- path
- ]
+ exitcode <-
+ proc
+ loud
+ "ghcjs"
+ [ "-Werror",
+ "-i" <> root,
+ "-odir",
+ root </> "_/bild/int",
+ "-hidir",
+ root </> "_/bild/int",
+ "--make",
+ path
+ ]
putChunkLn <| fore green <| "bilt: " <> nschunk namespace
+ return exitcode
Guile -> do
putStrLn <| "bild: dev: guile: " <> Namespace.toPath namespace
putText <| "bild: dev: local: " <> Text.pack builder
putText "bild: guile: TODO"
putText <| show target
+ return Exit.ExitSuccess
NixBuild -> do
putStrLn <| "bild: nix: " <> Namespace.toPath namespace
let outDir = root </> "_/bild/nix"
Dir.createDirectoryIfMissing True outDir
if null builder
then putText <| "bild: nix: local"
- else putText <| "bild: nix: remote: " <> Text.pack builder
- Process.callProcess
- "nix-build"
- [ path,
- "-o",
- outDir </> Namespace.toPath namespace,
- -- Set default arguments to nix functions
- "--arg",
- "bild",
- "import " <> root
- </> "Biz/Bild/Rules.nix"
- <> " { nixpkgs = import "
- <> root
- </> "Biz/Bild/Nixpkgs.nix"
- <> "; }",
- "--arg",
- "lib",
- "(import " <> root </> "Biz/Bild/Nixpkgs.nix).lib",
- "--builders",
- builder
- ]
+ else
+ putText <| "bild: nix: remote: "
+ <> Text.pack builder
+ exitcode <-
+ proc
+ loud
+ "nix-build"
+ [ path,
+ "-o",
+ outDir </> Namespace.toPath namespace,
+ -- Set default arguments to nix functions
+ "--arg",
+ "bild",
+ "import " <> root
+ </> "Biz/Bild/Rules.nix"
+ <> " { nixpkgs = import "
+ <> root
+ </> "Biz/Bild/Nixpkgs.nix"
+ <> "; }",
+ "--arg",
+ "lib",
+ "(import " <> root </> "Biz/Bild/Nixpkgs.nix).lib",
+ "--builders",
+ builder
+ ]
putChunkLn <| fore green <| "bilt: " <> nschunk namespace
+ return exitcode
Copy -> do
putStrLn <| "bild: copy: " <> Namespace.toPath namespace
putText "bild: copy: TODO"
putText <| show target
+ return Exit.ExitSuccess
+
+-- | Run a subprocess, handling output appropriately.
+proc :: Bool -> String -> [String] -> IO Exit.ExitCode
+proc loud cmd args = do
+ (exitcode, stdout_, stderr_) <- Process.readProcessWithExitCode cmd args ""
+ when loud <| putStr <| stdout_ ++ stderr_
+ when (isFailure exitcode) <| putStr <| stdout_ ++ stderr_
+ return exitcode
+nschunk :: Namespace -> Chunk
nschunk = chunk <. Text.pack <. Namespace.toPath
metaDep :: Regex.RE Char Dep