    {-# 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, warnsToMessages,

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

    import GHC.Prelude

    import GHC.Utils.Misc
    import GHC.Utils.Panic
    import GHC.Data.Bag
    import GHC.Types.SrcLoc
    import GHC.Types.Error
    import GHC.Utils.Error
    import GHC.Driver.Errors.Types
    import GHC.Driver.Errors.Ppr () -- instance Diagnostic DriverMessage
    import GHC.Utils.Outputable (text)

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

    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 = String -> OptKind m -> GhcFlagMode -> Flag m
    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 = String -> OptKind m -> GhcFlagMode -> Flag m
    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 = String -> OptKind m -> GhcFlagMode -> Flag m
    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 = String -> OptKind m -> GhcFlagMode -> Flag m
    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) = String -> OptKind n -> GhcFlagMode -> Flag n
    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)  = EwM n () -> OptKind n
    forall (m :: * -> *). EwM m () -> OptKind m
    NoArg (EwM m () -> EwM n ()
    forall a. EwM m a -> EwM n a
    go2 EwM m ()
    k)
          go (HasArg String -> EwM m ()
    k) = (String -> EwM n ()) -> OptKind n
    forall (m :: * -> *). (String -> EwM m ()) -> OptKind m
    HasArg (\String
    s -> EwM m () -> EwM n ()
    forall a. EwM m a -> EwM n a
    go2 (String -> EwM m ()
    k String
    s))
          go (SepArg String -> EwM m ()
    k) = (String -> EwM n ()) -> OptKind n
    forall (m :: * -> *). (String -> EwM m ()) -> OptKind m
    SepArg (\String
    s -> EwM m () -> EwM n ()
    forall a. EwM m a -> EwM n a
    go2 (String -> EwM m ()
    k String
    s))
          go (Prefix String -> EwM m ()
    k) = (String -> EwM n ()) -> OptKind n
    forall (m :: * -> *). (String -> EwM m ()) -> OptKind m
    Prefix (\String
    s -> EwM m () -> EwM n ()
    forall a. EwM m a -> EwM n a
    go2 (String -> EwM m ()
    k String
    s))
          go (OptPrefix String -> EwM m ()
    k) = (String -> EwM n ()) -> OptKind n
    forall (m :: * -> *). (String -> EwM m ()) -> OptKind m
    OptPrefix (\String
    s -> EwM m () -> EwM n ()
    forall a. EwM m a -> EwM n a
    go2 (String -> EwM m ()
    k String
    s))
          go (OptIntSuffix Maybe Int -> EwM m ()
    k) = (Maybe Int -> EwM n ()) -> OptKind n
    forall (m :: * -> *). (Maybe Int -> EwM m ()) -> OptKind m
    OptIntSuffix (\Maybe Int
    n -> EwM m () -> EwM n ()
    forall a. EwM m a -> EwM n a
    go2 (Maybe Int -> EwM m ()
    k Maybe Int
    n))
          go (IntSuffix Int -> EwM m ()
    k) = (Int -> EwM n ()) -> OptKind n
    forall (m :: * -> *). (Int -> EwM m ()) -> OptKind m
    IntSuffix (\Int
    n -> EwM m () -> EwM n ()
    forall a. EwM m a -> EwM n a
    go2 (Int -> EwM m ()
    k Int
    n))
          go (Word64Suffix Word64 -> EwM m ()
    k) = (Word64 -> EwM n ()) -> OptKind n
    forall (m :: * -> *). (Word64 -> EwM m ()) -> OptKind m
    Word64Suffix (\Word64
    s -> EwM m () -> EwM n ()
    forall a. EwM m a -> EwM n a
    go2 (Word64 -> EwM m ()
    k Word64
    s))
          go (FloatSuffix Float -> EwM m ()
    k) = (Float -> EwM n ()) -> OptKind n
    forall (m :: * -> *). (Float -> EwM m ()) -> OptKind m
    FloatSuffix (\Float
    s -> EwM m () -> EwM n ()
    forall a. EwM m a -> EwM n a
    go2 (Float -> EwM m ()
    k Float
    s))
          go (PassFlag String -> EwM m ()
    k) = (String -> EwM n ()) -> OptKind n
    forall (m :: * -> *). (String -> EwM m ()) -> OptKind m
    PassFlag (\String
    s -> EwM m () -> EwM n ()
    forall a. EwM m a -> EwM n a
    go2 (String -> EwM m ()
    k String
    s))
          go (AnySuffix String -> EwM m ()
    k) = (String -> EwM n ()) -> OptKind n
    forall (m :: * -> *). (String -> EwM m ()) -> OptKind m
    AnySuffix (\String
    s -> EwM m () -> EwM n ()
    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) = (Located String -> Errs -> Warns -> n (Errs, Warns, a)) -> EwM n a
    forall (m :: * -> *) a.
    (Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
    EwM ((Located String -> Errs -> Warns -> n (Errs, Warns, a))
     -> EwM n a)
    -> (Located String -> Errs -> Warns -> n (Errs, Warns, a))
    -> EwM n a
    forall a b. (a -> b) -> a -> b
    $ \Located String
    loc Errs
    es Warns
    ws -> m (Errs, Warns, a) -> n (Errs, Warns, a)
    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
        | Word64Suffix (Word64 -> 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
    --------------------------------------------------------

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

    -- | A command-line warning message and the reason it arose
    --
    -- This used to be own type, but now it's just @'MsgEnvelope' 'DriverMessage'@.
    type Warn = Located DriverMessage

    type Errs  = Bag Err
    type Warns = [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 -> b) -> EwM m a -> EwM m b)
    -> (forall a b. a -> EwM m b -> EwM m a) -> Functor (EwM m)
    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
    $cfmap :: forall (m :: * -> *) a b.
    Functor m =>
    (a -> b) -> EwM m a -> EwM m b
    fmap :: forall a b. (a -> b) -> EwM m a -> EwM m b
    $c<$ :: forall (m :: * -> *) a b. Functor m => a -> EwM m b -> EwM m a
    <$ :: forall a b. a -> EwM m b -> EwM m a
    Functor)

    instance Monad m => Applicative (EwM m) where
        pure :: forall a. a -> EwM m a
    pure a
    v = (Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
    forall (m :: * -> *) a.
    (Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
    EwM (\Located String
    _ Errs
    e Warns
    w -> (Errs, Warns, a) -> m (Errs, Warns, a)
    forall a. a -> m a
    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
    (<*>) = 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 = (Located String -> Errs -> Warns -> m (Errs, Warns, b)) -> EwM m b
    forall (m :: * -> *) a.
    (Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
    EwM (\Located String
    l Errs
    e Warns
    w -> do (e', w', r) <- Located String -> Errs -> Warns -> m (Errs, Warns, a)
    f Located String
    l Errs
    e Warns
    w
                                          unEwM (k r) l e' w')
    instance MonadIO m => MonadIO (EwM m) where
        liftIO :: forall a. IO a -> EwM m a
    liftIO = m a -> EwM m a
    forall (m :: * -> *) a. Monad m => m a -> EwM m a
    liftEwM (m a -> EwM m a) -> (IO a -> m a) -> IO a -> EwM m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO a -> m a
    forall a. IO a -> m a
    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 = EwM m a -> Located String -> Errs -> Warns -> m (Errs, Warns, a)
    forall (m :: * -> *) a.
    EwM m a -> Located String -> Errs -> Warns -> m (Errs, Warns, a)
    unEwM EwM m a
    action (String -> Located String
    forall a. HasCallStack => String -> a
    panic String
    "processArgs: no arg yet") Errs
    forall a. Bag a
    emptyBag Warns
    forall a. Monoid a => a
    mempty

    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) = (Located String -> Errs -> Warns -> m (Errs, Warns, ()))
    -> EwM m ()
    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 = (Located String -> Errs -> Warns -> m (Errs, Warns, ()))
    -> EwM m ()
    forall (m :: * -> *) a.
    (Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
    EwM (\(L SrcSpan
    loc String
    _) Errs
    es Warns
    ws -> (Errs, Warns, ()) -> m (Errs, Warns, ())
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Errs
    es Errs -> Err -> Errs
    forall a. Bag a -> a -> Bag a
    `snocBag` Located String -> Err
    Err (SrcSpan -> String -> Located String
    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 String
    msg = DriverMessage -> EwM m ()
    forall (m :: * -> *). Monad m => DriverMessage -> EwM m ()
    addFlagWarn (DriverMessage -> EwM m ()) -> DriverMessage -> EwM m ()
    forall a b. (a -> b) -> a -> b
    $ UnknownDiagnosticFor DriverMessage -> DriverMessage
    DriverUnknownMessage (UnknownDiagnosticFor DriverMessage -> DriverMessage)
    -> UnknownDiagnosticFor DriverMessage -> DriverMessage
    forall a b. (a -> b) -> a -> b
    $ DiagnosticMessage
    -> UnknownDiagnostic
         (DiagnosticOpts DriverMessage) (DiagnosticHint DiagnosticMessage)
    forall a b.
    (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
    a -> UnknownDiagnostic b (DiagnosticHint a)
    mkSimpleUnknownDiagnostic (DiagnosticMessage
     -> UnknownDiagnostic
          (DiagnosticOpts DriverMessage) (DiagnosticHint DiagnosticMessage))
    -> DiagnosticMessage
    -> UnknownDiagnostic
         (DiagnosticOpts DriverMessage) (DiagnosticHint DiagnosticMessage)
    forall a b. (a -> b) -> a -> b
    $
      DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
    mkPlainDiagnostic DiagnosticReason
    WarningWithoutFlag [GhcHint]
    noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    msg

    addFlagWarn :: Monad m => DriverMessage -> EwM m ()
    addFlagWarn :: forall (m :: * -> *). Monad m => DriverMessage -> EwM m ()
    addFlagWarn DriverMessage
    msg = (Located String -> Errs -> Warns -> m (Errs, Warns, ()))
    -> EwM m ()
    forall (m :: * -> *) a.
    (Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
    EwM
      (\(L SrcSpan
    loc String
    _) Errs
    es Warns
    ws -> (Errs, Warns, ()) -> m (Errs, Warns, ())
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Errs
    es, SrcSpan -> DriverMessage -> GenLocated SrcSpan DriverMessage
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc DriverMessage
    msg GenLocated SrcSpan DriverMessage -> Warns -> Warns
    forall a. a -> [a] -> [a]
    : Warns
    ws, ()))

    getArg :: Monad m => EwM m String
    getArg :: forall (m :: * -> *). Monad m => EwM m String
    getArg = (Located String -> Errs -> Warns -> m (Errs, Warns, String))
    -> EwM m String
    forall (m :: * -> *) a.
    (Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
    EwM (\(L SrcSpan
    _ String
    arg) Errs
    es Warns
    ws -> (Errs, Warns, String) -> m (Errs, Warns, String)
    forall a. a -> m a
    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 = (Located String -> Errs -> Warns -> m (Errs, Warns, SrcSpan))
    -> EwM m SrcSpan
    forall (m :: * -> *) a.
    (Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
    EwM (\(L SrcSpan
    loc String
    _) Errs
    es Warns
    ws -> (Errs, Warns, SrcSpan) -> m (Errs, Warns, SrcSpan)
    forall a. a -> m a
    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 = (Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
    forall (m :: * -> *) a.
    (Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
    EwM (\Located String
    _ Errs
    es Warns
    ws -> do { r <- m a
    action; return (es, ws, r) })

    warnsToMessages :: DiagOpts -> [Warn] -> Messages DriverMessage
    warnsToMessages :: DiagOpts -> Warns -> Messages DriverMessage
    warnsToMessages DiagOpts
    diag_opts = (GenLocated SrcSpan DriverMessage
     -> Messages DriverMessage -> Messages DriverMessage)
    -> Messages DriverMessage -> Warns -> Messages DriverMessage
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr
      (\(L SrcSpan
    loc DriverMessage
    w) Messages DriverMessage
    ws -> MsgEnvelope DriverMessage
    -> Messages DriverMessage -> Messages DriverMessage
    forall e. MsgEnvelope e -> Messages e -> Messages e
    addMessage (DiagOpts -> SrcSpan -> DriverMessage -> MsgEnvelope DriverMessage
    forall e. Diagnostic e => DiagOpts -> SrcSpan -> e -> MsgEnvelope e
    mkPlainMsgEnvelope DiagOpts
    diag_opts SrcSpan
    loc DriverMessage
    w) Messages DriverMessage
    ws)
      Messages DriverMessage
    forall e. Messages e
    emptyMessages

    --------------------------------------------------------
    --         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
                       Warns ) -- warnings
    processArgs :: forall (m :: * -> *).
    Monad m =>
    [Flag m]
    -> [Located String]
    -> (String -> EwM m [Located String])
    -> m ([Located String], [Err], Warns)
    processArgs [Flag m]
    spec [Located String]
    args String -> EwM m [Located String]
    handleRespFile = do
        (errs, warns, spare) <- EwM m [Located String] -> m (Errs, Warns, [Located String])
    forall (m :: * -> *) a. EwM m a -> m (Errs, Warns, a)
    runEwM EwM m [Located String]
    action
        return (spare, bagToList errs, 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 = [Located String] -> EwM m [Located String]
    forall a. a -> EwM m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Located String] -> [Located String]
    forall a. [a] -> [a]
    reverse [Located String]
    spare)

        process (L SrcSpan
    _ (Char
    '@' : String
    resp_file) : [Located String]
    args) [Located String]
    spare = do
            resp_args <- String -> EwM m [Located String]
    handleRespFile String
    resp_file
            process (resp_args ++ args) spare

        process (locArg :: Located String
    locArg@(L SrcSpan
    _ (Char
    '-' : String
    arg)) : [Located String]
    args) [Located String]
    spare =
            case [Flag m] -> String -> Maybe (String, OptKind m)
    forall (m :: * -> *).
    [Flag m] -> String -> Maybe (String, OptKind m)
    findArg [Flag m]
    spec String
    arg of
                Just (String
    rest, OptKind m
    opt_kind) ->
                    case OptKind m
    -> String
    -> String
    -> [Located String]
    -> Either String (EwM m (), [Located String])
    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 (Located String -> EwM m () -> EwM m ()
    forall (m :: * -> *). Located String -> EwM m () -> EwM m ()
    setArg Located String
    locArg (EwM m () -> EwM m ()) -> EwM m () -> EwM m ()
    forall a b. (a -> b) -> a -> b
    $ String -> EwM m ()
    forall (m :: * -> *). Monad m => String -> EwM m ()
    addErr String
    err) EwM m () -> EwM m [Located String] -> EwM m [Located String]
    forall a b. EwM m a -> EwM m b -> EwM m b
    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 (Located String -> EwM m () -> EwM m ()
    forall (m :: * -> *). Located String -> EwM m () -> EwM m ()
    setArg Located String
    locArg (EwM m () -> EwM m ()) -> EwM m () -> EwM m ()
    forall a b. (a -> b) -> a -> b
    $ EwM m ()
    action) EwM m () -> EwM m [Located String] -> EwM m [Located String]
    forall a b. EwM m a -> EwM m b -> EwM m b
    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 Located String -> [Located String] -> [Located String]
    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 Located String -> [Located String] -> [Located String]
    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
    '-' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    arg
            rest_no_eq :: String
    rest_no_eq = String -> String
    dropEq String
    rest
        in case OptKind m
    opt_kind of
            NoArg  EwM m ()
    a -> Bool
    -> ((EwM m (), [Located String])
        -> Either String (EwM m (), [Located String]))
    -> (EwM m (), [Located String])
    -> Either String (EwM m (), [Located String])
    forall a. HasCallStack => Bool -> a -> a
    assert (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    rest) (EwM m (), [Located String])
    -> Either String (EwM m (), [Located String])
    forall a b. b -> Either a b
    Right (EwM m ()
    a, [Located String]
    args)

            HasArg String -> EwM m ()
    f | String -> Bool
    forall (f :: * -> *) a. Foldable f => f a -> Bool
    notNull String
    rest_no_eq -> (EwM m (), [Located String])
    -> Either String (EwM m (), [Located String])
    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
                                        []               -> String -> Either String (EwM m (), [Located String])
    forall a. String -> Either String a
    missingArgErr String
    dash_arg
                                        (L SrcSpan
    _ String
    arg1:[Located String]
    args1) -> (EwM m (), [Located String])
    -> Either String (EwM m (), [Located String])
    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
                            []               -> String -> Either String (EwM m (), [Located String])
    forall a. String -> Either String a
    missingArgErr String
    dash_arg
                            (L SrcSpan
    _ String
    arg1:[Located String]
    args1) -> (EwM m (), [Located String])
    -> Either String (EwM m (), [Located String])
    forall a b. b -> Either a b
    Right (String -> EwM m ()
    f String
    arg1, [Located String]
    args1)

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

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

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

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

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

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

            OptPrefix String -> EwM m ()
    f       -> (EwM m (), [Located String])
    -> Either String (EwM m (), [Located String])
    forall a b. b -> Either a b
    Right (String -> EwM m ()
    f String
    rest_no_eq, [Located String]
    args)
            AnySuffix String -> EwM m ()
    f       -> (EwM m (), [Located String])
    -> Either String (EwM m (), [Located String])
    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 ((String, OptKind m) -> (String, OptKind m) -> Ordering)
    -> [(String, OptKind m)] -> [(String, OptKind m)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Int -> Int -> Ordering)
    -> ((String, OptKind m) -> Int)
    -> (String, OptKind m)
    -> (String, OptKind m)
    -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int)
    -> ((String, OptKind m) -> String) -> (String, OptKind m) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, OptKind m) -> String
    forall a b. (a, b) -> a
    fst)) -- prefer longest matching flag
               [ (String -> String
    removeSpaces String
    rest, OptKind m
    optKind)
               | Flag m
    flag <- [Flag m]
    spec,
                 let optKind :: OptKind m
    optKind  = Flag m -> OptKind m
    forall (m :: * -> *). Flag m -> OptKind m
    flagOptKind Flag m
    flag,
                 Just String
    rest <- [String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix (Flag m -> String
    forall (m :: * -> *). Flag m -> String
    flagName Flag m
    flag) String
    arg],
                 OptKind m -> String -> String -> Bool
    forall (t :: * -> *). OptKind t -> String -> String -> Bool
    arg_ok OptKind m
    optKind String
    rest String
    arg ]
        of
            []      -> Maybe (String, OptKind m)
    forall a. Maybe a
    Nothing
            ((String, OptKind m)
    one:[(String, OptKind m)]
    _) -> (String, OptKind m) -> Maybe (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
    _   = String -> Bool
    forall a. [a] -> Bool
    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
    _   = String -> Bool
    forall a. [a] -> Bool
    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 (Word64Suffix    Word64 -> 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
    _   = String -> Bool
    forall a. [a] -> Bool
    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 ReadS Int
    forall a. Read a => ReadS a
    reads String
    s of
                     ((Int
    n,String
    ""):[(Int, String)]
    _) -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    n
                     [(Int, String)]
    _          -> Maybe Int
    forall a. Maybe a
    Nothing

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

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

    -- | Discards a leading equals sign
    dropEq :: String -> String
    dropEq :: String -> String
    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 = String -> Either String a
    forall a b. a -> Either a b
    Left (String
    "unrecognised flag: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    f)

    missingArgErr :: String -> Either String a
    missingArgErr :: forall a. String -> Either String a
    missingArgErr String
    f = String -> Either String a
    forall a b. a -> Either a b
    Left (String
    "missing argument for flag: " String -> String -> String
    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
      res <- IO (Either IOException String) -> EwM m (Either IOException String)
    forall a. IO a -> EwM m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either IOException String)
     -> EwM m (Either IOException String))
    -> IO (Either IOException String)
    -> EwM m (Either IOException String)
    forall a b. (a -> b) -> a -> b
    $ (String -> Either IOException String)
    -> IO String -> IO (Either IOException String)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Either IOException String
    forall a b. b -> Either a b
    Right (String -> IO String
    readFile String
    path) IO (Either IOException String)
    -> (IOException -> IO (Either IOException String))
    -> IO (Either IOException String)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch`
        \(IOException
    e :: IOException) -> Either IOException String -> IO (Either IOException String)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (IOException -> Either IOException String
    forall a b. a -> Either a b
    Left IOException
    e)
      case res of
        Left IOException
    _err -> String -> EwM m ()
    forall (m :: * -> *). Monad m => String -> EwM m ()
    addErr String
    "Could not open response file" EwM m () -> EwM m [Located String] -> EwM m [Located String]
    forall a b. EwM m a -> EwM m b -> EwM m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [Located String] -> EwM m [Located String]
    forall a. a -> EwM m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        Right String
    resp_file -> [Located String] -> EwM m [Located String]
    forall a. a -> EwM m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Located String] -> EwM m [Located String])
    -> [Located String] -> EwM m [Located String]
    forall a b. (a -> b) -> a -> b
    $ (String -> Located String) -> [String] -> [Located String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String -> Located String
    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 (String -> GhcException) -> String -> GhcException
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n" ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [ String
    l String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> String -> 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).
    -}