diff options
| -rw-r--r-- | Alpha.hs | 7 | ||||
| -rw-r--r-- | Biz/Bild.hs | 59 | ||||
| -rw-r--r-- | Biz/Bild.nix | 2 | ||||
| -rw-r--r-- | Biz/Cli.hs | 7 | ||||
| -rw-r--r-- | Biz/Dragons/Analysis.hs | 2 | ||||
| -rwxr-xr-x | Biz/Ide/repl.bash | 2 |
6 files changed, 52 insertions, 27 deletions
@@ -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"; @@ -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) |