1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
module CommandLine (
optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, cmdIntegerSimple,
cmdProgressColour, cmdProgressInfo, cmdConfigure, cmdSplitObjects,
cmdInstallDestDir
) where
import Data.Either
import qualified Data.HashMap.Strict as Map
import Data.List.Extra
import Development.Shake hiding (Normal)
import Hadrian.Utilities
import System.Console.GetOpt
import System.Environment
-- | All arguments that can be passed to Hadrian via the command line.
data CommandLineArgs = CommandLineArgs
{ configure :: Bool
, flavour :: Maybe String
, freeze1 :: Bool
, installDestDir :: Maybe String
, integerSimple :: Bool
, progressColour :: UseColour
, progressInfo :: ProgressInfo
, splitObjects :: Bool }
deriving (Eq, Show)
-- | Default values for 'CommandLineArgs'.
defaultCommandLineArgs :: CommandLineArgs
defaultCommandLineArgs = CommandLineArgs
{ configure = False
, flavour = Nothing
, freeze1 = False
, installDestDir = Nothing
, integerSimple = False
, progressColour = Auto
, progressInfo = Brief
, splitObjects = False }
readConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
readConfigure = Right $ \flags -> flags { configure = True }
readFlavour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readFlavour ms = Right $ \flags -> flags { flavour = lower <$> ms }
readFreeze1 :: Either String (CommandLineArgs -> CommandLineArgs)
readFreeze1 = Right $ \flags -> flags { freeze1 = True }
readInstallDestDir :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readInstallDestDir ms = Right $ \flags -> flags { installDestDir = ms }
readIntegerSimple :: Either String (CommandLineArgs -> CommandLineArgs)
readIntegerSimple = Right $ \flags -> flags { integerSimple = True }
readProgressColour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readProgressColour ms =
maybe (Left "Cannot parse progress-colour") (Right . set) (go =<< lower <$> ms)
where
go :: String -> Maybe UseColour
go "never" = Just Never
go "auto" = Just Auto
go "always" = Just Always
go _ = Nothing
set :: UseColour -> CommandLineArgs -> CommandLineArgs
set flag flags = flags { progressColour = flag }
readProgressInfo :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readProgressInfo ms =
maybe (Left "Cannot parse progress-info") (Right . set) (go =<< lower <$> ms)
where
go :: String -> Maybe ProgressInfo
go "none" = Just None
go "brief" = Just Brief
go "normal" = Just Normal
go "unicorn" = Just Unicorn
go _ = Nothing
set :: ProgressInfo -> CommandLineArgs -> CommandLineArgs
set flag flags = flags { progressInfo = flag }
readSplitObjects :: Either String (CommandLineArgs -> CommandLineArgs)
readSplitObjects = Right $ \flags -> flags { splitObjects = True }
-- | Standard 'OptDescr' descriptions of Hadrian's command line arguments.
optDescrs :: [OptDescr (Either String (CommandLineArgs -> CommandLineArgs))]
optDescrs =
[ Option ['c'] ["configure"] (NoArg readConfigure)
"Run the boot and configure scripts (if you do not want to run them manually)."
, Option [] ["flavour"] (OptArg readFlavour "FLAVOUR")
"Build flavour (Default, Devel1, Devel2, Perf, Prof, Quick or Quickest)."
, Option [] ["freeze1"] (NoArg readFreeze1)
"Freeze Stage1 GHC."
, Option [] ["install-destdir"] (OptArg readInstallDestDir "DESTDIR")
"Installation destination directory."
, Option [] ["integer-simple"] (NoArg readIntegerSimple)
"Build GHC with integer-simple library."
, Option [] ["progress-colour"] (OptArg readProgressColour "MODE")
"Use colours in progress info (Never, Auto or Always)."
, Option [] ["progress-info"] (OptArg readProgressInfo "STYLE")
"Progress info style (None, Brief, Normal or Unicorn)."
, Option [] ["split-objects"] (NoArg readSplitObjects)
"Generate split objects (requires a full clean rebuild)." ]
-- | A type-indexed map containing Hadrian command line arguments to be passed
-- to Shake via 'shakeExtra'.
cmdLineArgsMap :: IO (Map.HashMap TypeRep Dynamic)
cmdLineArgsMap = do
(opts, _, _) <- getOpt Permute optDescrs <$> getArgs
let args = foldl (flip id) defaultCommandLineArgs (rights opts)
return $ insertExtra (progressColour args) -- Accessed by Hadrian.Utilities
$ insertExtra (progressInfo args) -- Accessed by Hadrian.Utilities
$ insertExtra args Map.empty
cmdLineArgs :: Action CommandLineArgs
cmdLineArgs = userSetting defaultCommandLineArgs
cmdConfigure :: Action Bool
cmdConfigure = configure <$> cmdLineArgs
cmdFlavour :: Action (Maybe String)
cmdFlavour = flavour <$> cmdLineArgs
lookupFreeze1 :: Map.HashMap TypeRep Dynamic -> Bool
lookupFreeze1 = freeze1 . lookupExtra defaultCommandLineArgs
cmdInstallDestDir :: Action (Maybe String)
cmdInstallDestDir = installDestDir <$> cmdLineArgs
cmdIntegerSimple :: Action Bool
cmdIntegerSimple = integerSimple <$> cmdLineArgs
cmdProgressColour :: Action UseColour
cmdProgressColour = progressColour <$> cmdLineArgs
cmdProgressInfo :: Action ProgressInfo
cmdProgressInfo = progressInfo <$> cmdLineArgs
cmdSplitObjects :: Action Bool
cmdSplitObjects = splitObjects <$> cmdLineArgs
|
