on master help sign in
Allow user control of -j argument #141
commit2d420cc03b96788d82e2d9bc4e39f446f9e2d0f2 authorMichael Snoyman <michael@snoyman.com> dateSun 17 Nov 2013, 14:28 (13 years ago) parent5b6cff8
2 files changed+19−8
Stackage/Build.hs+12−5 app/stackage.hs+7−3
Stackage/Build.hs+12−5
@@ -18,11 +18,20 @@ import System.IO (BufferMode (NoBuffering),
1818import System.Process (rawSystem, runProcess,
1919 waitForProcess)
2020
21−defaultBuildSettings :: GhcMajorVersion -> BuildSettings
22−defaultBuildSettings version = BuildSettings
21+defaultBuildSettings :: Maybe Int -- ^ argument to -j
22+ -> GhcMajorVersion
23+ -> BuildSettings
24+defaultBuildSettings cores version = BuildSettings
2325 { sandboxRoot = "sandbox"
2426 , expectedFailuresBuild = defaultExpectedFailures version
25− , extraArgs = const ["-fnetwork23"]
27+ , extraArgs = \bs -> "-fnetwork23" :
28+ case bs of
29+ BSTest -> []
30+ _ ->
31+ case cores of
32+ Nothing -> ["-j"]
33+ Just 1 -> []
34+ Just j -> ["-j", show j]
2635 , testWorkerThreads = 4
2736 , buildDocs = True
2837 , tarballDir = "patching/tarballs"
@@ -64,7 +73,6 @@ build settings' bp = do
6473 $ "install"
6574 : ("--cabal-lib-version=" ++ libVersion)
6675 : "--build-log=logs-tools/$pkg.log"
67− : "-j"
6876 : [tool]
6977 hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
7078 ph <- runCabal args handle
@@ -89,7 +97,6 @@ build settings' bp = do
8997 : "--build-log=logs/$pkg.log"
9098 : "--max-backjumps=-1"
9199 : "--reorder-goals"
92− : "-j"
93100 : packageList
94101 hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
95102 runCabal args handle
app/stackage.hs+7−3
@@ -47,15 +47,17 @@ data BuildArgs = BuildArgs
4747 , buildPlanSrc :: FilePath
4848 , extraArgs' :: [String] -> [String]
4949 , noDocs :: Bool
50+ , buildCores :: Maybe Int
5051 }
5152
5253parseBuildArgs :: GhcMajorVersion -> [String] -> IO BuildArgs
5354parseBuildArgs version =
5455 loop BuildArgs
55− { sandbox = sandboxRoot $ defaultBuildSettings version
56+ { sandbox = sandboxRoot $ defaultBuildSettings Nothing version
5657 , buildPlanSrc = defaultBuildPlan
5758 , extraArgs' = id
5859 , noDocs = False
60+ , buildCores = Nothing
5961 }
6062 where
6163 loop x [] = return x
@@ -63,6 +65,7 @@ parseBuildArgs version =
6365 loop x ("--build-plan":y:rest) = loop x { buildPlanSrc = y } rest
6466 loop x ("--arg":y:rest) = loop x { extraArgs' = extraArgs' x . (y:) } rest
6567 loop x ("--no-docs":rest) = loop x { noDocs = True } rest
68+ loop x ("-j":y:rest) = loop x { buildCores = Just $ read y } rest
6669 loop _ (y:_) = error $ "Did not understand argument: " ++ y
6770
6871defaultBuildPlan :: FilePath
@@ -73,9 +76,10 @@ withBuildSettings args f = do
7376 version <- getGhcVersion
7477 BuildArgs {..} <- parseBuildArgs version args
7578 bp <- readBuildPlan buildPlanSrc
76− let settings = (defaultBuildSettings version)
79+ let bs = defaultBuildSettings buildCores version
80+ let settings = bs
7781 { sandboxRoot = sandbox
78− , extraArgs = extraArgs' . extraArgs (defaultBuildSettings version)
82+ , extraArgs = extraArgs' . extraArgs bs
7983 , buildDocs = not noDocs
8084 }
8185 f settings bp