@@ -38,9 +38,39 @@ parseSelectArgs =
3838 loop x ("--build-plan":y:rest) = loop x { buildPlanDest = y } rest
3939 loop _ (y:_) = error $ "Did not understand argument: " ++ y
4040
41+data BuildArgs = BuildArgs
42+ { sandbox :: String
43+ , buildPlanSrc :: FilePath
44+ , extraArgs' :: [String] -> [String]
45+ }
46+
47+parseBuildArgs :: [String] -> IO BuildArgs
48+parseBuildArgs =
49+ loop BuildArgs
50+ { sandbox = sandboxRoot defaultBuildSettings
51+ , buildPlanSrc = defaultBuildPlan
52+ , extraArgs' = id
53+ }
54+ where
55+ loop x [] = return x
56+ loop x ("--sandbox":y:rest) = loop x { sandbox = y } rest
57+ loop x ("--build-plan":y:rest) = loop x { buildPlanSrc = y } rest
58+ loop x ("--arg":y:rest) = loop x { extraArgs' = extraArgs' x . (y:) } rest
59+ loop _ (y:_) = error $ "Did not understand argument: " ++ y
60+
4161defaultBuildPlan :: FilePath
4262defaultBuildPlan = "build-plan.txt"
4363
64+withBuildSettings :: [String] -> (BuildSettings -> BuildPlan -> IO a) -> IO a
65+withBuildSettings args f = do
66+ BuildArgs {..} <- parseBuildArgs args
67+ bp <- readBuildPlan buildPlanSrc
68+ let settings = defaultBuildSettings
69+ { sandboxRoot = sandbox
70+ , extraArgs = extraArgs' $ extraArgs defaultBuildSettings
71+ }
72+ f settings bp
73+
4474main :: IO ()
4575main = do
4676 args <- getArgs
@@ -57,13 +87,10 @@ main = do
5787 else const $ Right ()
5888 }
5989 writeBuildPlan buildPlanDest bp
60− ["check"] -> checkHelper defaultBuildPlan
61− ["check", fp] -> checkHelper fp
62− ["build"] -> buildHelper defaultBuildPlan
63− ["build", fp] -> buildHelper fp
64− ["test"] -> testHelper defaultBuildPlan
65− ["test", fp] -> testHelper fp
66− ["tarballs"] -> tbHelper defaultBuildPlan
90+ ("check":rest) -> withBuildSettings rest $ const checkPlan
91+ ("build":rest) -> withBuildSettings rest build
92+ ("test":rest) -> withBuildSettings rest runTestSuites
93+ ("tarballs":rest) -> withBuildSettings rest $ const makeTarballs
6794 ["init"] -> do
6895 putStrLn "Note: init isn't really ready for prime time use."
6996 putStrLn "Using it may make it impossible to build stackage."
@@ -81,11 +108,6 @@ main = do
81108 --putStrLn " update Download updated Stackage databases. Automatically calls init."
82109 --putStrLn " init Initialize your cabal file to use Stackage"
83110 putStrLn " select [--no-clean] [--no-platform] [--exclude package...] [--only-permissive] [--allow package] [--build-plan file]"
84− putStrLn " check [build plan file]"
85− putStrLn " build [build plan file]"
86− putStrLn " test [build plan file]"
87− where
88− checkHelper fp = readBuildPlan fp >>= checkPlan
89− buildHelper fp = readBuildPlan fp >>= build defaultBuildSettings
90− testHelper fp = readBuildPlan fp >>= runTestSuites defaultBuildSettings
91− tbHelper fp = readBuildPlan fp >>= makeTarballs
111+ putStrLn " check [--build-plan file] [--sandbox rootdir] [--arg cabal-arg]"
112+ putStrLn " build [--build-plan file] [--sandbox rootdir] [--arg cabal-arg]"
113+ putStrLn " test [--build-plan file] [--sandbox rootdir] [--arg cabal-arg]"