diff options
| -rw-r--r-- | Biz/Bild.hs | 285 | ||||
| -rw-r--r-- | Biz/Bild/Deps/Haskell.nix | 2 |
2 files changed, 168 insertions, 119 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs index 68ae588..ab6f5bb 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -7,6 +7,8 @@ -- | A general purpose build tool. -- -- : out bild +-- : dep conduit +-- : dep conduit-extra -- : dep docopt -- : dep regex-applicative -- : dep rainbow @@ -124,16 +126,21 @@ import Biz.Namespace (Namespace (..)) import qualified Biz.Namespace as Namespace import Biz.Test ((@=?)) import qualified Biz.Test as Test +import qualified Control.Concurrent.Async as Async import qualified Data.Char as Char +import Data.Conduit ((.|)) +import qualified Data.Conduit as Conduit +import qualified Data.Conduit.List as Conduit +import qualified Data.Conduit.Process as Conduit import qualified Data.List as List import qualified Data.String as String import qualified Data.Text as Text -import Rainbow (Chunk, chunk, fore, green, putChunkLn, red) +import Rainbow (chunk, fore, green, putChunk, red, white, yellow) import qualified System.Directory as Dir import qualified System.Environment as Env import qualified System.Exit as Exit import System.FilePath ((</>)) -import qualified System.Process as Process +import qualified System.IO as IO import qualified Text.Regex.Applicative as Regex import qualified Prelude @@ -142,7 +149,8 @@ main = Cli.main <| Cli.Plan help move test where test = Test.group "Biz.Bild" [Test.unit "id" <| 1 @=? (1 :: Integer)] move args = - mapM getNamespace (Cli.getAllArgs args (Cli.argument "target")) + IO.hSetBuffering stdout IO.NoBuffering + >> mapM getNamespace (Cli.getAllArgs args (Cli.argument "target")) /> catMaybes /> filter isBuildableNs >>= mapM analyze @@ -160,8 +168,7 @@ bild Usage: bild test - bild --help - bild [--test] [--loud] <target>... + bild [options] <target>... Options: --test Run tests on a target after building. @@ -311,17 +318,17 @@ isFailure (Exit.ExitFailure _) = True isFailure Exit.ExitSuccess = False build :: Bool -> Bool -> Target -> IO Exit.ExitCode -build andTest loud target@Target {..} = do +build andTest loud Target {..} = do root <- Env.getEnv "BIZ_ROOT" case compiler of GhcExe -> do - putStrLn <| "bild: dev: ghc-exe: " <> Namespace.toPath namespace + msg Info ["bild", "dev", "ghc-exe", nschunk namespace] let outDir = root </> "_/bild/dev/bin" Dir.createDirectoryIfMissing True outDir - putText <| "bild: dev: bilder: " <> Text.pack builder exitcode <- proc loud + namespace "ghc" [ "-Werror", "-i" <> root, @@ -336,131 +343,171 @@ build andTest loud target@Target {..} = do "-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 _, stdout_, stderr_) -> do - putChunkLn <| fore red <| "test: " <> nschunk namespace - when (stdout_ /= mempty) <| putStr stdout_ - when (stderr_ /= mempty) <| putStr stderr_ - return exitcode + if andTest + then + run + <| Proc + { loud = loud, + cmd = outDir </> out, + args = ["test"], + ns = namespace, + onFailure = msg Fail ["test", nschunk namespace] >> br, + onSuccess = msg Pass ["test", nschunk namespace] >> br + } + else return exitcode GhcLib -> do - putStrLn <| "bild: dev: ghc-lib: " <> Namespace.toPath namespace - putText <| "bild: dev: bilder: " <> Text.pack builder - 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 + msg Info ["bild", "dev", "ghc-lib", nschunk namespace] + proc + loud + namespace + "ghc" + [ "-Werror", + "-i" <> root, + "-odir", + root </> "_/bild/int", + "-hidir", + root </> "_/bild/int", + "--make", + path + ] GhcjsExe -> do - putStrLn <| "bild: dev: ghcjs-exe: " <> Namespace.toPath namespace + msg Info ["bild", "dev", "ghcjs-exe", nschunk namespace] let outDir = root </> "_/bild/dev/static" Dir.createDirectoryIfMissing True outDir - putText <| "bild: dev: local: " <> Text.pack builder - 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 + proc + loud + namespace + "ghcjs" + [ "-Werror", + "-i" <> root, + "-odir", + root </> "_/bild/int", + "-hidir", + root </> "_/bild/int", + "--make", + path, + "-main-is", + Namespace.toHaskellModule namespace, + "-o", + outDir </> out + ] GhcjsLib -> do - putStrLn <| "bild: dev: ghcjs-lib: " <> Namespace.toPath namespace - putText <| "bild: dev: local: " <> Text.pack builder - 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 + msg Info ["bild", "dev", "ghcjs-lib", nschunk namespace] + proc + loud + namespace + "ghcjs" + [ "-Werror", + "-i" <> root, + "-odir", + root </> "_/bild/int", + "-hidir", + root </> "_/bild/int", + "--make", + path + ] Guile -> do - putStrLn <| "bild: dev: guile: " <> Namespace.toPath namespace - putText <| "bild: dev: local: " <> Text.pack builder - putText "bild: guile: TODO" - putText <| show target + msg Warn ["bild", "guile", "TODO", nschunk namespace] return Exit.ExitSuccess NixBuild -> do - putStrLn <| "bild: nix: " <> Namespace.toPath namespace + msg + Info + [ "bild", + "nix", + if null builder + then "local" + else builder, + nschunk 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 - 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 + proc + loud + namespace + "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 + ] Copy -> do - putStrLn <| "bild: copy: " <> Namespace.toPath namespace - putText "bild: copy: TODO" - putText <| show target + msg Warn ["bild", "copy", "TODO", nschunk namespace] 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 +data Proc = Proc + { loud :: Bool, + cmd :: String, + args :: [String], + ns :: Namespace, + onFailure :: IO (), + onSuccess :: IO () + } + +-- | Run a subprocess, streaming output if --loud is set. +run :: Proc -> IO Exit.ExitCode +run Proc {..} = do + (Conduit.Inherited, stdout_, stderr_, cph) <- Conduit.streamingProcess <| Conduit.proc cmd args + exitcode <- + if loud + then + Async.runConcurrently + <| Async.Concurrently (puts stdout_) + *> (Async.Concurrently <| Conduit.waitForStreamingProcess cph) + else Async.runConcurrently <| Async.Concurrently <| Conduit.waitForStreamingProcess cph + if isFailure exitcode + then puts stderr_ >> onFailure >> return exitcode + else onSuccess >> return exitcode + +-- | Helper for running a standard bild subprocess. +proc :: Bool -> Namespace -> String -> [String] -> IO Exit.ExitCode +proc loud namespace cmd args = + run + <| Proc + { loud = loud, + ns = namespace, + cmd = cmd, + args = args, + onFailure = msg Fail ["bild", nschunk namespace] >> br, + onSuccess = msg Good ["bild", nschunk namespace] >> br + } + +data Lvl = Good | Pass | Info | Warn | Fail + +msg :: Lvl -> [String] -> IO () +msg lvl labels = putChunk <| fore color <| clear <> txt <> "\r" + where + txt = chunk <| Text.pack <| joinWith gap (label : labels) + (color, label) = case lvl of + Good -> (green, "good") + Pass -> (green, "pass") + Info -> (white, "info") + Warn -> (yellow, "warn") + Fail -> (red, "fail") + gap = ": " + clear = "\ESC[2K" + +br :: IO () +br = putChunk "\n" + +-- | Helper for printing during a subprocess +puts :: Conduit.ConduitM () ByteString IO () -> IO () +puts thing = Conduit.runConduit <| thing .| Conduit.mapM_ putStr -nschunk :: Namespace -> Chunk -nschunk = chunk <. Text.pack <. Namespace.toPath +nschunk :: Namespace -> String +nschunk = Namespace.toPath metaDep :: Regex.RE Char Dep metaDep = Regex.string "-- : dep " *> Regex.many (Regex.psym Char.isAlpha) diff --git a/Biz/Bild/Deps/Haskell.nix b/Biz/Bild/Deps/Haskell.nix index 21fcb66..4434cb3 100644 --- a/Biz/Bild/Deps/Haskell.nix +++ b/Biz/Bild/Deps/Haskell.nix @@ -11,6 +11,8 @@ with hpkgs; clay cmark cmark-lucid + conduit + conduit-extra config-ini containers directory |