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