{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}

-------------------------------------------------------------------------------
--
-- | Command-line parser
--
-- This is an abstract command-line parser used by DynFlags.
--
-- (c) The University of Glasgow 2005
--
-------------------------------------------------------------------------------

module GHC.Driver.CmdLine
    (
      processArgs, OptKind(..), GhcFlagMode(..),
      CmdLineP(..), getCmdLineState, putCmdLineState,
      Flag(..), defFlag, defGhcFlag, defGhciFlag, defHiddenFlag,
      errorsToGhcException,

      Err(..), Warn(..), WarnReason(..),

      EwM, runEwM, addErr, addWarn, addFlagWarn, getArg, getCurLoc, liftEwM,
      deprecate
    ) where

#include "HsVersions.h"

import GHC.Prelude

import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Data.Bag
import GHC.Types.SrcLoc
import GHC.Utils.Json

import Data.Function
import Data.List (sortBy, intercalate, stripPrefix)

import Control.Monad (liftM, ap)

--------------------------------------------------------
--         The Flag and OptKind types
--------------------------------------------------------

data Flag m = Flag
    {   forall (m :: * -> *). Flag m -> String
flagName    :: String,     -- Flag, without the leading "-"
        forall (m :: * -> *). Flag m -> OptKind m
flagOptKind :: OptKind m,  -- What to do if we see it
        forall (m :: * -> *). Flag m -> GhcFlagMode
flagGhcMode :: GhcFlagMode    -- Which modes this flag affects
    }

defFlag :: String -> OptKind m -> Flag m
defFlag :: forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag String
name OptKind m
optKind = forall (m :: * -> *). String -> OptKind m -> GhcFlagMode -> Flag m
Flag String
name OptKind m
optKind GhcFlagMode
AllModes

defGhcFlag :: String -> OptKind m -> Flag m
defGhcFlag :: forall (m :: * -> *). String -> OptKind m -> Flag m
defGhcFlag String
name OptKind m
optKind = forall (m :: * -> *). String -> OptKind m -> GhcFlagMode -> Flag m
Flag String
name OptKind m
optKind GhcFlagMode
OnlyGhc

defGhciFlag :: String -> OptKind m -> Flag m
defGhciFlag :: forall (m :: * -> *). String -> OptKind m -> Flag m
defGhciFlag String
name OptKind m
optKind = forall (m :: * -> *). String -> OptKind m -> GhcFlagMode -> Flag m
Flag String
name OptKind m
optKind GhcFlagMode
OnlyGhci

defHiddenFlag :: String -> OptKind m -> Flag m
defHiddenFlag :: forall (m :: * -> *). String -> OptKind m -> Flag m
defHiddenFlag String
name OptKind m
optKind = forall (m :: * -> *). String -> OptKind m -> GhcFlagMode -> Flag m
Flag String
name OptKind m
optKind GhcFlagMode
HiddenFlag

-- | GHC flag modes describing when a flag has an effect.
data GhcFlagMode
    = OnlyGhc  -- ^ The flag only affects the non-interactive GHC
    | OnlyGhci -- ^ The flag only affects the interactive GHC
    | AllModes -- ^ The flag affects multiple ghc modes
    | HiddenFlag -- ^ This flag should not be seen in cli completion

data OptKind m                             -- Suppose the flag is -f
    = NoArg     (EwM m ())                 -- -f all by itself
    | HasArg    (String -> EwM m ())       -- -farg or -f arg
    | SepArg    (String -> EwM m ())       -- -f arg
    | Prefix    (String -> EwM m ())       -- -farg
    | OptPrefix (String -> EwM m ())       -- -f or -farg (i.e. the arg is optional)
    | OptIntSuffix (Maybe Int -> EwM m ()) -- -f or -f=n; pass n to fn
    | IntSuffix (Int -> EwM m ())          -- -f or -f=n; pass n to fn
    | WordSuffix (Word -> EwM m ())        -- -f or -f=n; pass n to fn
    | FloatSuffix (Float -> EwM m ())      -- -f or -f=n; pass n to fn
    | PassFlag  (String -> EwM m ())       -- -f; pass "-f" fn
    | AnySuffix (String -> EwM m ())       -- -f or -farg; pass entire "-farg" to fn


--------------------------------------------------------
--         The EwM monad
--------------------------------------------------------

-- | Used when filtering warnings: if a reason is given
-- it can be filtered out when displaying.
data WarnReason
  = NoReason
  | ReasonDeprecatedFlag
  | ReasonUnrecognisedFlag
  deriving (WarnReason -> WarnReason -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WarnReason -> WarnReason -> Bool
$c/= :: WarnReason -> WarnReason -> Bool
== :: WarnReason -> WarnReason -> Bool
$c== :: WarnReason -> WarnReason -> Bool
Eq, Int -> WarnReason -> ShowS
[WarnReason] -> ShowS
WarnReason -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WarnReason] -> ShowS
$cshowList :: [WarnReason] -> ShowS
show :: WarnReason -> String
$cshow :: WarnReason -> String
showsPrec :: Int -> WarnReason -> ShowS
$cshowsPrec :: Int -> WarnReason -> ShowS
Show)

instance Outputable WarnReason where
  ppr :: WarnReason -> SDoc
ppr = String -> SDoc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance ToJson WarnReason where
  json :: WarnReason -> JsonDoc
json WarnReason
NoReason = JsonDoc
JSNull
  json WarnReason
reason   = String -> JsonDoc
JSString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show WarnReason
reason

-- | A command-line error message
newtype Err  = Err { Err -> Located String
errMsg :: Located String }

-- | A command-line warning message and the reason it arose
data Warn = Warn
  {   Warn -> WarnReason
warnReason :: WarnReason,
      Warn -> Located String
warnMsg    :: Located String
  }

type Errs  = Bag Err
type Warns = Bag Warn

-- EwM ("errors and warnings monad") is a monad
-- transformer for m that adds an (err, warn) state
newtype EwM m a = EwM { forall (m :: * -> *) a.
EwM m a -> Located String -> Errs -> Warns -> m (Errs, Warns, a)
unEwM :: Located String -- Current parse arg
                              -> Errs -> Warns
                              -> m (Errs, Warns, a) }

instance Monad m => Functor (EwM m) where
    fmap :: forall a b. (a -> b) -> EwM m a -> EwM m b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Monad m => Applicative (EwM m) where
    pure :: forall a. a -> EwM m a
pure a
v = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM (\Located String
_ Errs
e Warns
w -> forall (m :: * -> *) a. Monad m => a -> m a
return (Errs
e, Warns
w, a
v))
    <*> :: forall a b. EwM m (a -> b) -> EwM m a -> EwM m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad m => Monad (EwM m) where
    (EwM Located String -> Errs -> Warns -> m (Errs, Warns, a)
f) >>= :: forall a b. EwM m a -> (a -> EwM m b) -> EwM m b
>>= a -> EwM m b
k = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM (\Located String
l Errs
e Warns
w -> do (Errs
e', Warns
w', a
r) <- Located String -> Errs -> Warns -> m (Errs, Warns, a)
f Located String
l Errs
e Warns
w
                                      forall (m :: * -> *) a.
EwM m a -> Located String -> Errs -> Warns -> m (Errs, Warns, a)
unEwM (a -> EwM m b
k a
r) Located String
l Errs
e' Warns
w')

runEwM :: EwM m a -> m (Errs, Warns, a)
runEwM :: forall (m :: * -> *) a. EwM m a -> m (Errs, Warns, a)
runEwM EwM m a
action = forall (m :: * -> *) a.
EwM m a -> Located String -> Errs -> Warns -> m (Errs, Warns, a)
unEwM EwM m a
action (forall a. String -> a
panic String
"processArgs: no arg yet") forall a. Bag a
emptyBag forall a. Bag a
emptyBag

setArg :: Located String -> EwM m () -> EwM m ()
setArg :: forall (m :: * -> *). Located String -> EwM m () -> EwM m ()
setArg Located String
l (EwM Located String -> Errs -> Warns -> m (Errs, Warns, ())
f) = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM (\Located String
_ Errs
es Warns
ws -> Located String -> Errs -> Warns -> m (Errs, Warns, ())
f Located String
l Errs
es Warns
ws)

addErr :: Monad m => String -> EwM m ()
addErr :: forall (m :: * -> *). Monad m => String -> EwM m ()
addErr String
e = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM (\(L SrcSpan
loc String
_) Errs
es Warns
ws -> forall (m :: * -> *) a. Monad m => a -> m a
return (Errs
es forall a. Bag a -> a -> Bag a
`snocBag` Located String -> Err
Err (forall l e. l -> e -> GenLocated l e
L SrcSpan
loc String
e), Warns
ws, ()))

addWarn :: Monad m => String -> EwM m ()
addWarn :: forall (m :: * -> *). Monad m => String -> EwM m ()
addWarn = forall (m :: * -> *). Monad m => WarnReason -> String -> EwM m ()
addFlagWarn WarnReason
NoReason

addFlagWarn :: Monad m => WarnReason -> String -> EwM m ()
addFlagWarn :: forall (m :: * -> *). Monad m => WarnReason -> String -> EwM m ()
addFlagWarn WarnReason
reason String
msg = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM forall a b. (a -> b) -> a -> b
$
  (\(L SrcSpan
loc String
_) Errs
es Warns
ws -> forall (m :: * -> *) a. Monad m => a -> m a
return (Errs
es, Warns
ws forall a. Bag a -> a -> Bag a
`snocBag` WarnReason -> Located String -> Warn
Warn WarnReason
reason (forall l e. l -> e -> GenLocated l e
L SrcSpan
loc String
msg), ()))

deprecate :: Monad m => String -> EwM m ()
deprecate :: forall (m :: * -> *). Monad m => String -> EwM m ()
deprecate String
s = do
    String
arg <- forall (m :: * -> *). Monad m => EwM m String
getArg
    forall (m :: * -> *). Monad m => WarnReason -> String -> EwM m ()
addFlagWarn WarnReason
ReasonDeprecatedFlag (String
arg forall a. [a] -> [a] -> [a]
++ String
" is deprecated: " forall a. [a] -> [a] -> [a]
++ String
s)

getArg :: Monad m => EwM m String
getArg :: forall (m :: * -> *). Monad m => EwM m String
getArg = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM (\(L SrcSpan
_ String
arg) Errs
es Warns
ws -> forall (m :: * -> *) a. Monad m => a -> m a
return (Errs
es, Warns
ws, String
arg))

getCurLoc :: Monad m => EwM m SrcSpan
getCurLoc :: forall (m :: * -> *). Monad m => EwM m SrcSpan
getCurLoc = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM (\(L SrcSpan
loc String
_) Errs
es Warns
ws -> forall (m :: * -> *) a. Monad m => a -> m a
return (Errs
es, Warns
ws, SrcSpan
loc))

liftEwM :: Monad m => m a -> EwM m a
liftEwM :: forall (m :: * -> *) a. Monad m => m a -> EwM m a
liftEwM m a
action = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM (\Located String
_ Errs
es Warns
ws -> do { a
r <- m a
action; forall (m :: * -> *) a. Monad m => a -> m a
return (Errs
es, Warns
ws, a
r) })


--------------------------------------------------------
-- A state monad for use in the command-line parser
--------------------------------------------------------

-- (CmdLineP s) typically instantiates the 'm' in (EwM m) and (OptKind m)
newtype CmdLineP s a = CmdLineP { forall s a. CmdLineP s a -> s -> (a, s)
runCmdLine :: s -> (a, s) }
    deriving (forall a b. a -> CmdLineP s b -> CmdLineP s a
forall a b. (a -> b) -> CmdLineP s a -> CmdLineP s b
forall s a b. a -> CmdLineP s b -> CmdLineP s a
forall s a b. (a -> b) -> CmdLineP s a -> CmdLineP s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CmdLineP s b -> CmdLineP s a
$c<$ :: forall s a b. a -> CmdLineP s b -> CmdLineP s a
fmap :: forall a b. (a -> b) -> CmdLineP s a -> CmdLineP s b
$cfmap :: forall s a b. (a -> b) -> CmdLineP s a -> CmdLineP s b
Functor)

instance Applicative (CmdLineP s) where
    pure :: forall a. a -> CmdLineP s a
pure a
a = forall s a. (s -> (a, s)) -> CmdLineP s a
CmdLineP forall a b. (a -> b) -> a -> b
$ \s
s -> (a
a, s
s)
    <*> :: forall a b. CmdLineP s (a -> b) -> CmdLineP s a -> CmdLineP s b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (CmdLineP s) where
    CmdLineP s a
m >>= :: forall a b. CmdLineP s a -> (a -> CmdLineP s b) -> CmdLineP s b
>>= a -> CmdLineP s b
k = forall s a. (s -> (a, s)) -> CmdLineP s a
CmdLineP forall a b. (a -> b) -> a -> b
$ \s
s ->
                  let (a
a, s
s') = forall s a. CmdLineP s a -> s -> (a, s)
runCmdLine CmdLineP s a
m s
s
                  in forall s a. CmdLineP s a -> s -> (a, s)
runCmdLine (a -> CmdLineP s b
k a
a) s
s'


getCmdLineState :: CmdLineP s s
getCmdLineState :: forall s. CmdLineP s s
getCmdLineState   = forall s a. (s -> (a, s)) -> CmdLineP s a
CmdLineP forall a b. (a -> b) -> a -> b
$ \s
s -> (s
s,s
s)
putCmdLineState :: s -> CmdLineP s ()
putCmdLineState :: forall s. s -> CmdLineP s ()
putCmdLineState s
s = forall s a. (s -> (a, s)) -> CmdLineP s a
CmdLineP forall a b. (a -> b) -> a -> b
$ \s
_ -> ((),s
s)


--------------------------------------------------------
--         Processing arguments
--------------------------------------------------------

processArgs :: Monad m
            => [Flag m]               -- cmdline parser spec
            -> [Located String]       -- args
            -> m ( [Located String],  -- spare args
                   [Err],  -- errors
                   [Warn] ) -- warnings
processArgs :: forall (m :: * -> *).
Monad m =>
[Flag m] -> [Located String] -> m ([Located String], [Err], [Warn])
processArgs [Flag m]
spec [Located String]
args = do
    (Errs
errs, Warns
warns, [Located String]
spare) <- forall (m :: * -> *) a. EwM m a -> m (Errs, Warns, a)
runEwM EwM m [Located String]
action
    forall (m :: * -> *) a. Monad m => a -> m a
return ([Located String]
spare, forall a. Bag a -> [a]
bagToList Errs
errs, forall a. Bag a -> [a]
bagToList Warns
warns)
  where
    action :: EwM m [Located String]
action = [Located String] -> [Located String] -> EwM m [Located String]
process [Located String]
args []

    -- process :: [Located String] -> [Located String] -> EwM m [Located String]
    process :: [Located String] -> [Located String] -> EwM m [Located String]
process [] [Located String]
spare = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> [a]
reverse [Located String]
spare)

    process (locArg :: Located String
locArg@(L SrcSpan
_ (Char
'-' : String
arg)) : [Located String]
args) [Located String]
spare =
        case forall (m :: * -> *).
[Flag m] -> String -> Maybe (String, OptKind m)
findArg [Flag m]
spec String
arg of
            Just (String
rest, OptKind m
opt_kind) ->
                case forall (m :: * -> *).
OptKind m
-> String
-> String
-> [Located String]
-> Either String (EwM m (), [Located String])
processOneArg OptKind m
opt_kind String
rest String
arg [Located String]
args of
                    Left String
err ->
                        let b :: EwM m [Located String]
b = [Located String] -> [Located String] -> EwM m [Located String]
process [Located String]
args [Located String]
spare
                        in (forall (m :: * -> *). Located String -> EwM m () -> EwM m ()
setArg Located String
locArg forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => String -> EwM m ()
addErr String
err) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EwM m [Located String]
b

                    Right (EwM m ()
action,[Located String]
rest) ->
                        let b :: EwM m [Located String]
b = [Located String] -> [Located String] -> EwM m [Located String]
process [Located String]
rest [Located String]
spare
                        in (forall (m :: * -> *). Located String -> EwM m () -> EwM m ()
setArg Located String
locArg forall a b. (a -> b) -> a -> b
$ EwM m ()
action) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EwM m [Located String]
b

            Maybe (String, OptKind m)
Nothing -> [Located String] -> [Located String] -> EwM m [Located String]
process [Located String]
args (Located String
locArg forall a. a -> [a] -> [a]
: [Located String]
spare)

    process (Located String
arg : [Located String]
args) [Located String]
spare = [Located String] -> [Located String] -> EwM m [Located String]
process [Located String]
args (Located String
arg forall a. a -> [a] -> [a]
: [Located String]
spare)


processOneArg :: OptKind m -> String -> String -> [Located String]
              -> Either String (EwM m (), [Located String])
processOneArg :: forall (m :: * -> *).
OptKind m
-> String
-> String
-> [Located String]
-> Either String (EwM m (), [Located String])
processOneArg OptKind m
opt_kind String
rest String
arg [Located String]
args
  = let dash_arg :: String
dash_arg = Char
'-' forall a. a -> [a] -> [a]
: String
arg
        rest_no_eq :: String
rest_no_eq = ShowS
dropEq String
rest
    in case OptKind m
opt_kind of
        NoArg  EwM m ()
a -> ASSERT(null rest) Right (a, args)

        HasArg String -> EwM m ()
f | forall (f :: * -> *) a. Foldable f => f a -> Bool
notNull String
rest_no_eq -> forall a b. b -> Either a b
Right (String -> EwM m ()
f String
rest_no_eq, [Located String]
args)
                 | Bool
otherwise -> case [Located String]
args of
                                    []               -> forall a. String -> Either String a
missingArgErr String
dash_arg
                                    (L SrcSpan
_ String
arg1:[Located String]
args1) -> forall a b. b -> Either a b
Right (String -> EwM m ()
f String
arg1, [Located String]
args1)

        -- See #9776
        SepArg String -> EwM m ()
f -> case [Located String]
args of
                        []               -> forall a. String -> Either String a
missingArgErr String
dash_arg
                        (L SrcSpan
_ String
arg1:[Located String]
args1) -> forall a b. b -> Either a b
Right (String -> EwM m ()
f String
arg1, [Located String]
args1)

        -- See #12625
        Prefix String -> EwM m ()
f | forall (f :: * -> *) a. Foldable f => f a -> Bool
notNull String
rest_no_eq -> forall a b. b -> Either a b
Right (String -> EwM m ()
f String
rest_no_eq, [Located String]
args)
                 | Bool
otherwise          -> forall a. String -> Either String a
missingArgErr  String
dash_arg

        PassFlag String -> EwM m ()
f  | forall (f :: * -> *) a. Foldable f => f a -> Bool
notNull String
rest -> forall a. String -> Either String a
unknownFlagErr String
dash_arg
                    | Bool
otherwise    -> forall a b. b -> Either a b
Right (String -> EwM m ()
f String
dash_arg, [Located String]
args)

        OptIntSuffix Maybe Int -> EwM m ()
f | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest                     -> forall a b. b -> Either a b
Right (Maybe Int -> EwM m ()
f forall a. Maybe a
Nothing,  [Located String]
args)
                       | Just Int
n <- String -> Maybe Int
parseInt String
rest_no_eq -> forall a b. b -> Either a b
Right (Maybe Int -> EwM m ()
f (forall a. a -> Maybe a
Just Int
n), [Located String]
args)
                       | Bool
otherwise -> forall a b. a -> Either a b
Left (String
"malformed integer argument in " forall a. [a] -> [a] -> [a]
++ String
dash_arg)

        IntSuffix Int -> EwM m ()
f | Just Int
n <- String -> Maybe Int
parseInt String
rest_no_eq -> forall a b. b -> Either a b
Right (Int -> EwM m ()
f Int
n, [Located String]
args)
                    | Bool
otherwise -> forall a b. a -> Either a b
Left (String
"malformed integer argument in " forall a. [a] -> [a] -> [a]
++ String
dash_arg)

        WordSuffix Word -> EwM m ()
f | Just Word
n <- String -> Maybe Word
parseWord String
rest_no_eq -> forall a b. b -> Either a b
Right (Word -> EwM m ()
f Word
n, [Located String]
args)
                     | Bool
otherwise -> forall a b. a -> Either a b
Left (String
"malformed natural argument in " forall a. [a] -> [a] -> [a]
++ String
dash_arg)

        FloatSuffix Float -> EwM m ()
f | Just Float
n <- String -> Maybe Float
parseFloat String
rest_no_eq -> forall a b. b -> Either a b
Right (Float -> EwM m ()
f Float
n, [Located String]
args)
                      | Bool
otherwise -> forall a b. a -> Either a b
Left (String
"malformed float argument in " forall a. [a] -> [a] -> [a]
++ String
dash_arg)

        OptPrefix String -> EwM m ()
f       -> forall a b. b -> Either a b
Right (String -> EwM m ()
f String
rest_no_eq, [Located String]
args)
        AnySuffix String -> EwM m ()
f       -> forall a b. b -> Either a b
Right (String -> EwM m ()
f String
dash_arg, [Located String]
args)

findArg :: [Flag m] -> String -> Maybe (String, OptKind m)
findArg :: forall (m :: * -> *).
[Flag m] -> String -> Maybe (String, OptKind m)
findArg [Flag m]
spec String
arg =
    case forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)) -- prefer longest matching flag
           [ (ShowS
removeSpaces String
rest, OptKind m
optKind)
           | Flag m
flag <- [Flag m]
spec,
             let optKind :: OptKind m
optKind  = forall (m :: * -> *). Flag m -> OptKind m
flagOptKind Flag m
flag,
             Just String
rest <- [forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (forall (m :: * -> *). Flag m -> String
flagName Flag m
flag) String
arg],
             forall (t :: * -> *). OptKind t -> String -> String -> Bool
arg_ok OptKind m
optKind String
rest String
arg ]
    of
        []      -> forall a. Maybe a
Nothing
        ((String, OptKind m)
one:[(String, OptKind m)]
_) -> forall a. a -> Maybe a
Just (String, OptKind m)
one

arg_ok :: OptKind t -> [Char] -> String -> Bool
arg_ok :: forall (t :: * -> *). OptKind t -> String -> String -> Bool
arg_ok (NoArg           EwM t ()
_)  String
rest String
_   = forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest
arg_ok (HasArg          String -> EwM t ()
_)  String
_    String
_   = Bool
True
arg_ok (SepArg          String -> EwM t ()
_)  String
rest String
_   = forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest
arg_ok (Prefix          String -> EwM t ()
_)  String
_    String
_   = Bool
True -- Missing argument checked for in processOneArg t
                                            -- to improve error message (#12625)
arg_ok (OptIntSuffix    Maybe Int -> EwM t ()
_)  String
_    String
_   = Bool
True
arg_ok (IntSuffix       Int -> EwM t ()
_)  String
_    String
_   = Bool
True
arg_ok (WordSuffix      Word -> EwM t ()
_)  String
_    String
_   = Bool
True
arg_ok (FloatSuffix     Float -> EwM t ()
_)  String
_    String
_   = Bool
True
arg_ok (OptPrefix       String -> EwM t ()
_)  String
_    String
_   = Bool
True
arg_ok (PassFlag        String -> EwM t ()
_)  String
rest String
_   = forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest
arg_ok (AnySuffix       String -> EwM t ()
_)  String
_    String
_   = Bool
True

-- | Parse an Int
--
-- Looks for "433" or "=342", with no trailing gubbins
--   * n or =n      => Just n
--   * gibberish    => Nothing
parseInt :: String -> Maybe Int
parseInt :: String -> Maybe Int
parseInt String
s = case forall a. Read a => ReadS a
reads String
s of
                 ((Int
n,String
""):[(Int, String)]
_) -> forall a. a -> Maybe a
Just Int
n
                 [(Int, String)]
_          -> forall a. Maybe a
Nothing

parseWord :: String -> Maybe Word
parseWord :: String -> Maybe Word
parseWord String
s = case forall a. Read a => ReadS a
reads String
s of
                 ((Word
n,String
""):[(Word, String)]
_) -> forall a. a -> Maybe a
Just Word
n
                 [(Word, String)]
_          -> forall a. Maybe a
Nothing

parseFloat :: String -> Maybe Float
parseFloat :: String -> Maybe Float
parseFloat String
s = case forall a. Read a => ReadS a
reads String
s of
                   ((Float
n,String
""):[(Float, String)]
_) -> forall a. a -> Maybe a
Just Float
n
                   [(Float, String)]
_          -> forall a. Maybe a
Nothing

-- | Discards a leading equals sign
dropEq :: String -> String
dropEq :: ShowS
dropEq (Char
'=' : String
s) = String
s
dropEq String
s         = String
s

unknownFlagErr :: String -> Either String a
unknownFlagErr :: forall a. String -> Either String a
unknownFlagErr String
f = forall a b. a -> Either a b
Left (String
"unrecognised flag: " forall a. [a] -> [a] -> [a]
++ String
f)

missingArgErr :: String -> Either String a
missingArgErr :: forall a. String -> Either String a
missingArgErr String
f = forall a b. a -> Either a b
Left (String
"missing argument for flag: " forall a. [a] -> [a] -> [a]
++ String
f)

--------------------------------------------------------
-- Utils
--------------------------------------------------------


-- See Note [Handling errors when parsing flags]
errorsToGhcException :: [(String,    -- Location
                          String)]   -- Error
                     -> GhcException
errorsToGhcException :: [(String, String)] -> GhcException
errorsToGhcException [(String, String)]
errs =
    String -> GhcException
UsageError forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$ [ String
l forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
e | (String
l, String
e) <- [(String, String)]
errs ]

{- Note [Handling errors when parsing commandline flags]

Parsing of static and mode flags happens before any session is started, i.e.,
before the first call to 'GHC.withGhc'. Therefore, to report errors for
invalid usage of these two types of flags, we can not call any function that
needs DynFlags, as there are no DynFlags available yet (unsafeGlobalDynFlags
is not set either). So we always print "on the commandline" as the location,
which is true except for Api users, which is probably ok.

When reporting errors for invalid usage of dynamic flags we /can/ make use of
DynFlags, and we do so explicitly in DynFlags.parseDynamicFlagsFull.

Before, we called unsafeGlobalDynFlags when an invalid (combination of)
flag(s) was given on the commandline, resulting in panics (#9963).
-}