1f940f2152ec5df79bfc546cc24db321b08f6a2c
[ghc.git] / hadrian / src / CommandLine.hs
1 module CommandLine (
2 optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, cmdIntegerSimple,
3 cmdProgressColour, cmdProgressInfo, cmdConfigure, cmdSplitObjects,
4 lookupBuildRoot, TestArgs(..), TestSpeed(..), defaultTestArgs
5 ) where
6
7 import Data.Either
8 import qualified Data.HashMap.Strict as Map
9 import Data.List.Extra
10 import Development.Shake hiding (Normal)
11 import Hadrian.Utilities hiding (buildRoot)
12 import System.Console.GetOpt
13 import System.Environment
14
15 data TestSpeed = Slow | Average | Fast deriving (Show, Eq)
16
17 -- | All arguments that can be passed to Hadrian via the command line.
18 data CommandLineArgs = CommandLineArgs
19 { configure :: Bool
20 , flavour :: Maybe String
21 , freeze1 :: Bool
22 , integerSimple :: Bool
23 , progressColour :: UseColour
24 , progressInfo :: ProgressInfo
25 , splitObjects :: Bool
26 , buildRoot :: BuildRoot
27 , testArgs :: TestArgs }
28 deriving (Eq, Show)
29
30 -- | Default values for 'CommandLineArgs'.
31 defaultCommandLineArgs :: CommandLineArgs
32 defaultCommandLineArgs = CommandLineArgs
33 { configure = False
34 , flavour = Nothing
35 , freeze1 = False
36 , integerSimple = False
37 , progressColour = Auto
38 , progressInfo = Brief
39 , splitObjects = False
40 , buildRoot = BuildRoot "_build"
41 , testArgs = defaultTestArgs }
42
43 -- | These arguments are used by the `test` target.
44 data TestArgs = TestArgs
45 { testCompiler :: String
46 , testConfigFile :: String
47 , testConfigs :: [String]
48 , testJUnit :: Maybe FilePath
49 , testOnly :: [String]
50 , testOnlyPerf :: Bool
51 , testSkipPerf :: Bool
52 , testSpeed :: TestSpeed
53 , testSummary :: Maybe FilePath
54 , testVerbosity :: Maybe String
55 , testWays :: [String] }
56 deriving (Eq, Show)
57
58 -- | Default value for `TestArgs`.
59 defaultTestArgs :: TestArgs
60 defaultTestArgs = TestArgs
61 { testCompiler = "stage2"
62 , testConfigFile = "testsuite/config/ghc"
63 , testConfigs = []
64 , testJUnit = Nothing
65 , testOnly = []
66 , testOnlyPerf = False
67 , testSkipPerf = False
68 , testSpeed = Fast
69 , testSummary = Nothing
70 , testVerbosity = Nothing
71 , testWays = [] }
72
73 readConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
74 readConfigure = Right $ \flags -> flags { configure = True }
75
76 readFlavour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
77 readFlavour ms = Right $ \flags -> flags { flavour = lower <$> ms }
78
79 readBuildRoot :: Maybe FilePath -> Either String (CommandLineArgs -> CommandLineArgs)
80 readBuildRoot ms =
81 maybe (Left "Cannot parse build-root") (Right . set) (go =<< ms)
82 where
83 go :: String -> Maybe BuildRoot
84 go = Just . BuildRoot
85 set :: BuildRoot -> CommandLineArgs -> CommandLineArgs
86 set flag flags = flags { buildRoot = flag }
87
88 readFreeze1 :: Either String (CommandLineArgs -> CommandLineArgs)
89 readFreeze1 = Right $ \flags -> flags { freeze1 = True }
90
91 readIntegerSimple :: Either String (CommandLineArgs -> CommandLineArgs)
92 readIntegerSimple = Right $ \flags -> flags { integerSimple = True }
93
94 readProgressColour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
95 readProgressColour ms =
96 maybe (Left "Cannot parse progress-colour") (Right . set) (go =<< lower <$> ms)
97 where
98 go :: String -> Maybe UseColour
99 go "never" = Just Never
100 go "auto" = Just Auto
101 go "always" = Just Always
102 go _ = Nothing
103 set :: UseColour -> CommandLineArgs -> CommandLineArgs
104 set flag flags = flags { progressColour = flag }
105
106 readProgressInfo :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
107 readProgressInfo ms =
108 maybe (Left "Cannot parse progress-info") (Right . set) (go =<< lower <$> ms)
109 where
110 go :: String -> Maybe ProgressInfo
111 go "none" = Just None
112 go "brief" = Just Brief
113 go "normal" = Just Normal
114 go "unicorn" = Just Unicorn
115 go _ = Nothing
116 set :: ProgressInfo -> CommandLineArgs -> CommandLineArgs
117 set flag flags = flags { progressInfo = flag }
118
119 readSplitObjects :: Either String (CommandLineArgs -> CommandLineArgs)
120 readSplitObjects = Right $ \flags -> flags { splitObjects = True }
121
122 readTestCompiler :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
123 readTestCompiler compiler = maybe (Left "Cannot parse compiler") (Right . set) compiler
124 where
125 set compiler = \flags -> flags { testArgs = (testArgs flags) { testCompiler = compiler } }
126
127 readTestConfig :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
128 readTestConfig config =
129 case config of
130 Nothing -> Right id
131 Just conf -> Right $ \flags ->
132 let configs = conf : testConfigs (testArgs flags)
133 in flags { testArgs = (testArgs flags) { testConfigs = configs } }
134
135 readTestConfigFile :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
136 readTestConfigFile filepath =
137 maybe (Left "Cannot parse test-speed") (Right . set) filepath
138 where
139 set filepath flags = flags { testArgs = (testArgs flags) { testConfigFile = filepath } }
140
141 readTestJUnit :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
142 readTestJUnit filepath = Right $ \flags -> flags { testArgs = (testArgs flags) { testJUnit = filepath } }
143
144 readTestOnly :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
145 readTestOnly tests = Right $ \flags ->
146 flags { testArgs = (testArgs flags) { testOnly = tests' } }
147
148 where tests' = maybe [] words tests
149
150 readTestOnlyPerf :: Either String (CommandLineArgs -> CommandLineArgs)
151 readTestOnlyPerf = Right $ \flags -> flags { testArgs = (testArgs flags) { testOnlyPerf = True } }
152
153 readTestSkipPerf :: Either String (CommandLineArgs -> CommandLineArgs)
154 readTestSkipPerf = Right $ \flags -> flags { testArgs = (testArgs flags) { testSkipPerf = True } }
155
156 readTestSpeed :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
157 readTestSpeed ms =
158 maybe (Left "Cannot parse test-speed") (Right . set) (go =<< lower <$> ms)
159 where
160 go :: String -> Maybe TestSpeed
161 go "fast" = Just Fast
162 go "slow" = Just Slow
163 go "average" = Just Average
164 go _ = Nothing
165 set :: TestSpeed -> CommandLineArgs -> CommandLineArgs
166 set flag flags = flags { testArgs = (testArgs flags) {testSpeed = flag} }
167
168 readTestSummary :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
169 readTestSummary filepath = Right $ \flags -> flags { testArgs = (testArgs flags) { testJUnit = filepath } }
170
171 readTestVerbose :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
172 readTestVerbose verbose = Right $ \flags -> flags { testArgs = (testArgs flags) { testVerbosity = verbose } }
173
174 readTestWay :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
175 readTestWay way =
176 case way of
177 Nothing -> Right id
178 Just way -> Right $ \flags ->
179 let newWays = way : testWays (testArgs flags)
180 in flags { testArgs = (testArgs flags) {testWays = newWays} }
181
182 -- | Standard 'OptDescr' descriptions of Hadrian's command line arguments.
183 optDescrs :: [OptDescr (Either String (CommandLineArgs -> CommandLineArgs))]
184 optDescrs =
185 [ Option ['c'] ["configure"] (NoArg readConfigure)
186 "Run the boot and configure scripts (if you do not want to run them manually)."
187 , Option ['o'] ["build-root"] (OptArg readBuildRoot "BUILD_ROOT")
188 "Where to store build artifacts. (Default _build)."
189 , Option [] ["flavour"] (OptArg readFlavour "FLAVOUR")
190 "Build flavour (Default, Devel1, Devel2, Perf, Prof, Quick or Quickest)."
191 , Option [] ["freeze1"] (NoArg readFreeze1)
192 "Freeze Stage1 GHC."
193 , Option [] ["integer-simple"] (NoArg readIntegerSimple)
194 "Build GHC with integer-simple library."
195 , Option [] ["progress-colour"] (OptArg readProgressColour "MODE")
196 "Use colours in progress info (Never, Auto or Always)."
197 , Option [] ["progress-info"] (OptArg readProgressInfo "STYLE")
198 "Progress info style (None, Brief, Normal or Unicorn)."
199 , Option [] ["split-objects"] (NoArg readSplitObjects)
200 "Generate split objects (requires a full clean rebuild)."
201 , Option [] ["test-compiler"] (OptArg readTestCompiler "TEST_COMPILER")
202 "Use given compiler [Default=stage2]."
203 , Option [] ["test-config-file"] (OptArg readTestConfigFile "CONFIG_FILE")
204 "configuration file for testsuite. Default=testsuite/config/ghc"
205 , Option [] ["config"] (OptArg readTestConfig "EXTRA_TEST_CONFIG")
206 "Configurations to run test, in key=value format."
207 , Option [] ["summary-junit"] (OptArg readTestJUnit "TEST_SUMMARY_JUNIT")
208 "Output testsuite summary in JUnit format."
209 , Option [] ["only"] (OptArg readTestOnly "TESTS")
210 "Test cases to run."
211 , Option [] ["only-perf"] (NoArg readTestOnlyPerf)
212 "Only run performance tests."
213 , Option [] ["skip-perf"] (NoArg readTestSkipPerf)
214 "Skip performance tests."
215 , Option [] ["test-speed"] (OptArg readTestSpeed "SPEED")
216 "fast, slow or normal. Normal by default"
217 , Option [] ["summary"] (OptArg readTestSummary "TEST_SUMMARY")
218 "Where to output the test summary file."
219 , Option [] ["test-verbose"] (OptArg readTestVerbose "TEST_VERBOSE")
220 "A verbosity value between 0 and 5. 0 is silent, 4 and higher activates extra output."
221 , Option [] ["test-way"] (OptArg readTestWay "TEST_WAY")
222 "only run these ways" ]
223
224 -- | A type-indexed map containing Hadrian command line arguments to be passed
225 -- to Shake via 'shakeExtra'.
226 cmdLineArgsMap :: IO (Map.HashMap TypeRep Dynamic)
227 cmdLineArgsMap = do
228 (opts, _, _) <- getOpt Permute optDescrs <$> getArgs
229 let args = foldl (flip id) defaultCommandLineArgs (rights opts)
230 return $ insertExtra (progressColour args) -- Accessed by Hadrian.Utilities
231 $ insertExtra (progressInfo args) -- Accessed by Hadrian.Utilities
232 $ insertExtra (buildRoot args) -- Accessed by Hadrian.Utilities
233 $ insertExtra (testArgs args) -- Accessed by Settings.Builders.RunTest
234 $ insertExtra args Map.empty
235
236 cmdLineArgs :: Action CommandLineArgs
237 cmdLineArgs = userSetting defaultCommandLineArgs
238
239 cmdConfigure :: Action Bool
240 cmdConfigure = configure <$> cmdLineArgs
241
242 cmdFlavour :: Action (Maybe String)
243 cmdFlavour = flavour <$> cmdLineArgs
244
245 lookupBuildRoot :: Map.HashMap TypeRep Dynamic -> BuildRoot
246 lookupBuildRoot = buildRoot . lookupExtra defaultCommandLineArgs
247
248 lookupFreeze1 :: Map.HashMap TypeRep Dynamic -> Bool
249 lookupFreeze1 = freeze1 . lookupExtra defaultCommandLineArgs
250
251 cmdIntegerSimple :: Action Bool
252 cmdIntegerSimple = integerSimple <$> cmdLineArgs
253
254 cmdProgressColour :: Action UseColour
255 cmdProgressColour = progressColour <$> cmdLineArgs
256
257 cmdProgressInfo :: Action ProgressInfo
258 cmdProgressInfo = progressInfo <$> cmdLineArgs
259
260 cmdSplitObjects :: Action Bool
261 cmdSplitObjects = splitObjects <$> cmdLineArgs