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