Typos in comments
[ghc.git] / compiler / main / CmdLineParser.hs
1 {-# LANGUAGE CPP #-}
2
3 -------------------------------------------------------------------------------
4 --
5 -- | Command-line parser
6 --
7 -- This is an abstract command-line parser used by both StaticFlags and
8 -- DynFlags.
9 --
10 -- (c) The University of Glasgow 2005
11 --
12 -------------------------------------------------------------------------------
13
14 module CmdLineParser
15 (
16 processArgs, OptKind(..), GhcFlagMode(..),
17 CmdLineP(..), getCmdLineState, putCmdLineState,
18 Flag(..), defFlag, defGhcFlag, defGhciFlag, defHiddenFlag,
19 errorsToGhcException,
20
21 EwM, runEwM, addErr, addWarn, getArg, getCurLoc, liftEwM, deprecate
22 ) where
23
24 #include "HsVersions.h"
25
26 import Util
27 import Outputable
28 import Panic
29 import Bag
30 import SrcLoc
31
32 import Data.Function
33 import Data.List
34
35 import Control.Monad (liftM, ap)
36
37 --------------------------------------------------------
38 -- The Flag and OptKind types
39 --------------------------------------------------------
40
41 data Flag m = Flag
42 { flagName :: String, -- Flag, without the leading "-"
43 flagOptKind :: OptKind m, -- What to do if we see it
44 flagGhcMode :: GhcFlagMode -- Which modes this flag affects
45 }
46
47 defFlag :: String -> OptKind m -> Flag m
48 defFlag name optKind = Flag name optKind AllModes
49
50 defGhcFlag :: String -> OptKind m -> Flag m
51 defGhcFlag name optKind = Flag name optKind OnlyGhc
52
53 defGhciFlag :: String -> OptKind m -> Flag m
54 defGhciFlag name optKind = Flag name optKind OnlyGhci
55
56 defHiddenFlag :: String -> OptKind m -> Flag m
57 defHiddenFlag name optKind = Flag name optKind HiddenFlag
58
59 -- | GHC flag modes describing when a flag has an effect.
60 data GhcFlagMode
61 = OnlyGhc -- ^ The flag only affects the non-interactive GHC
62 | OnlyGhci -- ^ The flag only affects the interactive GHC
63 | AllModes -- ^ The flag affects multiple ghc modes
64 | HiddenFlag -- ^ This flag should not be seen in cli completion
65
66 data OptKind m -- Suppose the flag is -f
67 = NoArg (EwM m ()) -- -f all by itself
68 | HasArg (String -> EwM m ()) -- -farg or -f arg
69 | SepArg (String -> EwM m ()) -- -f arg
70 | Prefix (String -> EwM m ()) -- -farg
71 | OptPrefix (String -> EwM m ()) -- -f or -farg (i.e. the arg is optional)
72 | OptIntSuffix (Maybe Int -> EwM m ()) -- -f or -f=n; pass n to fn
73 | IntSuffix (Int -> EwM m ()) -- -f or -f=n; pass n to fn
74 | FloatSuffix (Float -> EwM m ()) -- -f or -f=n; pass n to fn
75 | PassFlag (String -> EwM m ()) -- -f; pass "-f" fn
76 | AnySuffix (String -> EwM m ()) -- -f or -farg; pass entire "-farg" to fn
77 | PrefixPred (String -> Bool) (String -> EwM m ())
78 | AnySuffixPred (String -> Bool) (String -> EwM m ())
79
80
81 --------------------------------------------------------
82 -- The EwM monad
83 --------------------------------------------------------
84
85 type Err = Located String
86 type Warn = Located String
87 type Errs = Bag Err
88 type Warns = Bag Warn
89
90 -- EwM ("errors and warnings monad") is a monad
91 -- transformer for m that adds an (err, warn) state
92 newtype EwM m a = EwM { unEwM :: Located String -- Current parse arg
93 -> Errs -> Warns
94 -> m (Errs, Warns, a) }
95
96 instance Monad m => Functor (EwM m) where
97 fmap = liftM
98
99 instance Monad m => Applicative (EwM m) where
100 pure v = EwM (\_ e w -> return (e, w, v))
101 (<*>) = ap
102
103 instance Monad m => Monad (EwM m) where
104 (EwM f) >>= k = EwM (\l e w -> do (e', w', r) <- f l e w
105 unEwM (k r) l e' w')
106
107 runEwM :: EwM m a -> m (Errs, Warns, a)
108 runEwM action = unEwM action (panic "processArgs: no arg yet") emptyBag emptyBag
109
110 setArg :: Located String -> EwM m () -> EwM m ()
111 setArg l (EwM f) = EwM (\_ es ws -> f l es ws)
112
113 addErr :: Monad m => String -> EwM m ()
114 addErr e = EwM (\(L loc _) es ws -> return (es `snocBag` L loc e, ws, ()))
115
116 addWarn :: Monad m => String -> EwM m ()
117 addWarn msg = EwM (\(L loc _) es ws -> return (es, ws `snocBag` L loc msg, ()))
118
119 deprecate :: Monad m => String -> EwM m ()
120 deprecate s = do
121 arg <- getArg
122 addWarn (arg ++ " is deprecated: " ++ s)
123
124 getArg :: Monad m => EwM m String
125 getArg = EwM (\(L _ arg) es ws -> return (es, ws, arg))
126
127 getCurLoc :: Monad m => EwM m SrcSpan
128 getCurLoc = EwM (\(L loc _) es ws -> return (es, ws, loc))
129
130 liftEwM :: Monad m => m a -> EwM m a
131 liftEwM action = EwM (\_ es ws -> do { r <- action; return (es, ws, r) })
132
133
134 --------------------------------------------------------
135 -- A state monad for use in the command-line parser
136 --------------------------------------------------------
137
138 -- (CmdLineP s) typically instantiates the 'm' in (EwM m) and (OptKind m)
139 newtype CmdLineP s a = CmdLineP { runCmdLine :: s -> (a, s) }
140
141 instance Functor (CmdLineP s) where
142 fmap = liftM
143
144 instance Applicative (CmdLineP s) where
145 pure a = CmdLineP $ \s -> (a, s)
146 (<*>) = ap
147
148 instance Monad (CmdLineP s) where
149 m >>= k = CmdLineP $ \s ->
150 let (a, s') = runCmdLine m s
151 in runCmdLine (k a) s'
152
153
154 getCmdLineState :: CmdLineP s s
155 getCmdLineState = CmdLineP $ \s -> (s,s)
156 putCmdLineState :: s -> CmdLineP s ()
157 putCmdLineState s = CmdLineP $ \_ -> ((),s)
158
159
160 --------------------------------------------------------
161 -- Processing arguments
162 --------------------------------------------------------
163
164 processArgs :: Monad m
165 => [Flag m] -- cmdline parser spec
166 -> [Located String] -- args
167 -> m ( [Located String], -- spare args
168 [Located String], -- errors
169 [Located String] ) -- warnings
170 processArgs spec args = do
171 (errs, warns, spare) <- runEwM action
172 return (spare, bagToList errs, bagToList warns)
173 where
174 action = process args []
175
176 -- process :: [Located String] -> [Located String] -> EwM m [Located String]
177 process [] spare = return (reverse spare)
178
179 process (locArg@(L _ ('-' : arg)) : args) spare =
180 case findArg spec arg of
181 Just (rest, opt_kind) ->
182 case processOneArg opt_kind rest arg args of
183 Left err ->
184 let b = process args spare
185 in (setArg locArg $ addErr err) >> b
186
187 Right (action,rest) ->
188 let b = process rest spare
189 in (setArg locArg $ action) >> b
190
191 Nothing -> process args (locArg : spare)
192
193 process (arg : args) spare = process args (arg : spare)
194
195
196 processOneArg :: OptKind m -> String -> String -> [Located String]
197 -> Either String (EwM m (), [Located String])
198 processOneArg opt_kind rest arg args
199 = let dash_arg = '-' : arg
200 rest_no_eq = dropEq rest
201 in case opt_kind of
202 NoArg a -> ASSERT(null rest) Right (a, args)
203
204 HasArg f | notNull rest_no_eq -> Right (f rest_no_eq, args)
205 | otherwise -> case args of
206 [] -> missingArgErr dash_arg
207 (L _ arg1:args1) -> Right (f arg1, args1)
208
209 -- See Trac #9776
210 SepArg f -> case args of
211 [] -> missingArgErr dash_arg
212 (L _ arg1:args1) -> Right (f arg1, args1)
213
214 Prefix f | notNull rest_no_eq -> Right (f rest_no_eq, args)
215 | otherwise -> unknownFlagErr dash_arg
216
217 PrefixPred _ f | notNull rest_no_eq -> Right (f rest_no_eq, args)
218 | otherwise -> unknownFlagErr dash_arg
219
220 PassFlag f | notNull rest -> unknownFlagErr dash_arg
221 | otherwise -> Right (f dash_arg, args)
222
223 OptIntSuffix f | null rest -> Right (f Nothing, args)
224 | Just n <- parseInt rest_no_eq -> Right (f (Just n), args)
225 | otherwise -> Left ("malformed integer argument in " ++ dash_arg)
226
227 IntSuffix f | Just n <- parseInt rest_no_eq -> Right (f n, args)
228 | otherwise -> Left ("malformed integer argument in " ++ dash_arg)
229
230 FloatSuffix f | Just n <- parseFloat rest_no_eq -> Right (f n, args)
231 | otherwise -> Left ("malformed float argument in " ++ dash_arg)
232
233 OptPrefix f -> Right (f rest_no_eq, args)
234 AnySuffix f -> Right (f dash_arg, args)
235 AnySuffixPred _ f -> Right (f dash_arg, args)
236
237 findArg :: [Flag m] -> String -> Maybe (String, OptKind m)
238 findArg spec arg =
239 case sortBy (compare `on` (length . fst)) -- prefer longest matching flag
240 [ (removeSpaces rest, optKind)
241 | flag <- spec,
242 let optKind = flagOptKind flag,
243 Just rest <- [stripPrefix (flagName flag) arg],
244 arg_ok optKind rest arg ]
245 of
246 [] -> Nothing
247 (one:_) -> Just one
248
249 arg_ok :: OptKind t -> [Char] -> String -> Bool
250 arg_ok (NoArg _) rest _ = null rest
251 arg_ok (HasArg _) _ _ = True
252 arg_ok (SepArg _) rest _ = null rest
253 arg_ok (Prefix _) rest _ = notNull rest
254 arg_ok (PrefixPred p _) rest _ = notNull rest && p (dropEq rest)
255 arg_ok (OptIntSuffix _) _ _ = True
256 arg_ok (IntSuffix _) _ _ = True
257 arg_ok (FloatSuffix _) _ _ = True
258 arg_ok (OptPrefix _) _ _ = True
259 arg_ok (PassFlag _) rest _ = null rest
260 arg_ok (AnySuffix _) _ _ = True
261 arg_ok (AnySuffixPred p _) _ arg = p arg
262
263 -- | Parse an Int
264 --
265 -- Looks for "433" or "=342", with no trailing gubbins
266 -- * n or =n => Just n
267 -- * gibberish => Nothing
268 parseInt :: String -> Maybe Int
269 parseInt s = case reads s of
270 ((n,""):_) -> Just n
271 _ -> Nothing
272
273 parseFloat :: String -> Maybe Float
274 parseFloat s = case reads s of
275 ((n,""):_) -> Just n
276 _ -> Nothing
277
278 -- | Discards a leading equals sign
279 dropEq :: String -> String
280 dropEq ('=' : s) = s
281 dropEq s = s
282
283 unknownFlagErr :: String -> Either String a
284 unknownFlagErr f = Left ("unrecognised flag: " ++ f)
285
286 missingArgErr :: String -> Either String a
287 missingArgErr f = Left ("missing argument for flag: " ++ f)
288
289 --------------------------------------------------------
290 -- Utils
291 --------------------------------------------------------
292
293
294 -- See Note [Handling errors when parsing flags]
295 errorsToGhcException :: [(String, -- Location
296 String)] -- Error
297 -> GhcException
298 errorsToGhcException errs =
299 UsageError $ intercalate "\n" $ [ l ++ ": " ++ e | (l, e) <- errs ]
300
301 {- Note [Handling errors when parsing commandline flags]
302
303 Parsing of static and mode flags happens before any session is started, i.e.,
304 before the first call to 'GHC.withGhc'. Therefore, to report errors for
305 invalid usage of these two types of flags, we can not call any function that
306 needs DynFlags, as there are no DynFlags available yet (unsafeGlobalDynFlags
307 is not set either). So we always print "on the commandline" as the location,
308 which is true except for Api users, which is probably ok.
309
310 When reporting errors for invalid usage of dynamic flags we /can/ make use of
311 DynFlags, and we do so explicitly in DynFlags.parseDynamicFlagsFull.
312
313 Before, we called unsafeGlobalDynFlags when an invalid (combination of)
314 flag(s) was given on the commandline, resulting in panics (#9963).
315 -}