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