diff options
Diffstat (limited to 'Biz')
| -rw-r--r-- | Biz/Bild.hs | 210 |
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 |