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