Fix warnings (#547)
[hadrian.git] / src / CommandLine.hs
1 module CommandLine (
2 optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, cmdIntegerSimple,
3 cmdProgressColour, cmdProgressInfo, cmdConfigure, cmdSplitObjects,
4 cmdInstallDestDir, lookupBuildRoot, TestArgs(..), 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 -- | All arguments that can be passed to Hadrian via the command line.
16 data CommandLineArgs = CommandLineArgs
17 { configure :: Bool
18 , flavour :: Maybe String
19 , freeze1 :: Bool
20 , installDestDir :: Maybe String
21 , integerSimple :: Bool
22 , progressColour :: UseColour
23 , progressInfo :: ProgressInfo
24 , splitObjects :: Bool
25 , buildRoot :: BuildRoot
26 , testArgs :: TestArgs }
27 deriving (Eq, Show)
28
29 -- | Default values for 'CommandLineArgs'.
30 defaultCommandLineArgs :: CommandLineArgs
31 defaultCommandLineArgs = CommandLineArgs
32 { configure = False
33 , flavour = Nothing
34 , freeze1 = False
35 , installDestDir = Nothing
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 { testOnly :: Maybe String
46 , testSkipPerf :: Bool
47 , testSummary :: Maybe FilePath
48 , testJUnit :: Maybe FilePath
49 , testConfigs :: [String] }
50 deriving (Eq, Show)
51
52 -- | Default value for `TestArgs`.
53 defaultTestArgs :: TestArgs
54 defaultTestArgs = TestArgs
55 { testOnly = Nothing
56 , testSkipPerf = False
57 , testSummary = Nothing
58 , testJUnit = Nothing
59 , testConfigs = [] }
60
61 readConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
62 readConfigure = Right $ \flags -> flags { configure = True }
63
64 readFlavour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
65 readFlavour ms = Right $ \flags -> flags { flavour = lower <$> ms }
66
67 readBuildRoot :: Maybe FilePath -> Either String (CommandLineArgs -> CommandLineArgs)
68 readBuildRoot ms =
69 maybe (Left "Cannot parse build-root") (Right . set) (go =<< ms)
70 where
71 go :: String -> Maybe BuildRoot
72 go = Just . BuildRoot
73 set :: BuildRoot -> CommandLineArgs -> CommandLineArgs
74 set flag flags = flags { buildRoot = flag }
75
76 readFreeze1 :: Either String (CommandLineArgs -> CommandLineArgs)
77 readFreeze1 = Right $ \flags -> flags { freeze1 = True }
78
79 readInstallDestDir :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
80 readInstallDestDir ms = Right $ \flags -> flags { installDestDir = ms }
81
82 readIntegerSimple :: Either String (CommandLineArgs -> CommandLineArgs)
83 readIntegerSimple = Right $ \flags -> flags { integerSimple = True }
84
85 readProgressColour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
86 readProgressColour ms =
87 maybe (Left "Cannot parse progress-colour") (Right . set) (go =<< lower <$> ms)
88 where
89 go :: String -> Maybe UseColour
90 go "never" = Just Never
91 go "auto" = Just Auto
92 go "always" = Just Always
93 go _ = Nothing
94 set :: UseColour -> CommandLineArgs -> CommandLineArgs
95 set flag flags = flags { progressColour = flag }
96
97 readProgressInfo :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
98 readProgressInfo ms =
99 maybe (Left "Cannot parse progress-info") (Right . set) (go =<< lower <$> ms)
100 where
101 go :: String -> Maybe ProgressInfo
102 go "none" = Just None
103 go "brief" = Just Brief
104 go "normal" = Just Normal
105 go "unicorn" = Just Unicorn
106 go _ = Nothing
107 set :: ProgressInfo -> CommandLineArgs -> CommandLineArgs
108 set flag flags = flags { progressInfo = flag }
109
110 readSplitObjects :: Either String (CommandLineArgs -> CommandLineArgs)
111 readSplitObjects = Right $ \flags -> flags { splitObjects = True }
112
113 readTestOnly :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
114 readTestOnly tests = Right $ \flags -> flags { testArgs = (testArgs flags) { testOnly = tests } }
115
116 readTestSkipPerf :: Either String (CommandLineArgs -> CommandLineArgs)
117 readTestSkipPerf = Right $ \flags -> flags { testArgs = (testArgs flags) { testSkipPerf = True } }
118
119 readTestSummary :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
120 readTestSummary filepath = Right $ \flags -> flags { testArgs = (testArgs flags) { testJUnit = filepath } }
121
122 readTestJUnit :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
123 readTestJUnit filepath = Right $ \flags -> flags { testArgs = (testArgs flags) { testJUnit = filepath } }
124
125 readTestConfig :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
126 readTestConfig config =
127 case config of
128 Nothing -> Right id
129 Just conf -> Right $ \flags ->
130 let configs = conf : testConfigs (testArgs flags)
131 in flags { testArgs = (testArgs flags) { testConfigs = configs } }
132
133 -- | Standard 'OptDescr' descriptions of Hadrian's command line arguments.
134 optDescrs :: [OptDescr (Either String (CommandLineArgs -> CommandLineArgs))]
135 optDescrs =
136 [ Option ['c'] ["configure"] (NoArg readConfigure)
137 "Run the boot and configure scripts (if you do not want to run them manually)."
138 , Option ['o'] ["build-root"] (OptArg readBuildRoot "BUILD_ROOT")
139 "Where to store build artifacts. (Default _build)."
140 , Option [] ["flavour"] (OptArg readFlavour "FLAVOUR")
141 "Build flavour (Default, Devel1, Devel2, Perf, Prof, Quick or Quickest)."
142 , Option [] ["freeze1"] (NoArg readFreeze1)
143 "Freeze Stage1 GHC."
144 , Option [] ["install-destdir"] (OptArg readInstallDestDir "DESTDIR")
145 "Installation destination directory."
146 , Option [] ["integer-simple"] (NoArg readIntegerSimple)
147 "Build GHC with integer-simple library."
148 , Option [] ["progress-colour"] (OptArg readProgressColour "MODE")
149 "Use colours in progress info (Never, Auto or Always)."
150 , Option [] ["progress-info"] (OptArg readProgressInfo "STYLE")
151 "Progress info style (None, Brief, Normal or Unicorn)."
152 , Option [] ["split-objects"] (NoArg readSplitObjects)
153 "Generate split objects (requires a full clean rebuild)."
154 , Option [] ["only"] (OptArg readTestOnly "TESTS")
155 "Test cases to run."
156 , Option [] ["skip-perf"] (NoArg readTestSkipPerf)
157 "Skip performance tests."
158 , Option [] ["summary"] (OptArg readTestSummary "TEST_SUMMARY")
159 "Where to output the test summary file."
160 , Option [] ["summary-junit"] (OptArg readTestJUnit "TEST_SUMMARY_JUNIT")
161 "Output testsuite summary in JUnit format."
162 , Option [] ["config"] (OptArg readTestConfig "EXTRA_TEST_CONFIG")
163 "Configurations to run test, in key=value format." ]
164
165 -- | A type-indexed map containing Hadrian command line arguments to be passed
166 -- to Shake via 'shakeExtra'.
167 cmdLineArgsMap :: IO (Map.HashMap TypeRep Dynamic)
168 cmdLineArgsMap = do
169 (opts, _, _) <- getOpt Permute optDescrs <$> getArgs
170 let args = foldl (flip id) defaultCommandLineArgs (rights opts)
171 return $ insertExtra (progressColour args) -- Accessed by Hadrian.Utilities
172 $ insertExtra (progressInfo args) -- Accessed by Hadrian.Utilities
173 $ insertExtra (buildRoot args) -- Accessed by Hadrian.Utilities
174 $ insertExtra (testArgs args) -- Accessed by Settings.Builders.RunTest
175 $ insertExtra args Map.empty
176
177 cmdLineArgs :: Action CommandLineArgs
178 cmdLineArgs = userSetting defaultCommandLineArgs
179
180 cmdConfigure :: Action Bool
181 cmdConfigure = configure <$> cmdLineArgs
182
183 cmdFlavour :: Action (Maybe String)
184 cmdFlavour = flavour <$> cmdLineArgs
185
186 lookupBuildRoot :: Map.HashMap TypeRep Dynamic -> BuildRoot
187 lookupBuildRoot = buildRoot . lookupExtra defaultCommandLineArgs
188
189 lookupFreeze1 :: Map.HashMap TypeRep Dynamic -> Bool
190 lookupFreeze1 = freeze1 . lookupExtra defaultCommandLineArgs
191
192 cmdInstallDestDir :: Action (Maybe String)
193 cmdInstallDestDir = installDestDir <$> cmdLineArgs
194
195 cmdIntegerSimple :: Action Bool
196 cmdIntegerSimple = integerSimple <$> cmdLineArgs
197
198 cmdProgressColour :: Action UseColour
199 cmdProgressColour = progressColour <$> cmdLineArgs
200
201 cmdProgressInfo :: Action ProgressInfo
202 cmdProgressInfo = progressInfo <$> cmdLineArgs
203
204 cmdSplitObjects :: Action Bool
205 cmdSplitObjects = splitObjects <$> cmdLineArgs