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