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