    {-# LANGUAGE ImportQualifiedPost #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ViewPatterns #-}

    module GHC.All(
        CppFlags(..), ParseFlags(..), defaultParseFlags,
        parseFlagsAddFixities, parseFlagsSetLanguage,
        ParseError(..), ModuleEx(..),
        parseModuleEx, createModuleEx, createModuleExWithFixities, ghcComments, modComments, firstDeclComments,
        parseExpGhcWithMode, parseImportDeclGhcWithMode, parseDeclGhcWithMode,
        ) where

    import GHC.Driver.Ppr
    import Control.Monad.Trans.Except
    import Control.Monad.IO.Class
    import Util
    import Data.Char
    import Data.List
    import Data.List.NonEmpty qualified as NE
    import Data.List.Extra
    import Timing
    import Language.Preprocessor.Cpphs
    import System.IO.Extra
    import Fixity
    import Extension
    import GHC.Data.FastString

    import GHC.Hs hiding (comments)
    import GHC.Types.SrcLoc
    import GHC.Types.Fixity
    import GHC.Types.Error
    import GHC.Driver.Errors.Types

    import GHC.Utils.Error
    import GHC.Parser.Lexer hiding (context)
    import GHC.LanguageExtensions.Type
    import GHC.Driver.Session hiding (extensions)
    import GHC.Data.Bag
    import Data.Generics.Uniplate.DataOnly

    import Language.Haskell.GhclibParserEx.GHC.Parser
    import Language.Haskell.GhclibParserEx.Fixity
    import Language.Haskell.GhclibParserEx.GHC.Driver.Session

    import GHC.Util

    -- | What C pre processor should be used.
    data CppFlags
        = CppSimple -- ^ Lines prefixed with @#@ are stripped.
        | Cpphs CpphsOptions -- ^ The @cpphs@ library is used.

    -- | Created with 'defaultParseFlags', used by 'parseModuleEx'.
    data ParseFlags = ParseFlags
        {ParseFlags -> CppFlags
    cppFlags :: CppFlags -- ^ How the file is preprocessed (defaults to 'NoCpp').
        ,ParseFlags -> Maybe Language
    baseLanguage :: Maybe Language -- ^ Base language (e.g. Haskell98, Haskell2010), defaults to 'Nothing'.
        ,ParseFlags -> [Extension]
    enabledExtensions :: [Extension] -- ^ List of extensions enabled for parsing, defaults to many non-conflicting extensions.
        ,ParseFlags -> [Extension]
    disabledExtensions :: [Extension] -- ^ List of extensions disabled for parsing, usually empty.
        ,ParseFlags -> [FixityInfo]
    fixities :: [FixityInfo] -- ^ List of fixities to be aware of, defaults to those defined in @base@.
        }

    -- | Default value for 'ParseFlags'.
    defaultParseFlags :: ParseFlags
    defaultParseFlags :: ParseFlags
    defaultParseFlags = CppFlags
    -> Maybe Language
    -> [Extension]
    -> [Extension]
    -> [FixityInfo]
    -> ParseFlags
    ParseFlags CppFlags
    CppSimple Maybe Language
    forall a. Maybe a
    Nothing [Extension]
    defaultExtensions [] [FixityInfo]
    defaultFixities

    -- | Given some fixities, add them to the existing fixities in 'ParseFlags'.
    parseFlagsAddFixities :: [FixityInfo] -> ParseFlags -> ParseFlags
    parseFlagsAddFixities :: [FixityInfo] -> ParseFlags -> ParseFlags
    parseFlagsAddFixities [FixityInfo]
    fx ParseFlags
    x = ParseFlags
    x{fixities = fx ++ fixities x}

    parseFlagsSetLanguage :: (Maybe Language, ([Extension], [Extension])) -> ParseFlags -> ParseFlags
    parseFlagsSetLanguage :: (Maybe Language, ([Extension], [Extension]))
    -> ParseFlags -> ParseFlags
    parseFlagsSetLanguage (Maybe Language
    l, ([Extension]
    es, [Extension]
    ds)) ParseFlags
    x = ParseFlags
    x{baseLanguage = l, enabledExtensions = es, disabledExtensions = ds}

    runCpp :: CppFlags -> FilePath -> String -> IO String
    runCpp :: CppFlags -> FilePath -> FilePath -> IO FilePath
    runCpp CppFlags
    CppSimple FilePath
    _ FilePath
    x = FilePath -> IO FilePath
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ [FilePath] -> FilePath
    unlines [if FilePath
    "#" FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` FilePath -> FilePath
    trimStart FilePath
    x then FilePath
    "" else FilePath
    x | FilePath
    x <- FilePath -> [FilePath]
    lines FilePath
    x]
    runCpp (Cpphs CpphsOptions
    o) FilePath
    file FilePath
    x = FilePath -> FilePath
    dropLine (FilePath -> FilePath) -> IO FilePath -> IO FilePath
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CpphsOptions -> FilePath -> FilePath -> IO FilePath
    runCpphs CpphsOptions
    o FilePath
    file FilePath
    x
        where
            -- LINE pragmas always inserted when locations=True
            dropLine :: FilePath -> FilePath
    dropLine (FilePath -> (FilePath, FilePath)
    line1 -> (FilePath
    a,FilePath
    b)) | FilePath
    "{-# LINE " FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` FilePath
    a = FilePath
    b
            dropLine FilePath
    x = FilePath
    x

    ---------------------------------------------------------------------
    -- PARSING

    -- | A parse error.
    data ParseError = ParseError
        { ParseError -> SrcSpan
    parseErrorLocation :: SrcSpan -- ^ Location of the error.
        , ParseError -> FilePath
    parseErrorMessage :: String  -- ^ Message about the cause of the error.
        , ParseError -> FilePath
    parseErrorContents :: String -- ^ Snippet of several lines (typically 5) including a @>@ character pointing at the faulty line.
        }

    -- | Result of 'parseModuleEx', representing a parsed module.
    newtype ModuleEx = ModuleEx {
        ModuleEx -> Located (HsModule GhcPs)
    ghcModule :: Located (HsModule GhcPs)
    }

    -- | Extract a complete list of all the comments in a module.
    ghcComments :: ModuleEx -> [LEpaComment]
    ghcComments :: ModuleEx -> [LEpaComment]
    ghcComments = Located (HsModule GhcPs) -> [LEpaComment]
    forall from to. Biplate from to => from -> [to]
    universeBi (Located (HsModule GhcPs) -> [LEpaComment])
    -> (ModuleEx -> Located (HsModule GhcPs))
    -> ModuleEx
    -> [LEpaComment]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleEx -> Located (HsModule GhcPs)
    ghcModule

    -- | Extract just the list of a modules' leading comments (pragmas).
    modComments :: ModuleEx -> EpAnnComments
    modComments :: ModuleEx -> EpAnnComments
    modComments = EpAnn AnnsModule -> EpAnnComments
    forall ann. EpAnn ann -> EpAnnComments
    comments (EpAnn AnnsModule -> EpAnnComments)
    -> (ModuleEx -> EpAnn AnnsModule) -> ModuleEx -> EpAnnComments
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XModulePs -> EpAnn AnnsModule
    hsmodAnn (XModulePs -> EpAnn AnnsModule)
    -> (ModuleEx -> XModulePs) -> ModuleEx -> EpAnn AnnsModule
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsModule GhcPs -> XCModule GhcPs
    HsModule GhcPs -> XModulePs
    forall p. HsModule p -> XCModule p
    hsmodExt (HsModule GhcPs -> XModulePs)
    -> (ModuleEx -> HsModule GhcPs) -> ModuleEx -> XModulePs
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Located (HsModule GhcPs) -> HsModule GhcPs
    forall l e. GenLocated l e -> e
    unLoc (Located (HsModule GhcPs) -> HsModule GhcPs)
    -> (ModuleEx -> Located (HsModule GhcPs))
    -> ModuleEx
    -> HsModule GhcPs
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleEx -> Located (HsModule GhcPs)
    ghcModule

    -- | Extract comments associated with the first declaration of a module.
    firstDeclComments :: ModuleEx -> EpAnnComments
    firstDeclComments :: ModuleEx -> EpAnnComments
    firstDeclComments ModuleEx
    m =
      case HsModule GhcPs -> [LHsDecl GhcPs]
    HsModule GhcPs -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    forall p. HsModule p -> [LHsDecl p]
    hsmodDecls (HsModule GhcPs -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
    -> (ModuleEx -> HsModule GhcPs)
    -> ModuleEx
    -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Located (HsModule GhcPs) -> HsModule GhcPs
    forall l e. GenLocated l e -> e
    unLoc (Located (HsModule GhcPs) -> HsModule GhcPs)
    -> (ModuleEx -> Located (HsModule GhcPs))
    -> ModuleEx
    -> HsModule GhcPs
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleEx -> Located (HsModule GhcPs)
    ghcModule (ModuleEx -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
    -> ModuleEx -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    forall a b. (a -> b) -> a -> b
    $ ModuleEx
    m of
            [] -> [LEpaComment] -> [LEpaComment] -> EpAnnComments
    EpaCommentsBalanced [] []
            L SrcSpanAnnA
    ann HsDecl GhcPs
    _ : [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    _ -> SrcSpanAnnA -> EpAnnComments
    forall ann. EpAnn ann -> EpAnnComments
    comments SrcSpanAnnA
    ann

    -- | The error handler invoked when GHC parsing has failed.
    ghcFailOpParseModuleEx :: String
                           -> FilePath
                           -> String
                           -> (SrcSpan, SDoc)
                           -> IO (Either ParseError ModuleEx)
    ghcFailOpParseModuleEx :: FilePath
    -> FilePath
    -> FilePath
    -> (SrcSpan, SDoc)
    -> IO (Either ParseError ModuleEx)
    ghcFailOpParseModuleEx FilePath
    ppstr FilePath
    file FilePath
    str (SrcSpan
    loc, SDoc
    err) = do
       let pe :: FilePath
    pe = case SrcSpan
    loc of
                RealSrcSpan RealSrcSpan
    r Maybe BufSpan
    _ -> Int -> FilePath -> FilePath
    context (RealSrcSpan -> Int
    srcSpanStartLine RealSrcSpan
    r) FilePath
    ppstr
                SrcSpan
    _ -> FilePath
    ""
           msg :: FilePath
    msg = DynFlags -> SDoc -> FilePath
    GHC.Driver.Ppr.showSDoc DynFlags
    baseDynFlags SDoc
    err
       Either ParseError ModuleEx -> IO (Either ParseError ModuleEx)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either ParseError ModuleEx -> IO (Either ParseError ModuleEx))
    -> Either ParseError ModuleEx -> IO (Either ParseError ModuleEx)
    forall a b. (a -> b) -> a -> b
    $ ParseError -> Either ParseError ModuleEx
    forall a b. a -> Either a b
    Left (ParseError -> Either ParseError ModuleEx)
    -> ParseError -> Either ParseError ModuleEx
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> FilePath -> FilePath -> ParseError
    ParseError SrcSpan
    loc FilePath
    msg FilePath
    pe

    -- GHC extensions to enable/disable given HSE parse flags.
    ghcExtensionsFromParseFlags :: ParseFlags -> ([Extension], [Extension])
    ghcExtensionsFromParseFlags :: ParseFlags -> ([Extension], [Extension])
    ghcExtensionsFromParseFlags ParseFlags{enabledExtensions :: ParseFlags -> [Extension]
    enabledExtensions=[Extension]
    es, disabledExtensions :: ParseFlags -> [Extension]
    disabledExtensions=[Extension]
    ds}= ([Extension]
    es, [Extension]
    ds)

    -- GHC fixities given HSE parse flags.
    ghcFixitiesFromParseFlags :: ParseFlags -> [(String, GHC.Types.Fixity.Fixity)]
    ghcFixitiesFromParseFlags :: ParseFlags -> [(FilePath, Fixity)]
    ghcFixitiesFromParseFlags = (FixityInfo -> (FilePath, Fixity))
    -> [FixityInfo] -> [(FilePath, Fixity)]
    forall a b. (a -> b) -> [a] -> [b]
    map FixityInfo -> (FilePath, Fixity)
    toFixity ([FixityInfo] -> [(FilePath, Fixity)])
    -> (ParseFlags -> [FixityInfo])
    -> ParseFlags
    -> [(FilePath, Fixity)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseFlags -> [FixityInfo]
    fixities

    -- These next two functions get called from 'Config/Yaml.hs' for user
    -- defined hint rules.

    parseModeToFlags :: ParseFlags -> DynFlags
    parseModeToFlags :: ParseFlags -> DynFlags
    parseModeToFlags ParseFlags
    parseMode =
      (DynFlags -> Maybe Language -> DynFlags)
    -> Maybe Language -> DynFlags -> DynFlags
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip DynFlags -> Maybe Language -> DynFlags
    lang_set (ParseFlags -> Maybe Language
    baseLanguage ParseFlags
    parseMode) (DynFlags -> DynFlags) -> DynFlags -> DynFlags
    forall a b. (a -> b) -> a -> b
    $ (DynFlags -> Extension -> DynFlags)
    -> DynFlags -> [Extension] -> DynFlags
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DynFlags -> Extension -> DynFlags
    xopt_unset ((DynFlags -> Extension -> DynFlags)
    -> DynFlags -> [Extension] -> DynFlags
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' DynFlags -> Extension -> DynFlags
    xopt_set DynFlags
    baseDynFlags [Extension]
    enable) [Extension]
    disable
      where
        ([Extension]
    enable, [Extension]
    disable) = ParseFlags -> ([Extension], [Extension])
    ghcExtensionsFromParseFlags ParseFlags
    parseMode

    parseExpGhcWithMode :: ParseFlags -> String -> ParseResult (LHsExpr GhcPs)
    parseExpGhcWithMode :: ParseFlags -> FilePath -> ParseResult (LHsExpr GhcPs)
    parseExpGhcWithMode ParseFlags
    parseMode FilePath
    s =
      let fixities :: [(FilePath, Fixity)]
    fixities = ParseFlags -> [(FilePath, Fixity)]
    ghcFixitiesFromParseFlags ParseFlags
    parseMode
      in case FilePath -> DynFlags -> ParseResult (LHsExpr GhcPs)
    parseExpression FilePath
    s (DynFlags -> ParseResult (LHsExpr GhcPs))
    -> DynFlags -> ParseResult (LHsExpr GhcPs)
    forall a b. (a -> b) -> a -> b
    $ ParseFlags -> DynFlags
    parseModeToFlags ParseFlags
    parseMode of
        POk PState
    pst GenLocated SrcSpanAnnA (HsExpr GhcPs)
    a -> PState -> LHsExpr GhcPs -> ParseResult (LHsExpr GhcPs)
    forall a. PState -> a -> ParseResult a
    POk PState
    pst (LHsExpr GhcPs -> ParseResult (LHsExpr GhcPs))
    -> LHsExpr GhcPs -> ParseResult (LHsExpr GhcPs)
    forall a b. (a -> b) -> a -> b
    $ [(FilePath, Fixity)]
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    forall a. Data a => [(FilePath, Fixity)] -> a -> a
    applyFixities [(FilePath, Fixity)]
    fixities GenLocated SrcSpanAnnA (HsExpr GhcPs)
    a
        f :: ParseResult (LHsExpr GhcPs)
    f@PFailed{} -> ParseResult (LHsExpr GhcPs)
    f

    parseImportDeclGhcWithMode :: ParseFlags -> String -> ParseResult (LImportDecl GhcPs)
    parseImportDeclGhcWithMode :: ParseFlags -> FilePath -> ParseResult (LImportDecl GhcPs)
    parseImportDeclGhcWithMode ParseFlags
    parseMode FilePath
    s =
      FilePath -> DynFlags -> ParseResult (LImportDecl GhcPs)
    parseImport FilePath
    s (DynFlags -> ParseResult (LImportDecl GhcPs))
    -> DynFlags -> ParseResult (LImportDecl GhcPs)
    forall a b. (a -> b) -> a -> b
    $ ParseFlags -> DynFlags
    parseModeToFlags ParseFlags
    parseMode

    parseDeclGhcWithMode :: ParseFlags -> String -> ParseResult (LHsDecl GhcPs)
    parseDeclGhcWithMode :: ParseFlags -> FilePath -> ParseResult (LHsDecl GhcPs)
    parseDeclGhcWithMode ParseFlags
    parseMode FilePath
    s =
      let fixities :: [(FilePath, Fixity)]
    fixities = ParseFlags -> [(FilePath, Fixity)]
    ghcFixitiesFromParseFlags ParseFlags
    parseMode
      in case FilePath -> DynFlags -> ParseResult (LHsDecl GhcPs)
    parseDeclaration FilePath
    s (DynFlags -> ParseResult (LHsDecl GhcPs))
    -> DynFlags -> ParseResult (LHsDecl GhcPs)
    forall a b. (a -> b) -> a -> b
    $ ParseFlags -> DynFlags
    parseModeToFlags ParseFlags
    parseMode of
        POk PState
    pst GenLocated SrcSpanAnnA (HsDecl GhcPs)
    a -> PState -> LHsDecl GhcPs -> ParseResult (LHsDecl GhcPs)
    forall a. PState -> a -> ParseResult a
    POk PState
    pst (LHsDecl GhcPs -> ParseResult (LHsDecl GhcPs))
    -> LHsDecl GhcPs -> ParseResult (LHsDecl GhcPs)
    forall a b. (a -> b) -> a -> b
    $ [(FilePath, Fixity)]
    -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
    forall a. Data a => [(FilePath, Fixity)] -> a -> a
    applyFixities [(FilePath, Fixity)]
    fixities GenLocated SrcSpanAnnA (HsDecl GhcPs)
    a
        f :: ParseResult (LHsDecl GhcPs)
    f@PFailed{} -> ParseResult (LHsDecl GhcPs)
    f

    -- | Create a 'ModuleEx' from a GHC module. It is assumed the incoming
    -- parsed module has not been adjusted to account for operator
    -- fixities (it uses the HLint default fixities).
    createModuleEx :: Located (HsModule GhcPs) -> ModuleEx
    createModuleEx :: Located (HsModule GhcPs) -> ModuleEx
    createModuleEx = [(FilePath, Fixity)] -> Located (HsModule GhcPs) -> ModuleEx
    createModuleExWithFixities ((FixityInfo -> (FilePath, Fixity))
    -> [FixityInfo] -> [(FilePath, Fixity)]
    forall a b. (a -> b) -> [a] -> [b]
    map FixityInfo -> (FilePath, Fixity)
    toFixity [FixityInfo]
    defaultFixities)

    createModuleExWithFixities :: [(String, Fixity)] -> Located (HsModule GhcPs) -> ModuleEx
    createModuleExWithFixities :: [(FilePath, Fixity)] -> Located (HsModule GhcPs) -> ModuleEx
    createModuleExWithFixities [(FilePath, Fixity)]
    fixities Located (HsModule GhcPs)
    ast =
      Located (HsModule GhcPs) -> ModuleEx
    ModuleEx ([(FilePath, Fixity)]
    -> Located (HsModule GhcPs) -> Located (HsModule GhcPs)
    forall a. Data a => [(FilePath, Fixity)] -> a -> a
    applyFixities (Located (HsModule GhcPs) -> [(FilePath, Fixity)]
    fixitiesFromModule Located (HsModule GhcPs)
    ast [(FilePath, Fixity)]
    -> [(FilePath, Fixity)] -> [(FilePath, Fixity)]
    forall a. [a] -> [a] -> [a]
    ++ [(FilePath, Fixity)]
    fixities) Located (HsModule GhcPs)
    ast)

    impliedEnables :: Extension -> [Extension]
    impliedEnables :: Extension -> [Extension]
    impliedEnables Extension
    ext = case Extension
    -> [(Extension, ([Extension], [Extension]))]
    -> Maybe ([Extension], [Extension])
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    Data.List.lookup Extension
    ext [(Extension, ([Extension], [Extension]))]
    extensionImplications of
      Just ([Extension], [Extension])
    exts -> Extension
    ext Extension -> [Extension] -> [Extension]
    forall a. a -> [a] -> [a]
    : ([Extension], [Extension]) -> [Extension]
    forall a b. (a, b) -> a
    fst ([Extension], [Extension])
    exts
      Maybe ([Extension], [Extension])
    Nothing -> [Extension
    ext]

    impliedDisables :: Extension -> [Extension]
    impliedDisables :: Extension -> [Extension]
    impliedDisables Extension
    ext = case Extension
    -> [(Extension, ([Extension], [Extension]))]
    -> Maybe ([Extension], [Extension])
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    Data.List.lookup Extension
    ext [(Extension, ([Extension], [Extension]))]
    extensionImplications  of
      Just ([Extension], [Extension])
    exts -> Extension
    ext Extension -> [Extension] -> [Extension]
    forall a. a -> [a] -> [a]
    : ([Extension], [Extension]) -> [Extension]
    forall a b. (a, b) -> b
    snd ([Extension], [Extension])
    exts
      Maybe ([Extension], [Extension])
    Nothing -> []

    -- | Parse a Haskell module. Applies the C pre processor, and uses
    -- best-guess fixity resolution if there are ambiguities.  The
    -- filename @-@ is treated as @stdin@. Requires some flags (often
    -- 'defaultParseFlags'), the filename, and optionally the contents of
    -- that file.
    --
    -- Note that certain programs, e.g. @main = do@ successfully parse
    -- with GHC, but then fail with an error in the renamer. These
    -- programs will return a successful parse.
    parseModuleEx :: ParseFlags -> FilePath -> Maybe String -> IO (Either ParseError ModuleEx)
    parseModuleEx :: ParseFlags
    -> FilePath -> Maybe FilePath -> IO (Either ParseError ModuleEx)
    parseModuleEx ParseFlags
    flags FilePath
    file Maybe FilePath
    str = FilePath
    -> FilePath
    -> IO (Either ParseError ModuleEx)
    -> IO (Either ParseError ModuleEx)
    forall a. FilePath -> FilePath -> IO a -> IO a
    timedIO FilePath
    "Parse" FilePath
    file (IO (Either ParseError ModuleEx)
     -> IO (Either ParseError ModuleEx))
    -> IO (Either ParseError ModuleEx)
    -> IO (Either ParseError ModuleEx)
    forall a b. (a -> b) -> a -> b
    $ ExceptT ParseError IO ModuleEx -> IO (Either ParseError ModuleEx)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT ParseError IO ModuleEx -> IO (Either ParseError ModuleEx))
    -> ExceptT ParseError IO ModuleEx
    -> IO (Either ParseError ModuleEx)
    forall a b. (a -> b) -> a -> b
    $ do
      str <- case Maybe FilePath
    str of
        Just FilePath
    x -> FilePath -> ExceptT ParseError IO FilePath
    forall a. a -> ExceptT ParseError IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FilePath
    x
        Maybe FilePath
    Nothing | FilePath
    file FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    "-" -> IO FilePath -> ExceptT ParseError IO FilePath
    forall a. IO a -> ExceptT ParseError IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO FilePath
    getContentsUTF8
                | Bool
    otherwise -> IO FilePath -> ExceptT ParseError IO FilePath
    forall a. IO a -> ExceptT ParseError IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO FilePath -> ExceptT ParseError IO FilePath)
    -> IO FilePath -> ExceptT ParseError IO FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO FilePath
    readFileUTF8' FilePath
    file
      str <- pure $ dropPrefix "\65279" str -- Remove the BOM if it exists, see #130.
      let (enable, disable) = ghcExtensionsFromParseFlags flags
      -- Enable/disable extensions and the extensions they imply.
          impliedEnabled = (Extension -> [Extension]) -> [Extension] -> [Extension]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Extension -> [Extension]
    impliedEnables [Extension]
    enable
          impliedDisabled = (Extension -> [Extension]) -> [Extension] -> [Extension]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Extension -> [Extension]
    impliedDisables [Extension]
    disable
          enableDisableExts = ([Extension]
    impliedEnabled, [Extension]
    impliedDisabled)
      -- Read pragmas for the first time.
      dynFlags <- withExceptT (parsePragmasErr str) $ ExceptT (parsePragmasIntoDynFlags baseDynFlags enableDisableExts file str)
      dynFlags <- pure $ lang_set dynFlags $ baseLanguage flags
      -- Avoid running cpp unless CPP is enabled, see #1075.
      str <- if not (xopt Cpp dynFlags) then pure str else liftIO $ runCpp (cppFlags flags) file str
      -- If we preprocessed the file, re-read the pragmas.
      dynFlags <- if not (xopt Cpp dynFlags) then pure dynFlags
                  else withExceptT (parsePragmasErr str) $ ExceptT (parsePragmasIntoDynFlags baseDynFlags enableDisableExts file str)
      dynFlags <- pure $ lang_set dynFlags $ baseLanguage flags
      -- Done with pragmas. Proceed to parsing.
      case fileToModule file str dynFlags of
        POk PState
    s Located (HsModule GhcPs)
    a -> do
          let errs :: [MsgEnvelope GhcMessage]
    errs = Bag (MsgEnvelope GhcMessage) -> [MsgEnvelope GhcMessage]
    forall a. Bag a -> [a]
    bagToList (Bag (MsgEnvelope GhcMessage) -> [MsgEnvelope GhcMessage])
    -> (Messages GhcMessage -> Bag (MsgEnvelope GhcMessage))
    -> Messages GhcMessage
    -> [MsgEnvelope GhcMessage]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Messages GhcMessage -> Bag (MsgEnvelope GhcMessage)
    forall e. Messages e -> Bag (MsgEnvelope e)
    getMessages (Messages GhcMessage -> [MsgEnvelope GhcMessage])
    -> Messages GhcMessage -> [MsgEnvelope GhcMessage]
    forall a b. (a -> b) -> a -> b
    $ PsMessage -> GhcMessage
    GhcPsMessage (PsMessage -> GhcMessage)
    -> Messages PsMessage -> Messages GhcMessage
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Messages PsMessage, Messages PsMessage) -> Messages PsMessage
    forall a b. (a, b) -> b
    snd (PState -> (Messages PsMessage, Messages PsMessage)
    getPsMessages PState
    s)
          if Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [MsgEnvelope GhcMessage] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [MsgEnvelope GhcMessage]
    errs then
            IO (Either ParseError ModuleEx) -> ExceptT ParseError IO ModuleEx
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (IO (Either ParseError ModuleEx) -> ExceptT ParseError IO ModuleEx)
    -> IO (Either ParseError ModuleEx)
    -> ExceptT ParseError IO ModuleEx
    forall a b. (a -> b) -> a -> b
    $ DynFlags
    -> FilePath
    -> FilePath
    -> FilePath
    -> NonEmpty (MsgEnvelope GhcMessage)
    -> IO (Either ParseError ModuleEx)
    forall {e} {p}.
    Diagnostic e =>
    p
    -> FilePath
    -> FilePath
    -> FilePath
    -> NonEmpty (MsgEnvelope e)
    -> IO (Either ParseError ModuleEx)
    parseFailureErr DynFlags
    dynFlags FilePath
    str FilePath
    file FilePath
    str (NonEmpty (MsgEnvelope GhcMessage)
     -> IO (Either ParseError ModuleEx))
    -> NonEmpty (MsgEnvelope GhcMessage)
    -> IO (Either ParseError ModuleEx)
    forall a b. (a -> b) -> a -> b
    $ [MsgEnvelope GhcMessage] -> NonEmpty (MsgEnvelope GhcMessage)
    forall a. HasCallStack => [a] -> NonEmpty a
    NE.fromList [MsgEnvelope GhcMessage]
    errs
          else do
            let fixes :: [(FilePath, Fixity)]
    fixes = Located (HsModule GhcPs) -> [(FilePath, Fixity)]
    fixitiesFromModule Located (HsModule GhcPs)
    a [(FilePath, Fixity)]
    -> [(FilePath, Fixity)] -> [(FilePath, Fixity)]
    forall a. [a] -> [a] -> [a]
    ++ ParseFlags -> [(FilePath, Fixity)]
    ghcFixitiesFromParseFlags ParseFlags
    flags
            ModuleEx -> ExceptT ParseError IO ModuleEx
    forall a. a -> ExceptT ParseError IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ModuleEx -> ExceptT ParseError IO ModuleEx)
    -> ModuleEx -> ExceptT ParseError IO ModuleEx
    forall a b. (a -> b) -> a -> b
    $ Located (HsModule GhcPs) -> ModuleEx
    ModuleEx ([(FilePath, Fixity)]
    -> Located (HsModule GhcPs) -> Located (HsModule GhcPs)
    forall a. Data a => [(FilePath, Fixity)] -> a -> a
    applyFixities [(FilePath, Fixity)]
    fixes Located (HsModule GhcPs)
    a)
        PFailed PState
    s ->
          IO (Either ParseError ModuleEx) -> ExceptT ParseError IO ModuleEx
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (IO (Either ParseError ModuleEx) -> ExceptT ParseError IO ModuleEx)
    -> IO (Either ParseError ModuleEx)
    -> ExceptT ParseError IO ModuleEx
    forall a b. (a -> b) -> a -> b
    $ DynFlags
    -> FilePath
    -> FilePath
    -> FilePath
    -> NonEmpty (MsgEnvelope GhcMessage)
    -> IO (Either ParseError ModuleEx)
    forall {e} {p}.
    Diagnostic e =>
    p
    -> FilePath
    -> FilePath
    -> FilePath
    -> NonEmpty (MsgEnvelope e)
    -> IO (Either ParseError ModuleEx)
    parseFailureErr DynFlags
    dynFlags FilePath
    str FilePath
    file FilePath
    str (NonEmpty (MsgEnvelope GhcMessage)
     -> IO (Either ParseError ModuleEx))
    -> NonEmpty (MsgEnvelope GhcMessage)
    -> IO (Either ParseError ModuleEx)
    forall a b. (a -> b) -> a -> b
    $ [MsgEnvelope GhcMessage] -> NonEmpty (MsgEnvelope GhcMessage)
    forall a. HasCallStack => [a] -> NonEmpty a
    NE.fromList ([MsgEnvelope GhcMessage] -> NonEmpty (MsgEnvelope GhcMessage))
    -> (Messages GhcMessage -> [MsgEnvelope GhcMessage])
    -> Messages GhcMessage
    -> NonEmpty (MsgEnvelope GhcMessage)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bag (MsgEnvelope GhcMessage) -> [MsgEnvelope GhcMessage]
    forall a. Bag a -> [a]
    bagToList (Bag (MsgEnvelope GhcMessage) -> [MsgEnvelope GhcMessage])
    -> (Messages GhcMessage -> Bag (MsgEnvelope GhcMessage))
    -> Messages GhcMessage
    -> [MsgEnvelope GhcMessage]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Messages GhcMessage -> Bag (MsgEnvelope GhcMessage)
    forall e. Messages e -> Bag (MsgEnvelope e)
    getMessages  (Messages GhcMessage -> NonEmpty (MsgEnvelope GhcMessage))
    -> Messages GhcMessage -> NonEmpty (MsgEnvelope GhcMessage)
    forall a b. (a -> b) -> a -> b
    $ PsMessage -> GhcMessage
    GhcPsMessage (PsMessage -> GhcMessage)
    -> Messages PsMessage -> Messages GhcMessage
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Messages PsMessage, Messages PsMessage) -> Messages PsMessage
    forall a b. (a, b) -> b
    snd (PState -> (Messages PsMessage, Messages PsMessage)
    getPsMessages PState
    s)
      where
        -- If parsing pragmas fails, synthesize a parse error from the
        -- error message.
        parsePragmasErr :: FilePath -> FilePath -> ParseError
    parsePragmasErr FilePath
    src FilePath
    msg =
          let loc :: SrcLoc
    loc = FastString -> Int -> Int -> SrcLoc
    mkSrcLoc (FilePath -> FastString
    mkFastString FilePath
    file) (Int
    1 :: Int) (Int
    1 :: Int)
          in SrcSpan -> FilePath -> FilePath -> ParseError
    ParseError (SrcLoc -> SrcLoc -> SrcSpan
    mkSrcSpan SrcLoc
    loc SrcLoc
    loc) FilePath
    msg FilePath
    src

        parseFailureErr :: p
    -> FilePath
    -> FilePath
    -> FilePath
    -> NonEmpty (MsgEnvelope e)
    -> IO (Either ParseError ModuleEx)
    parseFailureErr p
    dynFlags FilePath
    ppstr FilePath
    file FilePath
    str NonEmpty (MsgEnvelope e)
    errs =
          let errMsg :: MsgEnvelope e
    errMsg = NonEmpty (MsgEnvelope e) -> MsgEnvelope e
    forall a. NonEmpty a -> a
    NE.head NonEmpty (MsgEnvelope e)
    errs
              loc :: SrcSpan
    loc = MsgEnvelope e -> SrcSpan
    forall e. MsgEnvelope e -> SrcSpan
    errMsgSpan MsgEnvelope e
    errMsg
              doc :: SDoc
    doc = MsgEnvelope e -> SDoc
    forall e. Diagnostic e => MsgEnvelope e -> SDoc
    pprLocMsgEnvelopeDefault MsgEnvelope e
    errMsg
          in FilePath
    -> FilePath
    -> FilePath
    -> (SrcSpan, SDoc)
    -> IO (Either ParseError ModuleEx)
    ghcFailOpParseModuleEx FilePath
    ppstr FilePath
    file FilePath
    str (SrcSpan
    loc, SDoc
    doc)

    -- | Given a line number, and some source code, put bird ticks around the appropriate bit.
    context :: Int -> String -> String
    context :: Int -> FilePath -> FilePath
    context Int
    lineNo FilePath
    src =
        [FilePath] -> FilePath
    unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
    forall a b. (a -> b) -> a -> b
    $ (FilePath -> Bool) -> [FilePath] -> [FilePath]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhileEnd ((Char -> Bool) -> FilePath -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
    forall a b. (a -> b) -> a -> b
    $ (FilePath -> Bool) -> [FilePath] -> [FilePath]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile ((Char -> Bool) -> FilePath -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
    forall a b. (a -> b) -> a -> b
    $
        (FilePath -> FilePath -> FilePath)
    -> [FilePath] -> [FilePath] -> [FilePath]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    (++) [FilePath]
    ticks ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
    forall a b. (a -> b) -> a -> b
    $ Int -> [FilePath] -> [FilePath]
    forall a. Int -> [a] -> [a]
    take Int
    5 ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
    forall a b. (a -> b) -> a -> b
    $ Int -> [FilePath] -> [FilePath]
    forall a. Int -> [a] -> [a]
    drop (Int
    lineNo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    3) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
    forall a b. (a -> b) -> a -> b
    $ FilePath -> [FilePath]
    lines FilePath
    src [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ [FilePath
    "",FilePath
    "",FilePath
    "",FilePath
    "",FilePath
    ""]
        where ticks :: [FilePath]
    ticks = Int -> [FilePath] -> [FilePath]
    forall a. Int -> [a] -> [a]
    drop (Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    lineNo) [FilePath
    "  ",FilePath
    "  ",FilePath
    "> ",FilePath
    "  ",FilePath
    "  "]