1ba38c4850e6af0a9fc8360408a6fbac82d33215
[hadrian.git] / src / CommandLine.hs
1 module CommandLine (
2 optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, cmdIntegerSimple,
3 cmdProgressColour, cmdProgressInfo, cmdSkipConfigure, 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 { flavour :: Maybe String
18 , freeze1 :: Bool
19 , installDestDir :: Maybe String
20 , integerSimple :: Bool
21 , progressColour :: UseColour
22 , progressInfo :: ProgressInfo
23 , skipConfigure :: Bool
24 , splitObjects :: Bool }
25 deriving (Eq, Show)
26
27 -- | Default values for 'CommandLineArgs'.
28 defaultCommandLineArgs :: CommandLineArgs
29 defaultCommandLineArgs = CommandLineArgs
30 { flavour = Nothing
31 , freeze1 = False
32 , installDestDir = Nothing
33 , integerSimple = False
34 , progressColour = Auto
35 , progressInfo = Brief
36 , skipConfigure = False
37 , splitObjects = False }
38
39 readFreeze1 :: Either String (CommandLineArgs -> CommandLineArgs)
40 readFreeze1 = Right $ \flags -> flags { freeze1 = True }
41
42 readFlavour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
43 readFlavour ms = Right $ \flags -> flags { flavour = lower <$> ms }
44
45 readInstallDestDir :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
46 readInstallDestDir ms = Right $ \flags -> flags { installDestDir = ms }
47
48 readIntegerSimple :: Either String (CommandLineArgs -> CommandLineArgs)
49 readIntegerSimple = Right $ \flags -> flags { integerSimple = True }
50
51 readProgressColour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
52 readProgressColour ms =
53 maybe (Left "Cannot parse progress-colour") (Right . set) (go =<< lower <$> ms)
54 where
55 go :: String -> Maybe UseColour
56 go "never" = Just Never
57 go "auto" = Just Auto
58 go "always" = Just Always
59 go _ = Nothing
60 set :: UseColour -> CommandLineArgs -> CommandLineArgs
61 set flag flags = flags { progressColour = flag }
62
63 readProgressInfo :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
64 readProgressInfo ms =
65 maybe (Left "Cannot parse progress-info") (Right . set) (go =<< lower <$> ms)
66 where
67 go :: String -> Maybe ProgressInfo
68 go "none" = Just None
69 go "brief" = Just Brief
70 go "normal" = Just Normal
71 go "unicorn" = Just Unicorn
72 go _ = Nothing
73 set :: ProgressInfo -> CommandLineArgs -> CommandLineArgs
74 set flag flags = flags { progressInfo = flag }
75
76 readSkipConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
77 readSkipConfigure = Right $ \flags -> flags { skipConfigure = True }
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 [] ["flavour"] (OptArg readFlavour "FLAVOUR")
86 "Build flavour (Default, Devel1, Devel2, Perf, Prof, Quick or Quickest)."
87 , Option [] ["freeze1"] (NoArg readFreeze1)
88 "Freeze Stage1 GHC."
89 , Option [] ["install-destdir"] (OptArg readInstallDestDir "DESTDIR")
90 "Installation destination directory."
91 , Option [] ["integer-simple"] (NoArg readIntegerSimple)
92 "Build GHC with integer-simple library."
93 , Option [] ["progress-colour"] (OptArg readProgressColour "MODE")
94 "Use colours in progress info (Never, Auto or Always)."
95 , Option [] ["progress-info"] (OptArg readProgressInfo "STYLE")
96 "Progress info style (None, Brief, Normal or Unicorn)."
97 , Option [] ["skip-configure"] (NoArg readSkipConfigure)
98 "Skip the boot and configure scripts (if you want to run them manually)."
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 cmdFlavour :: Action (Maybe String)
116 cmdFlavour = flavour <$> cmdLineArgs
117
118 lookupFreeze1 :: Map.HashMap TypeRep Dynamic -> Bool
119 lookupFreeze1 = freeze1 . lookupExtra defaultCommandLineArgs
120
121 cmdInstallDestDir :: Action (Maybe String)
122 cmdInstallDestDir = installDestDir <$> cmdLineArgs
123
124 cmdIntegerSimple :: Action Bool
125 cmdIntegerSimple = integerSimple <$> cmdLineArgs
126
127 cmdProgressColour :: Action UseColour
128 cmdProgressColour = progressColour <$> cmdLineArgs
129
130 cmdProgressInfo :: Action ProgressInfo
131 cmdProgressInfo = progressInfo <$> cmdLineArgs
132
133 cmdSkipConfigure :: Action Bool
134 cmdSkipConfigure = skipConfigure <$> cmdLineArgs
135
136 cmdSplitObjects :: Action Bool
137 cmdSplitObjects = splitObjects <$> cmdLineArgs