{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RankNTypes #-}

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

module GHC.Driver.CmdLine
    (
      processArgs, parseResponseFile, OptKind(..), GhcFlagMode(..),
      Flag(..), defFlag, defGhcFlag, defGhciFlag, defHiddenFlag, hoistFlag,
      errorsToGhcException,

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

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

import GHC.Prelude

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

import GHC.Types.Error ( DiagnosticReason(..) )

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

import GHC.ResponseFile
import Control.Exception (IOException, catch)
import Control.Monad (ap)
import Control.Monad.IO.Class

--------------------------------------------------------
--         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

hoistFlag :: forall m n. (forall a. m a -> n a) -> Flag m -> Flag n
hoistFlag :: forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> Flag m -> Flag n
hoistFlag forall a. m a -> n a
f (Flag String
a OptKind m
b GhcFlagMode
c) = forall (m :: * -> *). String -> OptKind m -> GhcFlagMode -> Flag m
Flag String
a (OptKind m -> OptKind n
go OptKind m
b) GhcFlagMode
c
  where
      go :: OptKind m -> OptKind n
go (NoArg EwM m ()
k)  = forall (m :: * -> *). EwM m () -> OptKind m
NoArg (forall a. EwM m a -> EwM n a
go2 EwM m ()
k)
      go (HasArg String -> EwM m ()
k) = forall (m :: * -> *). (String -> EwM m ()) -> OptKind m
HasArg (\String
s -> forall a. EwM m a -> EwM n a
go2 (String -> EwM m ()
k String
s))
      go (SepArg String -> EwM m ()
k) = forall (m :: * -> *). (String -> EwM m ()) -> OptKind m
SepArg (\String
s -> forall a. EwM m a -> EwM n a
go2 (String -> EwM m ()
k String
s))
      go (Prefix String -> EwM m ()
k) = forall (m :: * -> *). (String -> EwM m ()) -> OptKind m
Prefix (\String
s -> forall a. EwM m a -> EwM n a
go2 (String -> EwM m ()
k String
s))
      go (OptPrefix String -> EwM m ()
k) = forall (m :: * -> *). (String -> EwM m ()) -> OptKind m
OptPrefix (\String
s -> forall a. EwM m a -> EwM n a
go2 (String -> EwM m ()
k String
s))
      go (OptIntSuffix Maybe Int -> EwM m ()
k) = forall (m :: * -> *). (Maybe Int -> EwM m ()) -> OptKind m
OptIntSuffix (\Maybe Int
n -> forall a. EwM m a -> EwM n a
go2 (Maybe Int -> EwM m ()
k Maybe Int
n))
      go (IntSuffix Int -> EwM m ()
k) = forall (m :: * -> *). (Int -> EwM m ()) -> OptKind m
IntSuffix (\Int
n -> forall a. EwM m a -> EwM n a
go2 (Int -> EwM m ()
k Int
n))
      go (WordSuffix Word -> EwM m ()
k) = forall (m :: * -> *). (Word -> EwM m ()) -> OptKind m
WordSuffix (\Word
s -> forall a. EwM m a -> EwM n a
go2 (Word -> EwM m ()
k Word
s))
      go (FloatSuffix Float -> EwM m ()
k) = forall (m :: * -> *). (Float -> EwM m ()) -> OptKind m
FloatSuffix (\Float
s -> forall a. EwM m a -> EwM n a
go2 (Float -> EwM m ()
k Float
s))
      go (PassFlag String -> EwM m ()
k) = forall (m :: * -> *). (String -> EwM m ()) -> OptKind m
PassFlag (\String
s -> forall a. EwM m a -> EwM n a
go2 (String -> EwM m ()
k String
s))
      go (AnySuffix String -> EwM m ()
k) = forall (m :: * -> *). (String -> EwM m ()) -> OptKind m
AnySuffix (\String
s -> forall a. EwM m a -> EwM n a
go2 (String -> EwM m ()
k String
s))

      go2 :: EwM m a -> EwM n a
      go2 :: forall a. EwM m a -> EwM n a
go2 (EwM Located String -> Errs -> Warns -> m (Errs, Warns, a)
g) = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM forall a b. (a -> b) -> a -> b
$ \Located String
loc Errs
es Warns
ws -> forall a. m a -> n a
f (Located String -> Errs -> Warns -> m (Errs, Warns, a)
g Located String
loc Errs
es Warns
ws)

-- | 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 = forall doc. IsLine doc => String -> doc
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 -> DiagnosticReason
warnReason :: DiagnosticReason,
      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) }
  deriving (forall a b. a -> EwM m b -> EwM m a
forall a b. (a -> b) -> EwM m a -> EwM m b
forall (m :: * -> *) a b. Functor m => a -> EwM m b -> EwM m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> EwM m a -> EwM m 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 -> EwM m b -> EwM m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> EwM m b -> EwM m a
fmap :: forall a b. (a -> b) -> EwM m a -> EwM m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> EwM m a -> EwM m b
Functor)

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')
instance MonadIO m => MonadIO (EwM m) where
    liftIO :: forall a. IO a -> EwM m a
liftIO = forall (m :: * -> *) a. Monad m => m a -> EwM m a
liftEwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

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. HasCallStack => 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 =>
DiagnosticReason -> String -> EwM m ()
addFlagWarn DiagnosticReason
WarningWithoutFlag

addFlagWarn :: Monad m => DiagnosticReason -> String -> EwM m ()
addFlagWarn :: forall (m :: * -> *).
Monad m =>
DiagnosticReason -> String -> EwM m ()
addFlagWarn DiagnosticReason
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` DiagnosticReason -> Located String -> Warn
Warn DiagnosticReason
reason (forall l e. l -> e -> GenLocated l e
L SrcSpan
loc String
msg), ()))

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) })


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

processArgs :: Monad m
            => [Flag m]               -- ^ cmdline parser spec
            -> [Located String]       -- ^ args
            -> (FilePath -> EwM m [Located String]) -- ^ response file handler
            -> m ( [Located String],  -- spare args
                   [Err],  -- errors
                   [Warn] ) -- warnings
processArgs :: forall (m :: * -> *).
Monad m =>
[Flag m]
-> [Located String]
-> (String -> EwM m [Located String])
-> m ([Located String], [Err], [Warn])
processArgs [Flag m]
spec [Located String]
args String -> EwM m [Located String]
handleRespFile = 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 (L SrcSpan
_ (Char
'@' : String
resp_file) : [Located String]
args) [Located String]
spare = do
        [Located String]
resp_args <- String -> EwM m [Located String]
handleRespFile String
resp_file
        [Located String] -> [Located String] -> EwM m [Located String]
process ([Located String]
resp_args forall a. [a] -> [a] -> [a]
++ [Located String]
args) [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 -> forall a. HasCallStack => Bool -> a -> a
assert (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest) forall a b. b -> Either a b
Right (EwM m ()
a, [Located String]
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
--------------------------------------------------------

-- | Parse a response file into arguments.
parseResponseFile :: MonadIO m => FilePath -> EwM m [Located String]
parseResponseFile :: forall (m :: * -> *). MonadIO m => String -> EwM m [Located String]
parseResponseFile String
path = do
  Either IOException String
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right (String -> IO String
readFile String
path) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
    \(IOException
e :: IOException) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left IOException
e)
  case Either IOException String
res of
    Left IOException
_err -> forall (m :: * -> *). Monad m => String -> EwM m ()
addErr String
"Could not open response file" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return []
    Right String
resp_file -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall e. String -> e -> Located e
mkGeneralLocated String
path) (String -> [String]
unescapeArgs String
resp_file)

-- See Note [Handling errors when parsing command-line 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 command-line 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).
-}