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