    {-# LANGUAGE TypeFamilies #-}

    -----------------------------------------------------------------------------
    --
    -- | Parsing the top of a Haskell source file to get its module name,
    -- imports and options.
    --
    -- (c) Simon Marlow 2005
    -- (c) Lemmih 2006
    --
    -----------------------------------------------------------------------------

    module GHC.Parser.Header
       ( getImports
       , mkPrelImports -- used by the renamer too
       , getOptionsFromFile
       , getOptions
       , toArgs
       , checkProcessArgsResult
       )
    where

    import GHC.Prelude

    import GHC.Data.Bag

    import GHC.Driver.Errors.Types -- Unfortunate, needed due to the fact we throw exceptions!

    import GHC.Parser.Errors.Types
    import GHC.Parser           ( parseHeader )
    import GHC.Parser.Lexer

    import GHC.Hs
    import GHC.Unit.Module
    import GHC.Builtin.Names

    import GHC.Types.Error
    import GHC.Types.SrcLoc
    import GHC.Types.SourceError
    import GHC.Types.SourceText
    import GHC.Types.PkgQual

    import GHC.Utils.Misc
    import GHC.Utils.Panic
    import GHC.Utils.Monad
    import GHC.Utils.Error
    import GHC.Utils.Exception as Exception

    import GHC.Data.StringBuffer
    import GHC.Data.Maybe
    import GHC.Data.FastString
    import qualified GHC.Data.Strict as Strict

    import Control.Monad
    import System.IO
    import System.IO.Unsafe
    import Data.List (partition)
    import Data.Char (isSpace)
    import Text.ParserCombinators.ReadP (readP_to_S, gather)
    import Text.ParserCombinators.ReadPrec (readPrec_to_P)
    import Text.Read (readPrec)

    ------------------------------------------------------------------------------

    -- | Parse the imports of a source file.
    --
    -- Throws a 'SourceError' if parsing fails.
    getImports :: ParserOpts   -- ^ Parser options
               -> Bool         -- ^ Implicit Prelude?
               -> StringBuffer -- ^ Parse this.
               -> FilePath     -- ^ Filename the buffer came from.  Used for
                               --   reporting parse error locations.
               -> FilePath     -- ^ The original source filename (used for locations
                               --   in the function result)
               -> IO (Either
                   (Messages PsMessage)
                   ([(RawPkgQual, Located ModuleName)],
                    [(RawPkgQual, Located ModuleName)],
                    Bool, -- Is GHC.Prim imported or not
                    Located ModuleName))
                  -- ^ The source imports and normal imports (with optional package
                  -- names from -XPackageImports), and the module name.
    getImports :: ParserOpts
    -> Bool
    -> StringBuffer
    -> String
    -> String
    -> IO
         (Either
            (Messages PsMessage)
            ([(RawPkgQual, Located ModuleName)],
             [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName))
    getImports ParserOpts
    popts Bool
    implicit_prelude StringBuffer
    buf String
    filename String
    source_filename = do
      let loc :: RealSrcLoc
    loc  = FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc (String -> FastString
    mkFastString String
    filename) Int
    1 Int
    1
      case P (Located HsModule) -> PState -> ParseResult (Located HsModule)
    forall a. P a -> PState -> ParseResult a
    unP P (Located HsModule)
    parseHeader (ParserOpts -> StringBuffer -> RealSrcLoc -> PState
    initParserState ParserOpts
    popts StringBuffer
    buf RealSrcLoc
    loc) of
        PFailed PState
    pst ->
            -- assuming we're not logging warnings here as per below
          Either
      (Messages PsMessage)
      ([(RawPkgQual, Located ModuleName)],
       [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)
    -> IO
         (Either
            (Messages PsMessage)
            ([(RawPkgQual, Located ModuleName)],
             [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either
       (Messages PsMessage)
       ([(RawPkgQual, Located ModuleName)],
        [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)
     -> IO
          (Either
             (Messages PsMessage)
             ([(RawPkgQual, Located ModuleName)],
              [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)))
    -> Either
         (Messages PsMessage)
         ([(RawPkgQual, Located ModuleName)],
          [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)
    -> IO
         (Either
            (Messages PsMessage)
            ([(RawPkgQual, Located ModuleName)],
             [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName))
    forall a b. (a -> b) -> a -> b
    $ Messages PsMessage
    -> Either
         (Messages PsMessage)
         ([(RawPkgQual, Located ModuleName)],
          [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)
    forall a b. a -> Either a b
    Left (Messages PsMessage
     -> Either
          (Messages PsMessage)
          ([(RawPkgQual, Located ModuleName)],
           [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName))
    -> Messages PsMessage
    -> Either
         (Messages PsMessage)
         ([(RawPkgQual, Located ModuleName)],
          [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)
    forall a b. (a -> b) -> a -> b
    $ PState -> Messages PsMessage
    getPsErrorMessages PState
    pst
        POk PState
    pst Located HsModule
    rdr_module -> (([(RawPkgQual, Located ModuleName)],
      [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)
     -> Either
          (Messages PsMessage)
          ([(RawPkgQual, Located ModuleName)],
           [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName))
    -> IO
         ([(RawPkgQual, Located ModuleName)],
          [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)
    -> IO
         (Either
            (Messages PsMessage)
            ([(RawPkgQual, Located ModuleName)],
             [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName))
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([(RawPkgQual, Located ModuleName)],
     [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)
    -> Either
         (Messages PsMessage)
         ([(RawPkgQual, Located ModuleName)],
          [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)
    forall a b. b -> Either a b
    Right (IO
       ([(RawPkgQual, Located ModuleName)],
        [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)
     -> IO
          (Either
             (Messages PsMessage)
             ([(RawPkgQual, Located ModuleName)],
              [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)))
    -> IO
         ([(RawPkgQual, Located ModuleName)],
          [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)
    -> IO
         (Either
            (Messages PsMessage)
            ([(RawPkgQual, Located ModuleName)],
             [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName))
    forall a b. (a -> b) -> a -> b
    $ do
          let (Messages PsMessage
    _warns, Messages PsMessage
    errs) = PState -> (Messages PsMessage, Messages PsMessage)
    getPsMessages PState
    pst
          -- don't log warnings: they'll be reported when we parse the file
          -- for real.  See #2500.
          if Bool -> Bool
    not (Messages PsMessage -> Bool
    forall e. Messages e -> Bool
    isEmptyMessages Messages PsMessage
    errs)
            then Messages GhcMessage
    -> IO
         ([(RawPkgQual, Located ModuleName)],
          [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)
    forall (io :: * -> *) a. MonadIO io => Messages GhcMessage -> io a
    throwErrors (PsMessage -> GhcMessage
    GhcPsMessage (PsMessage -> GhcMessage)
    -> Messages PsMessage -> Messages GhcMessage
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Messages PsMessage
    errs)
            else
              let   hsmod :: HsModule
    hsmod = Located HsModule -> HsModule
    forall l e. GenLocated l e -> e
    unLoc Located HsModule
    rdr_module
                    mb_mod :: Maybe (GenLocated SrcSpanAnnA ModuleName)
    mb_mod = HsModule -> Maybe (GenLocated SrcSpanAnnA ModuleName)
    hsmodName HsModule
    hsmod
                    imps :: [LImportDecl GhcPs]
    imps = HsModule -> [LImportDecl GhcPs]
    hsmodImports HsModule
    hsmod
                    main_loc :: SrcSpan
    main_loc = SrcLoc -> SrcSpan
    srcLocSpan (FastString -> Int -> Int -> SrcLoc
    mkSrcLoc (String -> FastString
    mkFastString String
    source_filename)
                                           Int
    1 Int
    1)
                    mod :: GenLocated SrcSpanAnnA ModuleName
    mod = Maybe (GenLocated SrcSpanAnnA ModuleName)
    mb_mod Maybe (GenLocated SrcSpanAnnA ModuleName)
    -> GenLocated SrcSpanAnnA ModuleName
    -> GenLocated SrcSpanAnnA ModuleName
    forall a. Maybe a -> a -> a
    `orElse` SrcSpanAnnA -> ModuleName -> GenLocated SrcSpanAnnA ModuleName
    forall l e. l -> e -> GenLocated l e
    L (SrcSpan -> SrcSpanAnnA
    forall ann. SrcSpan -> SrcAnn ann
    noAnnSrcSpan SrcSpan
    main_loc) ModuleName
    mAIN_NAME
                    ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    src_idecls, [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    ord_idecls) = (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Bool)
    -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    -> ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)],
        [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition ((IsBootInterface -> IsBootInterface -> Bool
    forall a. Eq a => a -> a -> Bool
    == IsBootInterface
    IsBoot) (IsBootInterface -> Bool)
    -> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> IsBootInterface)
    -> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ImportDecl GhcPs -> IsBootInterface
    forall pass. ImportDecl pass -> IsBootInterface
    ideclSource (ImportDecl GhcPs -> IsBootInterface)
    -> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs)
    -> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> IsBootInterface
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
    forall l e. GenLocated l e -> e
    unLoc) [LImportDecl GhcPs]
    [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    imps

                   -- GHC.Prim doesn't exist physically, so don't go looking for it.
                    ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    ordinary_imps, [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    ghc_prim_import)
                      = (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Bool)
    -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    -> ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)],
        [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition ((ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    /= GenModule Unit -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName GenModule Unit
    gHC_PRIM) (ModuleName -> Bool)
    -> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ModuleName)
    -> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA ModuleName -> ModuleName
    forall l e. GenLocated l e -> e
    unLoc
                                      (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
    -> (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
        -> GenLocated SrcSpanAnnA ModuleName)
    -> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> ModuleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ImportDecl GhcPs -> XRec GhcPs ModuleName
    ImportDecl GhcPs -> GenLocated SrcSpanAnnA ModuleName
    forall pass. ImportDecl pass -> XRec pass ModuleName
    ideclName (ImportDecl GhcPs -> GenLocated SrcSpanAnnA ModuleName)
    -> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs)
    -> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> GenLocated SrcSpanAnnA ModuleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
    forall l e. GenLocated l e -> e
    unLoc)
                                     [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    ord_idecls

                    implicit_imports :: [LImportDecl GhcPs]
    implicit_imports = ModuleName
    -> SrcSpan -> Bool -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
    mkPrelImports (GenLocated SrcSpanAnnA ModuleName -> ModuleName
    forall l e. GenLocated l e -> e
    unLoc GenLocated SrcSpanAnnA ModuleName
    mod) SrcSpan
    main_loc
                                                     Bool
    implicit_prelude [LImportDecl GhcPs]
    imps
                    convImport :: GenLocated l (ImportDecl pass)
    -> (ImportDeclPkgQual pass, Located ModuleName)
    convImport (L l
    _ ImportDecl pass
    i) = (ImportDecl pass -> ImportDeclPkgQual pass
    forall pass. ImportDecl pass -> ImportDeclPkgQual pass
    ideclPkgQual ImportDecl pass
    i, GenLocated (SrcAnn a) ModuleName -> Located ModuleName
    forall a e. LocatedAn a e -> Located e
    reLoc (GenLocated (SrcAnn a) ModuleName -> Located ModuleName)
    -> GenLocated (SrcAnn a) ModuleName -> Located ModuleName
    forall a b. (a -> b) -> a -> b
    $ ImportDecl pass -> XRec pass ModuleName
    forall pass. ImportDecl pass -> XRec pass ModuleName
    ideclName ImportDecl pass
    i)
                  in
                  ([(RawPkgQual, Located ModuleName)],
     [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)
    -> IO
         ([(RawPkgQual, Located ModuleName)],
          [(RawPkgQual, Located ModuleName)], Bool, Located ModuleName)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((GenLocated SrcSpanAnnA (ImportDecl GhcPs)
     -> (RawPkgQual, Located ModuleName))
    -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    -> [(RawPkgQual, Located ModuleName)]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> (RawPkgQual, Located ModuleName)
    GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> (ImportDeclPkgQual GhcPs, Located ModuleName)
    forall {pass} {a} {l}.
    (XRec pass ModuleName ~ GenLocated (SrcAnn a) ModuleName) =>
    GenLocated l (ImportDecl pass)
    -> (ImportDeclPkgQual pass, Located ModuleName)
    convImport [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    src_idecls
                         , (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
     -> (RawPkgQual, Located ModuleName))
    -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    -> [(RawPkgQual, Located ModuleName)]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> (RawPkgQual, Located ModuleName)
    GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> (ImportDeclPkgQual GhcPs, Located ModuleName)
    forall {pass} {a} {l}.
    (XRec pass ModuleName ~ GenLocated (SrcAnn a) ModuleName) =>
    GenLocated l (ImportDecl pass)
    -> (ImportDeclPkgQual pass, Located ModuleName)
    convImport ([LImportDecl GhcPs]
    [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    implicit_imports [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    forall a. [a] -> [a] -> [a]
    ++ [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    ordinary_imps)
                         , Bool -> Bool
    not ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    ghc_prim_import)
                         , GenLocated SrcSpanAnnA ModuleName -> Located ModuleName
    forall a e. LocatedAn a e -> Located e
    reLoc GenLocated SrcSpanAnnA ModuleName
    mod)

    mkPrelImports :: ModuleName
                  -> SrcSpan    -- Attribute the "import Prelude" to this location
                  -> Bool -> [LImportDecl GhcPs]
                  -> [LImportDecl GhcPs]
    -- Construct the implicit declaration "import Prelude" (or not)
    --
    -- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
    -- because the former doesn't even look at Prelude.hi for instance
    -- declarations, whereas the latter does.
    mkPrelImports :: ModuleName
    -> SrcSpan -> Bool -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
    mkPrelImports ModuleName
    this_mod SrcSpan
    loc Bool
    implicit_prelude [LImportDecl GhcPs]
    import_decls
      | ModuleName
    this_mod ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModuleName
    pRELUDE_NAME
       Bool -> Bool -> Bool
    || Bool
    explicit_prelude_import
       Bool -> Bool -> Bool
    || Bool -> Bool
    not Bool
    implicit_prelude
      = []
      | Bool
    otherwise = [LImportDecl GhcPs
    preludeImportDecl]
      where
          explicit_prelude_import :: Bool
    explicit_prelude_import = (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Bool)
    -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Bool
    forall {pass} {l} {l}.
    (XRec pass ModuleName ~ GenLocated l ModuleName,
     ImportDeclPkgQual pass ~ RawPkgQual) =>
    GenLocated l (ImportDecl pass) -> Bool
    is_prelude_import [LImportDecl GhcPs]
    [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    import_decls

          is_prelude_import :: GenLocated l (ImportDecl pass) -> Bool
    is_prelude_import (L l
    _ ImportDecl pass
    decl) =
            GenLocated l ModuleName -> ModuleName
    forall l e. GenLocated l e -> e
    unLoc (ImportDecl pass -> XRec pass ModuleName
    forall pass. ImportDecl pass -> XRec pass ModuleName
    ideclName ImportDecl pass
    decl) ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModuleName
    pRELUDE_NAME
            -- allow explicit "base" package qualifier (#19082, #17045)
            Bool -> Bool -> Bool
    && case ImportDecl pass -> ImportDeclPkgQual pass
    forall pass. ImportDecl pass -> ImportDeclPkgQual pass
    ideclPkgQual ImportDecl pass
    decl of
                RawPkgQual
    ImportDeclPkgQual pass
    NoRawPkgQual -> Bool
    True
                RawPkgQual StringLiteral
    b -> StringLiteral -> FastString
    sl_fs StringLiteral
    b FastString -> FastString -> Bool
    forall a. Eq a => a -> a -> Bool
    == UnitId -> FastString
    unitIdFS UnitId
    baseUnitId

          loc' :: SrcSpanAnnA
    loc' = SrcSpan -> SrcSpanAnnA
    forall ann. SrcSpan -> SrcAnn ann
    noAnnSrcSpan SrcSpan
    loc
          preludeImportDecl :: LImportDecl GhcPs
          preludeImportDecl :: LImportDecl GhcPs
    preludeImportDecl
            = SrcSpanAnnA
    -> ImportDecl GhcPs -> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    loc' (ImportDecl GhcPs -> GenLocated SrcSpanAnnA (ImportDecl GhcPs))
    -> ImportDecl GhcPs -> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    forall a b. (a -> b) -> a -> b
    $ ImportDecl { ideclExt :: XCImportDecl GhcPs
    ideclExt       = XCImportDecl GhcPs
    EpAnn EpAnnImportDecl
    forall a. EpAnn a
    noAnn,
                                    ideclSourceSrc :: SourceText
    ideclSourceSrc = SourceText
    NoSourceText,
                                    ideclName :: XRec GhcPs ModuleName
    ideclName      = SrcSpanAnnA -> ModuleName -> GenLocated SrcSpanAnnA ModuleName
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    loc' ModuleName
    pRELUDE_NAME,
                                    ideclPkgQual :: ImportDeclPkgQual GhcPs
    ideclPkgQual   = RawPkgQual
    ImportDeclPkgQual GhcPs
    NoRawPkgQual,
                                    ideclSource :: IsBootInterface
    ideclSource    = IsBootInterface
    NotBoot,
                                    ideclSafe :: Bool
    ideclSafe      = Bool
    False,  -- Not a safe import
                                    ideclQualified :: ImportDeclQualifiedStyle
    ideclQualified = ImportDeclQualifiedStyle
    NotQualified,
                                    ideclImplicit :: Bool
    ideclImplicit  = Bool
    True,   -- Implicit!
                                    ideclAs :: Maybe (XRec GhcPs ModuleName)
    ideclAs        = Maybe (XRec GhcPs ModuleName)
    Maybe (GenLocated SrcSpanAnnA ModuleName)
    forall a. Maybe a
    Nothing,
                                    ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
    ideclHiding    = Maybe (Bool, XRec GhcPs [LIE GhcPs])
    Maybe
      (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
    forall a. Maybe a
    Nothing  }

    --------------------------------------------------------------
    -- Get options
    --------------------------------------------------------------

    -- | Parse OPTIONS and LANGUAGE pragmas of the source file.
    --
    -- Throws a 'SourceError' if flag parsing fails (including unsupported flags.)
    getOptionsFromFile :: ParserOpts
                       -> FilePath            -- ^ Input file
                       -> IO (Messages PsMessage, [Located String]) -- ^ Parsed options, if any.
    getOptionsFromFile :: ParserOpts -> String -> IO (Messages PsMessage, [Located String])
    getOptionsFromFile ParserOpts
    opts String
    filename
        = IO Handle
    -> (Handle -> IO ())
    -> (Handle -> IO (Messages PsMessage, [Located String]))
    -> IO (Messages PsMessage, [Located String])
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    Exception.bracket
                  (String -> IOMode -> IO Handle
    openBinaryFile String
    filename IOMode
    ReadMode)
                  (Handle -> IO ()
    hClose)
                  (\Handle
    handle -> do
                      (Messages PsMessage
    warns, [Located String]
    opts) <- ([Located Token] -> (Messages PsMessage, [Located String]))
    -> IO [Located Token] -> IO (Messages PsMessage, [Located String])
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ParserOpts
    -> [Located Token] -> (Messages PsMessage, [Located String])
    getOptions' ParserOpts
    opts)
                                   (ParserOpts -> String -> Handle -> IO [Located Token]
    lazyGetToks ParserOpts
    opts' String
    filename Handle
    handle)
                      [Located String]
    -> IO (Messages PsMessage, [Located String])
    -> IO (Messages PsMessage, [Located String])
    forall a b. [a] -> b -> b
    seqList [Located String]
    opts
                        (IO (Messages PsMessage, [Located String])
     -> IO (Messages PsMessage, [Located String]))
    -> IO (Messages PsMessage, [Located String])
    -> IO (Messages PsMessage, [Located String])
    forall a b. (a -> b) -> a -> b
    $ [MsgEnvelope PsMessage]
    -> IO (Messages PsMessage, [Located String])
    -> IO (Messages PsMessage, [Located String])
    forall a b. [a] -> b -> b
    seqList (Bag (MsgEnvelope PsMessage) -> [MsgEnvelope PsMessage]
    forall a. Bag a -> [a]
    bagToList (Bag (MsgEnvelope PsMessage) -> [MsgEnvelope PsMessage])
    -> Bag (MsgEnvelope PsMessage) -> [MsgEnvelope PsMessage]
    forall a b. (a -> b) -> a -> b
    $ Messages PsMessage -> Bag (MsgEnvelope PsMessage)
    forall e. Messages e -> Bag (MsgEnvelope e)
    getMessages Messages PsMessage
    warns)
                        (IO (Messages PsMessage, [Located String])
     -> IO (Messages PsMessage, [Located String]))
    -> IO (Messages PsMessage, [Located String])
    -> IO (Messages PsMessage, [Located String])
    forall a b. (a -> b) -> a -> b
    $ (Messages PsMessage, [Located String])
    -> IO (Messages PsMessage, [Located String])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Messages PsMessage
    warns, [Located String]
    opts))
        where -- We don't need to get haddock doc tokens when we're just
              -- getting the options from pragmas, and lazily lexing them
              -- correctly is a little tricky: If there is "\n" or "\n-"
              -- left at the end of a buffer then the haddock doc may
              -- continue past the end of the buffer, despite the fact that
              -- we already have an apparently-complete token.
              -- We therefore just turn Opt_Haddock off when doing the lazy
              -- lex.
              opts' :: ParserOpts
    opts' = ParserOpts -> ParserOpts
    disableHaddock ParserOpts
    opts

    blockSize :: Int
    -- blockSize = 17 -- for testing :-)
    blockSize :: Int
    blockSize = Int
    1024

    lazyGetToks :: ParserOpts -> FilePath -> Handle -> IO [Located Token]
    lazyGetToks :: ParserOpts -> String -> Handle -> IO [Located Token]
    lazyGetToks ParserOpts
    popts String
    filename Handle
    handle = do
      StringBuffer
    buf <- Handle -> Int -> IO StringBuffer
    hGetStringBufferBlock Handle
    handle Int
    blockSize
      let prag_state :: PState
    prag_state = ParserOpts -> StringBuffer -> RealSrcLoc -> PState
    initPragState ParserOpts
    popts StringBuffer
    buf RealSrcLoc
    loc
      IO [Located Token] -> IO [Located Token]
    forall a. IO a -> IO a
    unsafeInterleaveIO (IO [Located Token] -> IO [Located Token])
    -> IO [Located Token] -> IO [Located Token]
    forall a b. (a -> b) -> a -> b
    $ Handle -> PState -> Bool -> Int -> IO [Located Token]
    lazyLexBuf Handle
    handle PState
    prag_state Bool
    False Int
    blockSize
     where
      loc :: RealSrcLoc
    loc  = FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc (String -> FastString
    mkFastString String
    filename) Int
    1 Int
    1

      lazyLexBuf :: Handle -> PState -> Bool -> Int -> IO [Located Token]
      lazyLexBuf :: Handle -> PState -> Bool -> Int -> IO [Located Token]
    lazyLexBuf Handle
    handle PState
    state Bool
    eof Int
    size =
        case P (Located Token) -> PState -> ParseResult (Located Token)
    forall a. P a -> PState -> ParseResult a
    unP (Bool -> (Located Token -> P (Located Token)) -> P (Located Token)
    forall a. Bool -> (Located Token -> P a) -> P a
    lexer Bool
    False Located Token -> P (Located Token)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return) PState
    state of
          POk PState
    state' Located Token
    t -> do
            -- pprTrace "lazyLexBuf" (text (show (buffer state'))) (return ())
            if StringBuffer -> Bool
    atEnd (PState -> StringBuffer
    buffer PState
    state') Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    eof
               -- if this token reached the end of the buffer, and we haven't
               -- necessarily read up to the end of the file, then the token might
               -- be truncated, so read some more of the file and lex it again.
               then Handle -> PState -> Int -> IO [Located Token]
    getMore Handle
    handle PState
    state Int
    size
               else case Located Token -> Token
    forall l e. GenLocated l e -> e
    unLoc Located Token
    t of
                      Token
    ITeof  -> [Located Token] -> IO [Located Token]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Located Token
    t]
                      Token
    _other -> do [Located Token]
    rest <- Handle -> PState -> Bool -> Int -> IO [Located Token]
    lazyLexBuf Handle
    handle PState
    state' Bool
    eof Int
    size
                                   [Located Token] -> IO [Located Token]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Located Token
    t Located Token -> [Located Token] -> [Located Token]
    forall a. a -> [a] -> [a]
    : [Located Token]
    rest)
          ParseResult (Located Token)
    _ | Bool -> Bool
    not Bool
    eof   -> Handle -> PState -> Int -> IO [Located Token]
    getMore Handle
    handle PState
    state Int
    size
            | Bool
    otherwise -> [Located Token] -> IO [Located Token]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [SrcSpan -> Token -> Located Token
    forall l e. l -> e -> GenLocated l e
    L (PsSpan -> SrcSpan
    mkSrcSpanPs (PState -> PsSpan
    last_loc PState
    state)) Token
    ITeof]
                             -- parser assumes an ITeof sentinel at the end

      getMore :: Handle -> PState -> Int -> IO [Located Token]
      getMore :: Handle -> PState -> Int -> IO [Located Token]
    getMore Handle
    handle PState
    state Int
    size = do
         -- pprTrace "getMore" (text (show (buffer state))) (return ())
         let new_size :: Int
    new_size = Int
    size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2
           -- double the buffer size each time we read a new block.  This
           -- counteracts the quadratic slowdown we otherwise get for very
           -- large module names (#5981)
         StringBuffer
    nextbuf <- Handle -> Int -> IO StringBuffer
    hGetStringBufferBlock Handle
    handle Int
    new_size
         if (StringBuffer -> Int
    len StringBuffer
    nextbuf Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0) then Handle -> PState -> Bool -> Int -> IO [Located Token]
    lazyLexBuf Handle
    handle PState
    state Bool
    True Int
    new_size else do
           StringBuffer
    newbuf <- StringBuffer -> StringBuffer -> IO StringBuffer
    appendStringBuffers (PState -> StringBuffer
    buffer PState
    state) StringBuffer
    nextbuf
           IO [Located Token] -> IO [Located Token]
    forall a. IO a -> IO a
    unsafeInterleaveIO (IO [Located Token] -> IO [Located Token])
    -> IO [Located Token] -> IO [Located Token]
    forall a b. (a -> b) -> a -> b
    $ Handle -> PState -> Bool -> Int -> IO [Located Token]
    lazyLexBuf Handle
    handle PState
    state{buffer :: StringBuffer
    buffer=StringBuffer
    newbuf} Bool
    False Int
    new_size

    getToks :: ParserOpts -> FilePath -> StringBuffer -> [Located Token]
    getToks :: ParserOpts -> String -> StringBuffer -> [Located Token]
    getToks ParserOpts
    popts String
    filename StringBuffer
    buf = PState -> [Located Token]
    lexAll PState
    pstate
     where
      pstate :: PState
    pstate = ParserOpts -> StringBuffer -> RealSrcLoc -> PState
    initPragState ParserOpts
    popts StringBuffer
    buf RealSrcLoc
    loc
      loc :: RealSrcLoc
    loc  = FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc (String -> FastString
    mkFastString String
    filename) Int
    1 Int
    1

      lexAll :: PState -> [Located Token]
    lexAll PState
    state = case P (Located Token) -> PState -> ParseResult (Located Token)
    forall a. P a -> PState -> ParseResult a
    unP (Bool -> (Located Token -> P (Located Token)) -> P (Located Token)
    forall a. Bool -> (Located Token -> P a) -> P a
    lexer Bool
    False Located Token -> P (Located Token)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return) PState
    state of
                       POk PState
    _      t :: Located Token
    t@(L SrcSpan
    _ Token
    ITeof) -> [Located Token
    t]
                       POk PState
    state' Located Token
    t -> Located Token
    t Located Token -> [Located Token] -> [Located Token]
    forall a. a -> [a] -> [a]
    : PState -> [Located Token]
    lexAll PState
    state'
                       ParseResult (Located Token)
    _ -> [SrcSpan -> Token -> Located Token
    forall l e. l -> e -> GenLocated l e
    L (PsSpan -> SrcSpan
    mkSrcSpanPs (PState -> PsSpan
    last_loc PState
    state)) Token
    ITeof]

    -- | Parse OPTIONS and LANGUAGE pragmas of the source file.
    --
    -- Throws a 'SourceError' if flag parsing fails (including unsupported flags.)
    getOptions :: ParserOpts
               -> StringBuffer -- ^ Input Buffer
               -> FilePath     -- ^ Source filename.  Used for location info.
               -> (Messages PsMessage,[Located String]) -- ^ warnings and parsed options.
    getOptions :: ParserOpts
    -> StringBuffer -> String -> (Messages PsMessage, [Located String])
    getOptions ParserOpts
    opts StringBuffer
    buf String
    filename
        = ParserOpts
    -> [Located Token] -> (Messages PsMessage, [Located String])
    getOptions' ParserOpts
    opts (ParserOpts -> String -> StringBuffer -> [Located Token]
    getToks ParserOpts
    opts String
    filename StringBuffer
    buf)

    -- The token parser is written manually because Happy can't
    -- return a partial result when it encounters a lexer error.
    -- We want to extract options before the buffer is passed through
    -- CPP, so we can't use the same trick as 'getImports'.
    getOptions' :: ParserOpts
                -> [Located Token]      -- Input buffer
                -> (Messages PsMessage,[Located String])     -- Options.
    getOptions' :: ParserOpts
    -> [Located Token] -> (Messages PsMessage, [Located String])
    getOptions' ParserOpts
    opts [Located Token]
    toks
        = [Located Token] -> (Messages PsMessage, [Located String])
    parseToks [Located Token]
    toks
        where
              parseToks :: [Located Token] -> (Messages PsMessage, [Located String])
    parseToks (Located Token
    open:Located Token
    close:[Located Token]
    xs)
                  | IToptions_prag String
    str <- Located Token -> Token
    forall l e. GenLocated l e -> e
    unLoc Located Token
    open
                  , Token
    ITclose_prag       <- Located Token -> Token
    forall l e. GenLocated l e -> e
    unLoc Located Token
    close
                  = case RealSrcLoc -> String -> Either String [Located String]
    toArgs RealSrcLoc
    starting_loc String
    str of
                      Left String
    _err -> String -> SrcSpan -> (Messages PsMessage, [Located String])
    forall a. String -> SrcSpan -> a
    optionsParseError String
    str (SrcSpan -> (Messages PsMessage, [Located String]))
    -> SrcSpan -> (Messages PsMessage, [Located String])
    forall a b. (a -> b) -> a -> b
    $   -- #15053
                                     SrcSpan -> SrcSpan -> SrcSpan
    combineSrcSpans (Located Token -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc Located Token
    open) (Located Token -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc Located Token
    close)
                      Right [Located String]
    args -> ([Located String] -> [Located String])
    -> (Messages PsMessage, [Located String])
    -> (Messages PsMessage, [Located String])
    forall a b.
    (a -> b) -> (Messages PsMessage, a) -> (Messages PsMessage, b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([Located String]
    args [Located String] -> [Located String] -> [Located String]
    forall a. [a] -> [a] -> [a]
    ++) ([Located Token] -> (Messages PsMessage, [Located String])
    parseToks [Located Token]
    xs)
                where
                  src_span :: SrcSpan
    src_span      = Located Token -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc Located Token
    open
                  real_src_span :: RealSrcSpan
    real_src_span = String -> Maybe RealSrcSpan -> RealSrcSpan
    forall a. HasCallStack => String -> Maybe a -> a
    expectJust String
    "getOptions'" (SrcSpan -> Maybe RealSrcSpan
    srcSpanToRealSrcSpan SrcSpan
    src_span)
                  starting_loc :: RealSrcLoc
    starting_loc  = RealSrcSpan -> RealSrcLoc
    realSrcSpanStart RealSrcSpan
    real_src_span
              parseToks (Located Token
    open:Located Token
    close:[Located Token]
    xs)
                  | ITinclude_prag String
    str <- Located Token -> Token
    forall l e. GenLocated l e -> e
    unLoc Located Token
    open
                  , Token
    ITclose_prag       <- Located Token -> Token
    forall l e. GenLocated l e -> e
    unLoc Located Token
    close
                  = ([Located String] -> [Located String])
    -> (Messages PsMessage, [Located String])
    -> (Messages PsMessage, [Located String])
    forall a b.
    (a -> b) -> (Messages PsMessage, a) -> (Messages PsMessage, b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((String -> Located String) -> [String] -> [Located String]
    forall a b. (a -> b) -> [a] -> [b]
    map (SrcSpan -> String -> Located String
    forall l e. l -> e -> GenLocated l e
    L (Located Token -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc Located Token
    open)) [String
    "-#include",String -> String
    removeSpaces String
    str] [Located String] -> [Located String] -> [Located String]
    forall a. [a] -> [a] -> [a]
    ++)
                         ([Located Token] -> (Messages PsMessage, [Located String])
    parseToks [Located Token]
    xs)
              parseToks (Located Token
    open:Located Token
    close:[Located Token]
    xs)
                  | ITdocOptions String
    str PsSpan
    _ <- Located Token -> Token
    forall l e. GenLocated l e -> e
    unLoc Located Token
    open
                  , Token
    ITclose_prag       <- Located Token -> Token
    forall l e. GenLocated l e -> e
    unLoc Located Token
    close
                  = ([Located String] -> [Located String])
    -> (Messages PsMessage, [Located String])
    -> (Messages PsMessage, [Located String])
    forall a b.
    (a -> b) -> (Messages PsMessage, a) -> (Messages PsMessage, b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((String -> Located String) -> [String] -> [Located String]
    forall a b. (a -> b) -> [a] -> [b]
    map (SrcSpan -> String -> Located String
    forall l e. l -> e -> GenLocated l e
    L (Located Token -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc Located Token
    open)) [String
    "-haddock-opts", String -> String
    removeSpaces String
    str] [Located String] -> [Located String] -> [Located String]
    forall a. [a] -> [a] -> [a]
    ++)
                         ([Located Token] -> (Messages PsMessage, [Located String])
    parseToks [Located Token]
    xs)
              parseToks (Located Token
    open:[Located Token]
    xs)
                  | Token
    ITlanguage_prag <- Located Token -> Token
    forall l e. GenLocated l e -> e
    unLoc Located Token
    open
                  = [Located Token] -> (Messages PsMessage, [Located String])
    parseLanguage [Located Token]
    xs
              parseToks (Located Token
    comment:[Located Token]
    xs) -- Skip over comments
                  | Token -> Bool
    isComment (Located Token -> Token
    forall l e. GenLocated l e -> e
    unLoc Located Token
    comment)
                  = [Located Token] -> (Messages PsMessage, [Located String])
    parseToks [Located Token]
    xs
              -- At the end of the header, warn about all the misplaced pragmas
              parseToks [Located Token]
    xs = ([Messages PsMessage] -> Messages PsMessage
    forall (f :: * -> *) e. Foldable f => f (Messages e) -> Messages e
    unionManyMessages ([Messages PsMessage] -> Messages PsMessage)
    -> [Messages PsMessage] -> Messages PsMessage
    forall a b. (a -> b) -> a -> b
    $ (Located Token -> Maybe (Messages PsMessage))
    -> [Located Token] -> [Messages PsMessage]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Located Token -> Maybe (Messages PsMessage)
    mkMessage [Located Token]
    xs ,[])

              parseLanguage :: [Located Token] -> (Messages PsMessage, [Located String])
    parseLanguage ((L SrcSpan
    loc (ITconid FastString
    fs)):[Located Token]
    rest)
                  = ([Located String] -> [Located String])
    -> (Messages PsMessage, [Located String])
    -> (Messages PsMessage, [Located String])
    forall a b.
    (a -> b) -> (Messages PsMessage, a) -> (Messages PsMessage, b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ParserOpts -> Located FastString -> Located String
    checkExtension ParserOpts
    opts (SrcSpan -> FastString -> Located FastString
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc FastString
    fs) Located String -> [Located String] -> [Located String]
    forall a. a -> [a] -> [a]
    :) ((Messages PsMessage, [Located String])
     -> (Messages PsMessage, [Located String]))
    -> (Messages PsMessage, [Located String])
    -> (Messages PsMessage, [Located String])
    forall a b. (a -> b) -> a -> b
    $
                    case [Located Token]
    rest of
                      (L SrcSpan
    _loc Token
    ITcomma):[Located Token]
    more -> [Located Token] -> (Messages PsMessage, [Located String])
    parseLanguage [Located Token]
    more
                      (L SrcSpan
    _loc Token
    ITclose_prag):[Located Token]
    more -> [Located Token] -> (Messages PsMessage, [Located String])
    parseToks [Located Token]
    more
                      (L SrcSpan
    loc Token
    _):[Located Token]
    _ -> SrcSpan -> (Messages PsMessage, [Located String])
    forall a. SrcSpan -> a
    languagePragParseError SrcSpan
    loc
                      [] -> String -> (Messages PsMessage, [Located String])
    forall a. String -> a
    panic String
    "getOptions'.parseLanguage(1) went past eof token"
              parseLanguage (Located Token
    tok:[Located Token]
    _)
                  = SrcSpan -> (Messages PsMessage, [Located String])
    forall a. SrcSpan -> a
    languagePragParseError (Located Token -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc Located Token
    tok)
              parseLanguage []
                  = String -> (Messages PsMessage, [Located String])
    forall a. String -> a
    panic String
    "getOptions'.parseLanguage(2) went past eof token"

              -- Warn for all the misplaced pragmas
              mkMessage :: Located Token -> Maybe (Messages PsMessage)
              mkMessage :: Located Token -> Maybe (Messages PsMessage)
    mkMessage (L SrcSpan
    loc Token
    token)
                | IToptions_prag String
    _ <- Token
    token
                = Messages PsMessage -> Maybe (Messages PsMessage)
    forall a. a -> Maybe a
    Just (MsgEnvelope PsMessage -> Messages PsMessage
    forall e. MsgEnvelope e -> Messages e
    singleMessage (MsgEnvelope PsMessage -> Messages PsMessage)
    -> MsgEnvelope PsMessage -> Messages PsMessage
    forall a b. (a -> b) -> a -> b
    $ DiagOpts -> SrcSpan -> PsMessage -> MsgEnvelope PsMessage
    forall e. Diagnostic e => DiagOpts -> SrcSpan -> e -> MsgEnvelope e
    mkPlainMsgEnvelope DiagOpts
    diag_opts SrcSpan
    loc (FileHeaderPragmaType -> PsMessage
    PsWarnMisplacedPragma FileHeaderPragmaType
    OptionsPrag))
                | ITinclude_prag String
    _ <- Token
    token
                = Messages PsMessage -> Maybe (Messages PsMessage)
    forall a. a -> Maybe a
    Just (MsgEnvelope PsMessage -> Messages PsMessage
    forall e. MsgEnvelope e -> Messages e
    singleMessage (MsgEnvelope PsMessage -> Messages PsMessage)
    -> MsgEnvelope PsMessage -> Messages PsMessage
    forall a b. (a -> b) -> a -> b
    $ DiagOpts -> SrcSpan -> PsMessage -> MsgEnvelope PsMessage
    forall e. Diagnostic e => DiagOpts -> SrcSpan -> e -> MsgEnvelope e
    mkPlainMsgEnvelope DiagOpts
    diag_opts SrcSpan
    loc (FileHeaderPragmaType -> PsMessage
    PsWarnMisplacedPragma FileHeaderPragmaType
    IncludePrag))
                | ITdocOptions String
    _ PsSpan
    _ <- Token
    token
                = Messages PsMessage -> Maybe (Messages PsMessage)
    forall a. a -> Maybe a
    Just (MsgEnvelope PsMessage -> Messages PsMessage
    forall e. MsgEnvelope e -> Messages e
    singleMessage (MsgEnvelope PsMessage -> Messages PsMessage)
    -> MsgEnvelope PsMessage -> Messages PsMessage
    forall a b. (a -> b) -> a -> b
    $ DiagOpts -> SrcSpan -> PsMessage -> MsgEnvelope PsMessage
    forall e. Diagnostic e => DiagOpts -> SrcSpan -> e -> MsgEnvelope e
    mkPlainMsgEnvelope DiagOpts
    diag_opts SrcSpan
    loc (FileHeaderPragmaType -> PsMessage
    PsWarnMisplacedPragma FileHeaderPragmaType
    DocOptionsPrag))
                | Token
    ITlanguage_prag <- Token
    token
                = Messages PsMessage -> Maybe (Messages PsMessage)
    forall a. a -> Maybe a
    Just (MsgEnvelope PsMessage -> Messages PsMessage
    forall e. MsgEnvelope e -> Messages e
    singleMessage (MsgEnvelope PsMessage -> Messages PsMessage)
    -> MsgEnvelope PsMessage -> Messages PsMessage
    forall a b. (a -> b) -> a -> b
    $ DiagOpts -> SrcSpan -> PsMessage -> MsgEnvelope PsMessage
    forall e. Diagnostic e => DiagOpts -> SrcSpan -> e -> MsgEnvelope e
    mkPlainMsgEnvelope DiagOpts
    diag_opts SrcSpan
    loc (FileHeaderPragmaType -> PsMessage
    PsWarnMisplacedPragma FileHeaderPragmaType
    LanguagePrag))
                | Bool
    otherwise = Maybe (Messages PsMessage)
    forall a. Maybe a
    Nothing
                where diag_opts :: DiagOpts
    diag_opts = ParserOpts -> DiagOpts
    pDiagOpts ParserOpts
    opts

              isComment :: Token -> Bool
              isComment :: Token -> Bool
    isComment Token
    c =
                case Token
    c of
                  (ITlineComment {})  -> Bool
    True
                  (ITblockComment {}) -> Bool
    True
                  (ITdocComment {})   -> Bool
    True
                  Token
    _                   -> Bool
    False

    toArgs :: RealSrcLoc
           -> String -> Either String   -- Error
                               [Located String] -- Args
    toArgs :: RealSrcLoc -> String -> Either String [Located String]
    toArgs RealSrcLoc
    starting_loc String
    orig_str
        = let (RealSrcLoc
    after_spaces_loc, String
    after_spaces_str) = RealSrcLoc -> String -> (RealSrcLoc, String)
    consume_spaces RealSrcLoc
    starting_loc String
    orig_str in
          case String
    after_spaces_str of
          Char
    '[':String
    after_bracket ->
            let after_bracket_loc :: RealSrcLoc
    after_bracket_loc = RealSrcLoc -> Char -> RealSrcLoc
    advanceSrcLoc RealSrcLoc
    after_spaces_loc Char
    '['
                (RealSrcLoc
    after_bracket_spaces_loc, String
    after_bracket_spaces_str)
                  = RealSrcLoc -> String -> (RealSrcLoc, String)
    consume_spaces RealSrcLoc
    after_bracket_loc String
    after_bracket in
            case String
    after_bracket_spaces_str of
              Char
    ']':String
    rest | (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace String
    rest -> [Located String] -> Either String [Located String]
    forall a b. b -> Either a b
    Right []
              String
    _ -> RealSrcLoc -> String -> Either String [Located String]
    readAsList RealSrcLoc
    after_bracket_spaces_loc String
    after_bracket_spaces_str

          String
    _ -> RealSrcLoc -> String -> Either String [Located String]
    toArgs' RealSrcLoc
    after_spaces_loc String
    after_spaces_str
     where
      consume_spaces :: RealSrcLoc -> String -> (RealSrcLoc, String)
      consume_spaces :: RealSrcLoc -> String -> (RealSrcLoc, String)
    consume_spaces RealSrcLoc
    loc [] = (RealSrcLoc
    loc, [])
      consume_spaces RealSrcLoc
    loc (Char
    c:String
    cs)
        | Char -> Bool
    isSpace Char
    c = RealSrcLoc -> String -> (RealSrcLoc, String)
    consume_spaces (RealSrcLoc -> Char -> RealSrcLoc
    advanceSrcLoc RealSrcLoc
    loc Char
    c) String
    cs
        | Bool
    otherwise = (RealSrcLoc
    loc, Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    cs)

      break_with_loc :: (Char -> Bool) -> RealSrcLoc -> String
                     -> (String, RealSrcLoc, String)  -- location is start of second string
      break_with_loc :: (Char -> Bool)
    -> RealSrcLoc -> String -> (String, RealSrcLoc, String)
    break_with_loc Char -> Bool
    p = String -> RealSrcLoc -> String -> (String, RealSrcLoc, String)
    go []
        where
          go :: String -> RealSrcLoc -> String -> (String, RealSrcLoc, String)
    go String
    reversed_acc RealSrcLoc
    loc [] = (String -> String
    forall a. [a] -> [a]
    reverse String
    reversed_acc, RealSrcLoc
    loc, [])
          go String
    reversed_acc RealSrcLoc
    loc (Char
    c:String
    cs)
            | Char -> Bool
    p Char
    c       = (String -> String
    forall a. [a] -> [a]
    reverse String
    reversed_acc, RealSrcLoc
    loc, Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    cs)
            | Bool
    otherwise = String -> RealSrcLoc -> String -> (String, RealSrcLoc, String)
    go (Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    reversed_acc) (RealSrcLoc -> Char -> RealSrcLoc
    advanceSrcLoc RealSrcLoc
    loc Char
    c) String
    cs

      advance_src_loc_many :: RealSrcLoc -> String -> RealSrcLoc
      advance_src_loc_many :: RealSrcLoc -> String -> RealSrcLoc
    advance_src_loc_many = (RealSrcLoc -> Char -> RealSrcLoc)
    -> RealSrcLoc -> String -> RealSrcLoc
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' RealSrcLoc -> Char -> RealSrcLoc
    advanceSrcLoc

      locate :: RealSrcLoc -> RealSrcLoc -> a -> Located a
      locate :: forall a. RealSrcLoc -> RealSrcLoc -> a -> Located a
    locate RealSrcLoc
    begin RealSrcLoc
    end a
    x = SrcSpan -> a -> GenLocated SrcSpan a
    forall l e. l -> e -> GenLocated l e
    L (RealSrcSpan -> Maybe BufSpan -> SrcSpan
    RealSrcSpan (RealSrcLoc -> RealSrcLoc -> RealSrcSpan
    mkRealSrcSpan RealSrcLoc
    begin RealSrcLoc
    end) Maybe BufSpan
    forall a. Maybe a
    Strict.Nothing) a
    x

      toArgs' :: RealSrcLoc -> String -> Either String [Located String]
      -- Remove outer quotes:
      -- > toArgs' "\"foo\" \"bar baz\""
      -- Right ["foo", "bar baz"]
      --
      -- Keep inner quotes:
      -- > toArgs' "-DFOO=\"bar baz\""
      -- Right ["-DFOO=\"bar baz\""]
      toArgs' :: RealSrcLoc -> String -> Either String [Located String]
    toArgs' RealSrcLoc
    loc String
    s =
        let (RealSrcLoc
    after_spaces_loc, String
    after_spaces_str) = RealSrcLoc -> String -> (RealSrcLoc, String)
    consume_spaces RealSrcLoc
    loc String
    s in
        case String
    after_spaces_str of
          [] -> [Located String] -> Either String [Located String]
    forall a b. b -> Either a b
    Right []
          Char
    '"' : String
    _ -> do
            -- readAsString removes outer quotes
            (String
    arg, RealSrcLoc
    new_loc, String
    rest) <- RealSrcLoc -> String -> Either String (String, RealSrcLoc, String)
    readAsString RealSrcLoc
    after_spaces_loc String
    after_spaces_str
            String -> Either String ()
    check_for_space String
    rest
            (RealSrcLoc -> RealSrcLoc -> String -> Located String
    forall a. RealSrcLoc -> RealSrcLoc -> a -> Located a
    locate RealSrcLoc
    after_spaces_loc RealSrcLoc
    new_loc String
    argLocated String -> [Located String] -> [Located String]
    forall a. a -> [a] -> [a]
    :)
              ([Located String] -> [Located String])
    -> Either String [Located String] -> Either String [Located String]
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` RealSrcLoc -> String -> Either String [Located String]
    toArgs' RealSrcLoc
    new_loc String
    rest
          String
    _ -> case (Char -> Bool)
    -> RealSrcLoc -> String -> (String, RealSrcLoc, String)
    break_with_loc (Char -> Bool
    isSpace (Char -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall (f :: * -> *). Applicative f => f Bool -> f Bool -> f Bool
    <||> (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '"')) RealSrcLoc
    after_spaces_loc String
    after_spaces_str of
                (String
    argPart1, RealSrcLoc
    loc2, s'' :: String
    s''@(Char
    '"':String
    _)) -> do
                    (String
    argPart2, RealSrcLoc
    loc3, String
    rest) <- RealSrcLoc -> String -> Either String (String, RealSrcLoc, String)
    readAsString RealSrcLoc
    loc2 String
    s''
                    String -> Either String ()
    check_for_space String
    rest
                    -- show argPart2 to keep inner quotes
                    (RealSrcLoc -> RealSrcLoc -> String -> Located String
    forall a. RealSrcLoc -> RealSrcLoc -> a -> Located a
    locate RealSrcLoc
    after_spaces_loc RealSrcLoc
    loc3 (String
    argPart1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    argPart2)Located String -> [Located String] -> [Located String]
    forall a. a -> [a] -> [a]
    :)
                      ([Located String] -> [Located String])
    -> Either String [Located String] -> Either String [Located String]
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` RealSrcLoc -> String -> Either String [Located String]
    toArgs' RealSrcLoc
    loc3 String
    rest
                (String
    arg, RealSrcLoc
    loc2, String
    s'') -> (RealSrcLoc -> RealSrcLoc -> String -> Located String
    forall a. RealSrcLoc -> RealSrcLoc -> a -> Located a
    locate RealSrcLoc
    after_spaces_loc RealSrcLoc
    loc2 String
    argLocated String -> [Located String] -> [Located String]
    forall a. a -> [a] -> [a]
    :)
                                      ([Located String] -> [Located String])
    -> Either String [Located String] -> Either String [Located String]
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` RealSrcLoc -> String -> Either String [Located String]
    toArgs' RealSrcLoc
    loc2 String
    s''

      check_for_space :: String -> Either String ()
      check_for_space :: String -> Either String ()
    check_for_space [] = () -> Either String ()
    forall a b. b -> Either a b
    Right ()
      check_for_space (Char
    c:String
    _)
        | Char -> Bool
    isSpace Char
    c = () -> Either String ()
    forall a b. b -> Either a b
    Right ()
        | Bool
    otherwise = String -> Either String ()
    forall a b. a -> Either a b
    Left (String
    "Whitespace expected after string in " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    orig_str)

      reads_with_consumed :: Read a => String
                          -> [((String, a), String)]
                            -- ((consumed string, parsed result), remainder of input)
      reads_with_consumed :: forall a. Read a => String -> [((String, a), String)]
    reads_with_consumed = ReadP (String, a) -> ReadS (String, a)
    forall a. ReadP a -> ReadS a
    readP_to_S (ReadP a -> ReadP (String, a)
    forall a. ReadP a -> ReadP (String, a)
    gather (ReadPrec a -> Int -> ReadP a
    forall a. ReadPrec a -> Int -> ReadP a
    readPrec_to_P ReadPrec a
    forall a. Read a => ReadPrec a
    readPrec Int
    0))

      readAsString :: RealSrcLoc
                   -> String
                   -> Either String (String, RealSrcLoc, String)
      readAsString :: RealSrcLoc -> String -> Either String (String, RealSrcLoc, String)
    readAsString RealSrcLoc
    loc String
    s = case String -> [((String, String), String)]
    forall a. Read a => String -> [((String, a), String)]
    reads_with_consumed String
    s of
                    [((String
    consumed, String
    arg), String
    rest)] ->
                        (String, RealSrcLoc, String)
    -> Either String (String, RealSrcLoc, String)
    forall a b. b -> Either a b
    Right (String
    arg, RealSrcLoc -> String -> RealSrcLoc
    advance_src_loc_many RealSrcLoc
    loc String
    consumed, String
    rest)
                    [((String, String), String)]
    _ ->
                        String -> Either String (String, RealSrcLoc, String)
    forall a b. a -> Either a b
    Left (String
    "Couldn't read " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " as String")

       -- input has had the '[' stripped off
      readAsList :: RealSrcLoc -> String -> Either String [Located String]
      readAsList :: RealSrcLoc -> String -> Either String [Located String]
    readAsList RealSrcLoc
    loc String
    s = do
        let (RealSrcLoc
    after_spaces_loc, String
    after_spaces_str) = RealSrcLoc -> String -> (RealSrcLoc, String)
    consume_spaces RealSrcLoc
    loc String
    s
        (String
    arg, RealSrcLoc
    after_arg_loc, String
    after_arg_str) <- RealSrcLoc -> String -> Either String (String, RealSrcLoc, String)
    readAsString RealSrcLoc
    after_spaces_loc String
    after_spaces_str
        let (RealSrcLoc
    after_arg_spaces_loc, String
    after_arg_spaces_str)
              = RealSrcLoc -> String -> (RealSrcLoc, String)
    consume_spaces RealSrcLoc
    after_arg_loc String
    after_arg_str
        (RealSrcLoc -> RealSrcLoc -> String -> Located String
    forall a. RealSrcLoc -> RealSrcLoc -> a -> Located a
    locate RealSrcLoc
    after_spaces_loc RealSrcLoc
    after_arg_loc String
    arg Located String -> [Located String] -> [Located String]
    forall a. a -> [a] -> [a]
    :) ([Located String] -> [Located String])
    -> Either String [Located String] -> Either String [Located String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
          case String
    after_arg_spaces_str of
            Char
    ',':String
    after_comma -> RealSrcLoc -> String -> Either String [Located String]
    readAsList (RealSrcLoc -> Char -> RealSrcLoc
    advanceSrcLoc RealSrcLoc
    after_arg_spaces_loc Char
    ',') String
    after_comma
            Char
    ']':String
    after_bracket
              | (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace String
    after_bracket
              -> [Located String] -> Either String [Located String]
    forall a b. b -> Either a b
    Right []
            String
    _ -> String -> Either String [Located String]
    forall a b. a -> Either a b
    Left (String
    "Couldn't read " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show (Char
    '[' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    s) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " as [String]")
                 -- reinsert missing '[' for clarity.

    -----------------------------------------------------------------------------

    -- | Complain about non-dynamic flags in OPTIONS pragmas.
    --
    -- Throws a 'SourceError' if the input list is non-empty claiming that the
    -- input flags are unknown.
    checkProcessArgsResult :: MonadIO m => [Located String] -> m ()
    checkProcessArgsResult :: forall (m :: * -> *). MonadIO m => [Located String] -> m ()
    checkProcessArgsResult [Located String]
    flags
      = Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([Located String] -> Bool
    forall (f :: * -> *) a. Foldable f => f a -> Bool
    notNull [Located String]
    flags) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
          IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Messages GhcMessage -> IO ()
    forall (io :: * -> *) a. MonadIO io => Messages GhcMessage -> io a
    throwErrors (Messages GhcMessage -> IO ()) -> Messages GhcMessage -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (Located String -> Messages GhcMessage)
    -> [Located String] -> Messages GhcMessage
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap (MsgEnvelope GhcMessage -> Messages GhcMessage
    forall e. MsgEnvelope e -> Messages e
    singleMessage (MsgEnvelope GhcMessage -> Messages GhcMessage)
    -> (Located String -> MsgEnvelope GhcMessage)
    -> Located String
    -> Messages GhcMessage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Located String -> MsgEnvelope GhcMessage
    mkMsg) [Located String]
    flags
        where mkMsg :: Located String -> MsgEnvelope GhcMessage
    mkMsg (L SrcSpan
    loc String
    flag)
                  = SrcSpan -> GhcMessage -> MsgEnvelope GhcMessage
    forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
    mkPlainErrorMsgEnvelope SrcSpan
    loc (GhcMessage -> MsgEnvelope GhcMessage)
    -> GhcMessage -> MsgEnvelope GhcMessage
    forall a b. (a -> b) -> a -> b
    $
                    PsMessage -> GhcMessage
    GhcPsMessage (PsMessage -> GhcMessage) -> PsMessage -> GhcMessage
    forall a b. (a -> b) -> a -> b
    $ PsHeaderMessage -> PsMessage
    PsHeaderMessage (PsHeaderMessage -> PsMessage) -> PsHeaderMessage -> PsMessage
    forall a b. (a -> b) -> a -> b
    $ String -> PsHeaderMessage
    PsErrUnknownOptionsPragma String
    flag

    -----------------------------------------------------------------------------

    checkExtension :: ParserOpts -> Located FastString -> Located String
    checkExtension :: ParserOpts -> Located FastString -> Located String
    checkExtension ParserOpts
    opts (L SrcSpan
    l FastString
    ext)
    -- Checks if a given extension is valid, and if so returns
    -- its corresponding flag. Otherwise it throws an exception.
      = if String
    ext' String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (ParserOpts -> [String]
    pSupportedExts ParserOpts
    opts)
        then SrcSpan -> String -> Located String
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l (String
    "-X"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    ext')
        else ParserOpts -> SrcSpan -> String -> Located String
    forall a. ParserOpts -> SrcSpan -> String -> a
    unsupportedExtnError ParserOpts
    opts SrcSpan
    l String
    ext'
      where
        ext' :: String
    ext' = FastString -> String
    unpackFS FastString
    ext

    languagePragParseError :: SrcSpan -> a
    languagePragParseError :: forall a. SrcSpan -> a
    languagePragParseError SrcSpan
    loc =
        SrcSpan -> PsHeaderMessage -> a
    forall a. SrcSpan -> PsHeaderMessage -> a
    throwErr SrcSpan
    loc (PsHeaderMessage -> a) -> PsHeaderMessage -> a
    forall a b. (a -> b) -> a -> b
    $ PsHeaderMessage
    PsErrParseLanguagePragma

    unsupportedExtnError :: ParserOpts -> SrcSpan -> String -> a
    unsupportedExtnError :: forall a. ParserOpts -> SrcSpan -> String -> a
    unsupportedExtnError ParserOpts
    opts SrcSpan
    loc String
    unsup =
        SrcSpan -> PsHeaderMessage -> a
    forall a. SrcSpan -> PsHeaderMessage -> a
    throwErr SrcSpan
    loc (PsHeaderMessage -> a) -> PsHeaderMessage -> a
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> PsHeaderMessage
    PsErrUnsupportedExt String
    unsup (ParserOpts -> [String]
    pSupportedExts ParserOpts
    opts)

    optionsParseError :: String -> SrcSpan -> a     -- #15053
    optionsParseError :: forall a. String -> SrcSpan -> a
    optionsParseError String
    str SrcSpan
    loc =
      SrcSpan -> PsHeaderMessage -> a
    forall a. SrcSpan -> PsHeaderMessage -> a
    throwErr SrcSpan
    loc (PsHeaderMessage -> a) -> PsHeaderMessage -> a
    forall a b. (a -> b) -> a -> b
    $ String -> PsHeaderMessage
    PsErrParseOptionsPragma String
    str

    throwErr :: SrcSpan -> PsHeaderMessage -> a                -- #15053
    throwErr :: forall a. SrcSpan -> PsHeaderMessage -> a
    throwErr SrcSpan
    loc PsHeaderMessage
    ps_msg =
      let msg :: MsgEnvelope GhcMessage
    msg = SrcSpan -> GhcMessage -> MsgEnvelope GhcMessage
    forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
    mkPlainErrorMsgEnvelope SrcSpan
    loc (GhcMessage -> MsgEnvelope GhcMessage)
    -> GhcMessage -> MsgEnvelope GhcMessage
    forall a b. (a -> b) -> a -> b
    $ PsMessage -> GhcMessage
    GhcPsMessage (PsHeaderMessage -> PsMessage
    PsHeaderMessage PsHeaderMessage
    ps_msg)
      in SourceError -> a
    forall a e. Exception e => e -> a
    throw (SourceError -> a) -> SourceError -> a
    forall a b. (a -> b) -> a -> b
    $ Messages GhcMessage -> SourceError
    mkSrcErr (Messages GhcMessage -> SourceError)
    -> Messages GhcMessage -> SourceError
    forall a b. (a -> b) -> a -> b
    $ MsgEnvelope GhcMessage -> Messages GhcMessage
    forall e. MsgEnvelope e -> Messages e
    singleMessage MsgEnvelope GhcMessage
    msg