Add --jobs and --cpus to bild

By default, nix will use the maximum amount of cores available to the machine.
On my machine it was maxxing out the CPUs and then actually running out of RAM
when compiling JavaScriptCore and literally shutting down my machine. So, I need
to be able to control the concurrency and parallelism.

The default settings I chose should reserve 4 cores for the user.

I also changed --json to --plan because -j makes more sense for --jobs, as its
used this way in other tools like make and nix-build.

6 files changed, 52 insertions, 27 deletions

diff --git a/Alpha.hs b/Alpha.hs
index e53474b..ba35e5b 100644
--- a/Alpha.hs
+++ b/Alpha.hs
@@ -83,7 +83,7 @@ import qualified Data.List as List
 import Data.String
 import qualified Data.Text as Text
 import qualified Data.Text.Lazy as LazyText
-import Protolude as X hiding (list, ($), (&), (.), (>>=))
+import Protolude as X hiding (list, toS, ($), (&), (.), (>>=))
 import Protolude.Conv
 import qualified Prelude
 
@@ -248,7 +248,10 @@ wrap lim = Text.words .> wrap_ 0 .> Text.unwords
 -- | Automatically convert any string-like type into any other string-like type,
 -- using types to infer the appropriate conversion.
 str :: (StringConv a b) => a -> b
-str = Protolude.Conv.toS
+str = toS
+
+instance StringConv Int String where
+  strConv _ = show
 
 tshow :: Show a => a -> Text
 tshow = show
diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index 66a0ae4..967dfbf 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -55,7 +55,7 @@
 --        * -o = optimize level
 --
 --    * The build is planned out with an analysis, which can be viewed
---      beforehand with `--json`. The analysis includes compiler flags, which
+--      beforehand with `--plan`. The analysis includes compiler flags, which
 --      can be used in `repl` for testing compilation locally.
 --
 --    * (WIP) Nix is used by default to build everything on a remote build
@@ -140,6 +140,7 @@ import qualified Data.Set as Set
 import qualified Data.String as String
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text.IO
+import qualified GHC.Conc as GHC
 import qualified Network.HostName as HostName
 import qualified System.Directory as Dir
 import qualified System.Environment as Env
@@ -171,7 +172,7 @@ test_bildBild =
       Nothing -> Test.assertFailure "can't find ns for bild"
       Just ns ->
         analyze mempty ns
-          +> build False False
+          +> build False False 1 2
           +> \case
             [Exit.ExitFailure _] ->
               Test.assertFailure "can't bild bild"
@@ -188,7 +189,7 @@ test_bildExamples =
         /> map (Namespace.fromPath root)
         /> catMaybes
         +> foldM analyze mempty
-        +> build False False
+        +> build False False 4 1
         +> \case
           [] -> Test.assertFailure "asdf"
           xs -> all (== Exit.ExitSuccess) xs @=? True
@@ -217,7 +218,7 @@ move args =
             pure ()
   where
     minutes =
-      Cli.getArgWithDefault args (Cli.longOption "time")
+      Cli.getArgWithDefault args "10" (Cli.longOption "time")
         |> readMaybe
         |> \case
           Nothing -> panic "could not read --time argument"
@@ -229,12 +230,27 @@ move args =
             >> Log.fail ["bild", "nothing to build"]
             >> Log.br
             >> exitWith (ExitFailure 1)
-      | args `Cli.has` Cli.longOption "json" =
+      | args `Cli.has` Cli.longOption "plan" =
           Log.wipe >> putJSON targets >> pure [Exit.ExitSuccess]
       | otherwise = do
           root <- Env.getEnv "CODEROOT"
+          nproc <- GHC.getNumProcessors
           createHier root
-          build isTest isLoud targets
+          build isTest isLoud jobs (cpus nproc) targets
+    cpus :: Int -> Int
+    cpus nproc =
+      Cli.getArgWithDefault args (str <| (nproc - 4) `div` jobs) (Cli.longOption "cpus")
+        |> readMaybe
+        |> \case
+          Nothing -> panic "could not read --cpus argument"
+          Just n -> n
+    jobs :: Int
+    jobs =
+      Cli.getArgWithDefault args "6" (Cli.longOption "jobs")
+        |> readMaybe
+        |> \case
+          Nothing -> panic "could not read --jobs argument"
+          Just n -> n
     isTest = args `Cli.has` Cli.longOption "test"
     isLoud = args `Cli.has` Cli.longOption "loud"
     putJSON = Aeson.encode .> ByteString.Lazy.toStrict .> Char8.putStrLn
@@ -283,8 +299,10 @@ Usage:
 Options:
   --test, -t   Run tests on a target after building
   --loud, -l   Show all output from compiler
-  --json, -j   Print the build plan as JSON, don't build
+  --plan, -p   Print the build plan as JSON, don't build
   --time N     Set timeout to N minutes, 0 means never timeout [default: 10]
+  --jobs, -j   Number of jobs to build at once [default: 6]
+  --cpus, -c   Number of cpu cores to use per job [default: (nproc-4)/jobs]
   --help, -h   Print this info
 |]
 
@@ -842,21 +860,21 @@ test loud Target {..} = case compiler of
       >> Log.br
       >> pure (Exit.ExitFailure 1, mempty)
 
-build :: Bool -> Bool -> Analysis -> IO [Exit.ExitCode]
-build andTest loud analysis =
+build :: Bool -> Bool -> Int -> Int -> Analysis -> IO [Exit.ExitCode]
+build andTest loud jobs cpus analysis =
   Env.getEnv "CODEROOT" +> \root ->
     forM (Map.elems analysis) <| \target@Target {..} ->
       fst </ case compiler of
         CPython -> case out of
           Meta.Bin _ ->
             Log.info ["bild", "nix", "python", nschunk namespace]
-              >> nixBuild loud target
+              >> nixBuild loud jobs cpus target
           _ ->
             Log.info ["bild", "nix", "python", nschunk namespace, "cannot build library"]
               >> pure (Exit.ExitSuccess, mempty)
         Gcc ->
           Log.info ["bild", label, "gcc", nschunk namespace]
-            >> nixBuild loud target
+            >> nixBuild loud jobs cpus target
           where
             label = case out of
               Meta.Bin _ -> "bin"
@@ -865,7 +883,7 @@ build andTest loud analysis =
           Meta.None -> pure (Exit.ExitSuccess, mempty)
           Meta.Bin _ -> do
             Log.info ["bild", "nix", user <> "@" <> host, nschunk namespace]
-            result <- nixBuild loud target
+            result <- nixBuild loud jobs cpus target
             if andTest && (isSuccess <| fst result)
               then test loud target
               else pure result
@@ -890,7 +908,7 @@ build andTest loud analysis =
           pure (Exit.ExitSuccess, mempty)
         Rustc ->
           Log.info ["bild", "dev", "rust", nschunk namespace]
-            >> nixBuild loud target
+            >> nixBuild loud jobs cpus target
         Sbcl -> do
           Log.info ["bild", "dev", "lisp", nschunk namespace]
           proc loud namespace (toNixFlag compiler) compilerFlags
@@ -1000,8 +1018,8 @@ lispRequires =
     isQuote :: Char -> Bool
     isQuote c = c `elem` ['\'', ':']
 
-nixBuild :: Bool -> Target -> IO (Exit.ExitCode, ByteString)
-nixBuild loud target@(Target {..}) =
+nixBuild :: Bool -> Int -> Int -> Target -> IO (Exit.ExitCode, ByteString)
+nixBuild loud maxJobs cores target@(Target {..}) =
   Env.getEnv "CODEROOT" +> \root ->
     instantiate root |> run +> \case
       (_, "") -> panic "instantiate did not produce a drv"
@@ -1039,7 +1057,16 @@ nixBuild loud target@(Target {..}) =
         { loud = loud,
           ns = namespace,
           cmd = "nix-store",
-          args = ["--realise", drv, "--add-root", nixdir </> outname out],
+          args =
+            [ "--realise",
+              drv,
+              "--add-root",
+              nixdir </> outname out,
+              "--max-jobs",
+              str maxJobs,
+              "--cores",
+              str cores
+            ],
           onFailure = Log.fail ["bild", "realise", nschunk namespace] >> Log.br,
           onSuccess = Log.good ["bild", nschunk namespace] >> Log.br
         }
diff --git a/Biz/Bild.nix b/Biz/Bild.nix
index 4e1fb4c..097a089 100644
--- a/Biz/Bild.nix
+++ b/Biz/Bild.nix
@@ -111,7 +111,7 @@ in nixpkgs // { bild = rec {
     TARGET = "." + lib.strings.removePrefix (toString src) (toString target);
     buildPhase = ''
       mkdir $out
-      ${bild}/bin/bild --json "$TARGET" 1> $out/analysis.json \
+      ${bild}/bin/bild --plan "$TARGET" 1> $out/analysis.json \
         2> >(tee -a $out/stderr >&2)
     '';
     installPhase = "exit 0";
diff --git a/Biz/Cli.hs b/Biz/Cli.hs
index 819fdf1..b3c7583 100644
--- a/Biz/Cli.hs
+++ b/Biz/Cli.hs
@@ -10,7 +10,7 @@ module Biz.Cli
     Docopt.docopt,
     Docopt.getAllArgs,
     Docopt.getArg,
-    getArgWithDefault,
+    Docopt.getArgWithDefault,
     Docopt.longOption,
     Docopt.shortOption,
     Docopt.command,
@@ -44,8 +44,3 @@ main Plan {..} =
 
 has :: Docopt.Arguments -> Docopt.Option -> Bool
 has = Docopt.isPresent
-
--- | This ignores the second argument because the default should come from the
--- USAGE text with [default: x].
-getArgWithDefault :: Docopt.Arguments -> Docopt.Option -> String
-getArgWithDefault args = Docopt.getArgWithDefault args ""
diff --git a/Biz/Dragons/Analysis.hs b/Biz/Dragons/Analysis.hs
index c27eebb..a946b4d 100644
--- a/Biz/Dragons/Analysis.hs
+++ b/Biz/Dragons/Analysis.hs
@@ -44,7 +44,7 @@ move args = gitDir +> run authors /> Aeson.encode +> putStrLn
   where
     gitDir =
       Cli.longOption "git-dir"
-        |> Cli.getArgWithDefault args
+        |> Cli.getArgWithDefault args ""
         |> Directory.makeAbsolute
     authors =
       -- i think this is not working? do i need optparse-applicative?
diff --git a/Biz/Ide/repl.bash b/Biz/Ide/repl.bash
index fcc7eba..a14b0b8 100755
--- a/Biz/Ide/repl.bash
+++ b/Biz/Ide/repl.bash
@@ -25,7 +25,7 @@ fi
     shift
   fi
   targets=${@:?}
-  json=$(bild --json ${targets[@]})
+  json=$(bild --plan ${targets[@]})
   langdeps=$(jq --raw-output '.[].langdeps | join(" ")' <<< $json)
   sysdeps=$(jq --raw-output '.[].sysdeps | join(" ")' <<< $json)
   rundeps=$(jq --raw-output '.[].rundeps | join(" ")' <<< $json)