    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE ViewPatterns #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}

    -- | Parser for Haskell source code.
    module Ormolu.Parser
      ( parseModule,
        manualExts,
      )
    where

    import Control.Exception
    import Control.Monad
    import Control.Monad.Except (ExceptT (..), runExceptT)
    import Control.Monad.IO.Class
    import Data.Char (isSpace)
    import Data.Functor
    import Data.Generics
    import qualified Data.List as L
    import qualified Data.List.NonEmpty as NE
    import Data.Text (Text)
    import GHC.Data.Bag (bagToList)
    import qualified GHC.Data.EnumSet as EnumSet
    import qualified GHC.Data.FastString as GHC
    import qualified GHC.Driver.CmdLine as GHC
    import GHC.Driver.Config.Parser (initParserOpts)
    import GHC.Driver.Session as GHC
    import GHC.DynFlags (baseDynFlags)
    import GHC.Hs hiding (UnicodeSyntax)
    import GHC.LanguageExtensions.Type (Extension (..))
    import qualified GHC.Parser as GHC
    import qualified GHC.Parser.Header as GHC
    import qualified GHC.Parser.Lexer as GHC
    import GHC.Types.Error (getMessages)
    import qualified GHC.Types.SourceError as GHC (handleSourceError)
    import GHC.Types.SrcLoc
    import GHC.Utils.Error
    import GHC.Utils.Outputable (defaultSDocContext)
    import qualified GHC.Utils.Panic as GHC
    import Ormolu.Config
    import Ormolu.Exception
    import Ormolu.Fixity (LazyFixityMap)
    import Ormolu.Imports (normalizeImports)
    import Ormolu.Parser.CommentStream
    import Ormolu.Parser.Result
    import Ormolu.Processing.Common
    import Ormolu.Processing.Preprocess
    import Ormolu.Utils (incSpanLine, showOutputable, textToStringBuffer)

    -- | Parse a complete module from string.
    parseModule ::
      (MonadIO m) =>
      -- | Ormolu configuration
      Config RegionDeltas ->
      -- | Fixity map to include in the resulting 'ParseResult's
      LazyFixityMap ->
      -- | File name (only for source location annotations)
      FilePath ->
      -- | Input for parser
      Text ->
      m
        ( [GHC.Warn],
          Either (SrcSpan, String) [SourceSnippet]
        )
    parseModule :: forall (m :: * -> *).
    MonadIO m =>
    Config RegionDeltas
    -> LazyFixityMap
    -> String
    -> Text
    -> m ([Warn], Either (SrcSpan, String) [SourceSnippet])
    parseModule config :: Config RegionDeltas
    config@Config {Bool
    [DynOption]
    Set PackageName
    FixityMap
    ColorMode
    RegionDeltas
    SourceType
    cfgDynOptions :: [DynOption]
    cfgFixityOverrides :: FixityMap
    cfgDependencies :: Set PackageName
    cfgUnsafe :: Bool
    cfgDebug :: Bool
    cfgCheckIdempotence :: Bool
    cfgSourceType :: SourceType
    cfgColorMode :: ColorMode
    cfgRegion :: RegionDeltas
    cfgDynOptions :: forall region. Config region -> [DynOption]
    cfgFixityOverrides :: forall region. Config region -> FixityMap
    cfgDependencies :: forall region. Config region -> Set PackageName
    cfgUnsafe :: forall region. Config region -> Bool
    cfgDebug :: forall region. Config region -> Bool
    cfgCheckIdempotence :: forall region. Config region -> Bool
    cfgSourceType :: forall region. Config region -> SourceType
    cfgColorMode :: forall region. Config region -> ColorMode
    cfgRegion :: forall region. Config region -> region
    ..} LazyFixityMap
    fixityMap String
    path Text
    rawInput = IO ([Warn], Either (SrcSpan, String) [SourceSnippet])
    -> m ([Warn], Either (SrcSpan, String) [SourceSnippet])
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ([Warn], Either (SrcSpan, String) [SourceSnippet])
     -> m ([Warn], Either (SrcSpan, String) [SourceSnippet]))
    -> IO ([Warn], Either (SrcSpan, String) [SourceSnippet])
    -> m ([Warn], Either (SrcSpan, String) [SourceSnippet])
    forall a b. (a -> b) -> a -> b
    $ do
      -- It's important that 'setDefaultExts' is done before
      -- 'parsePragmasIntoDynFlags', because otherwise we might enable an
      -- extension that was explicitly disabled in the file.
      let baseFlags :: DynFlags
    baseFlags =
            GeneralFlag -> DynFlags -> DynFlags
    GHC.setGeneralFlag'
              GeneralFlag
    GHC.Opt_Haddock
              (DynFlags -> DynFlags
    setDefaultExts DynFlags
    baseDynFlags)
          extraOpts :: [Located String]
    extraOpts = DynOption -> Located String
    dynOptionToLocatedStr (DynOption -> Located String) -> [DynOption] -> [Located String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [DynOption]
    cfgDynOptions
      ([Warn]
    warnings, DynFlags
    dynFlags) <-
        DynFlags
    -> [Located String]
    -> String
    -> Text
    -> IO (Either String ([Warn], DynFlags))
    parsePragmasIntoDynFlags DynFlags
    baseFlags [Located String]
    extraOpts String
    path Text
    rawInput IO (Either String ([Warn], DynFlags))
    -> (Either String ([Warn], DynFlags) -> IO ([Warn], DynFlags))
    -> IO ([Warn], DynFlags)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          Right ([Warn], DynFlags)
    res -> ([Warn], DynFlags) -> IO ([Warn], DynFlags)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Warn], DynFlags)
    res
          Left String
    err ->
            let loc :: SrcSpan
    loc =
                  SrcLoc -> SrcLoc -> SrcSpan
    mkSrcSpan
                    (FastString -> Int -> Int -> SrcLoc
    mkSrcLoc (String -> FastString
    GHC.mkFastString String
    path) Int
    1 Int
    1)
                    (FastString -> Int -> Int -> SrcLoc
    mkSrcLoc (String -> FastString
    GHC.mkFastString String
    path) Int
    1 Int
    1)
             in OrmoluException -> IO ([Warn], DynFlags)
    forall e a. Exception e => e -> IO a
    throwIO (SrcSpan -> String -> OrmoluException
    OrmoluParsingFailed SrcSpan
    loc String
    err)
      let cppEnabled :: Bool
    cppEnabled = Extension -> EnumSet Extension -> Bool
    forall a. Enum a => a -> EnumSet a -> Bool
    EnumSet.member Extension
    Cpp (DynFlags -> EnumSet Extension
    GHC.extensionFlags DynFlags
    dynFlags)
      Either (SrcSpan, String) [SourceSnippet]
    snippets <- ExceptT (SrcSpan, String) IO [SourceSnippet]
    -> IO (Either (SrcSpan, String) [SourceSnippet])
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT (SrcSpan, String) IO [SourceSnippet]
     -> IO (Either (SrcSpan, String) [SourceSnippet]))
    -> ((Either Text RegionDeltas
         -> ExceptT (SrcSpan, String) IO SourceSnippet)
        -> ExceptT (SrcSpan, String) IO [SourceSnippet])
    -> (Either Text RegionDeltas
        -> ExceptT (SrcSpan, String) IO SourceSnippet)
    -> IO (Either (SrcSpan, String) [SourceSnippet])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Either Text RegionDeltas]
    -> (Either Text RegionDeltas
        -> ExceptT (SrcSpan, String) IO SourceSnippet)
    -> ExceptT (SrcSpan, String) IO [SourceSnippet]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM (Bool -> RegionDeltas -> Text -> [Either Text RegionDeltas]
    preprocess Bool
    cppEnabled RegionDeltas
    cfgRegion Text
    rawInput) ((Either Text RegionDeltas
      -> ExceptT (SrcSpan, String) IO SourceSnippet)
     -> IO (Either (SrcSpan, String) [SourceSnippet]))
    -> (Either Text RegionDeltas
        -> ExceptT (SrcSpan, String) IO SourceSnippet)
    -> IO (Either (SrcSpan, String) [SourceSnippet])
    forall a b. (a -> b) -> a -> b
    $ \case
        Right RegionDeltas
    region ->
          (ParseResult -> SourceSnippet)
    -> ExceptT (SrcSpan, String) IO ParseResult
    -> ExceptT (SrcSpan, String) IO SourceSnippet
    forall a b.
    (a -> b)
    -> ExceptT (SrcSpan, String) IO a -> ExceptT (SrcSpan, String) IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ParseResult -> SourceSnippet
    ParsedSnippet (ExceptT (SrcSpan, String) IO ParseResult
     -> ExceptT (SrcSpan, String) IO SourceSnippet)
    -> (IO (Either (SrcSpan, String) ParseResult)
        -> ExceptT (SrcSpan, String) IO ParseResult)
    -> IO (Either (SrcSpan, String) ParseResult)
    -> ExceptT (SrcSpan, String) IO SourceSnippet
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (Either (SrcSpan, String) ParseResult)
    -> ExceptT (SrcSpan, String) IO ParseResult
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (IO (Either (SrcSpan, String) ParseResult)
     -> ExceptT (SrcSpan, String) IO SourceSnippet)
    -> IO (Either (SrcSpan, String) ParseResult)
    -> ExceptT (SrcSpan, String) IO SourceSnippet
    forall a b. (a -> b) -> a -> b
    $
            Config RegionDeltas
    -> LazyFixityMap
    -> DynFlags
    -> String
    -> Text
    -> IO (Either (SrcSpan, String) ParseResult)
    forall (m :: * -> *).
    MonadIO m =>
    Config RegionDeltas
    -> LazyFixityMap
    -> DynFlags
    -> String
    -> Text
    -> m (Either (SrcSpan, String) ParseResult)
    parseModuleSnippet (Config RegionDeltas
    config Config RegionDeltas -> RegionDeltas -> Config RegionDeltas
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> RegionDeltas
    region) LazyFixityMap
    fixityMap DynFlags
    dynFlags String
    path Text
    rawInput
        Left Text
    raw -> SourceSnippet -> ExceptT (SrcSpan, String) IO SourceSnippet
    forall a. a -> ExceptT (SrcSpan, String) IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SourceSnippet -> ExceptT (SrcSpan, String) IO SourceSnippet)
    -> SourceSnippet -> ExceptT (SrcSpan, String) IO SourceSnippet
    forall a b. (a -> b) -> a -> b
    $ Text -> SourceSnippet
    RawSnippet Text
    raw
      ([Warn], Either (SrcSpan, String) [SourceSnippet])
    -> IO ([Warn], Either (SrcSpan, String) [SourceSnippet])
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Warn]
    warnings, Either (SrcSpan, String) [SourceSnippet]
    snippets)

    parseModuleSnippet ::
      (MonadIO m) =>
      Config RegionDeltas ->
      LazyFixityMap ->
      DynFlags ->
      FilePath ->
      Text ->
      m (Either (SrcSpan, String) ParseResult)
    parseModuleSnippet :: forall (m :: * -> *).
    MonadIO m =>
    Config RegionDeltas
    -> LazyFixityMap
    -> DynFlags
    -> String
    -> Text
    -> m (Either (SrcSpan, String) ParseResult)
    parseModuleSnippet Config {Bool
    [DynOption]
    Set PackageName
    FixityMap
    ColorMode
    RegionDeltas
    SourceType
    cfgDynOptions :: forall region. Config region -> [DynOption]
    cfgFixityOverrides :: forall region. Config region -> FixityMap
    cfgDependencies :: forall region. Config region -> Set PackageName
    cfgUnsafe :: forall region. Config region -> Bool
    cfgDebug :: forall region. Config region -> Bool
    cfgCheckIdempotence :: forall region. Config region -> Bool
    cfgSourceType :: forall region. Config region -> SourceType
    cfgColorMode :: forall region. Config region -> ColorMode
    cfgRegion :: forall region. Config region -> region
    cfgDynOptions :: [DynOption]
    cfgFixityOverrides :: FixityMap
    cfgDependencies :: Set PackageName
    cfgUnsafe :: Bool
    cfgDebug :: Bool
    cfgCheckIdempotence :: Bool
    cfgSourceType :: SourceType
    cfgColorMode :: ColorMode
    cfgRegion :: RegionDeltas
    ..} LazyFixityMap
    fixityMap DynFlags
    dynFlags String
    path Text
    rawInput = IO (Either (SrcSpan, String) ParseResult)
    -> m (Either (SrcSpan, String) ParseResult)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either (SrcSpan, String) ParseResult)
     -> m (Either (SrcSpan, String) ParseResult))
    -> IO (Either (SrcSpan, String) ParseResult)
    -> m (Either (SrcSpan, String) ParseResult)
    forall a b. (a -> b) -> a -> b
    $ do
      let (Text
    input, Int
    indent) = Text -> (Text, Int)
    removeIndentation (Text -> (Text, Int)) -> (Text -> Text) -> Text -> (Text, Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RegionDeltas -> Text -> Text
    linesInRegion RegionDeltas
    cfgRegion (Text -> (Text, Int)) -> Text -> (Text, Int)
    forall a b. (a -> b) -> a -> b
    $ Text
    rawInput
      let pStateErrors :: PState -> Maybe (SrcSpan, String)
    pStateErrors PState
    pstate =
            let errs :: [MsgEnvelope PsMessage]
    errs = Bag (MsgEnvelope PsMessage) -> [MsgEnvelope PsMessage]
    forall a. Bag a -> [a]
    bagToList (Bag (MsgEnvelope PsMessage) -> [MsgEnvelope PsMessage])
    -> (Messages PsMessage -> Bag (MsgEnvelope PsMessage))
    -> Messages PsMessage
    -> [MsgEnvelope PsMessage]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Messages PsMessage -> Bag (MsgEnvelope PsMessage)
    forall e. Messages e -> Bag (MsgEnvelope e)
    getMessages (Messages PsMessage -> [MsgEnvelope PsMessage])
    -> Messages PsMessage -> [MsgEnvelope PsMessage]
    forall a b. (a -> b) -> a -> b
    $ PState -> Messages PsMessage
    GHC.getPsErrorMessages PState
    pstate
                fixupErrSpan :: SrcSpan -> SrcSpan
    fixupErrSpan = Int -> SrcSpan -> SrcSpan
    incSpanLine (RegionDeltas -> Int
    regionPrefixLength RegionDeltas
    cfgRegion)
                rateSeverity :: Severity -> Int
    rateSeverity = \case
                  Severity
    SevError -> Int
    1 :: Int
                  Severity
    SevWarning -> Int
    2
                  Severity
    SevIgnore -> Int
    3
                showErr :: MsgEnvelope PsMessage -> String
    showErr =
                  SDoc -> String
    forall o. Outputable o => o -> String
    showOutputable
                    (SDoc -> String)
    -> (MsgEnvelope PsMessage -> SDoc)
    -> MsgEnvelope PsMessage
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDocContext -> DecoratedSDoc -> SDoc
    formatBulleted SDocContext
    defaultSDocContext
                    (DecoratedSDoc -> SDoc)
    -> (MsgEnvelope PsMessage -> DecoratedSDoc)
    -> MsgEnvelope PsMessage
    -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PsMessage -> DecoratedSDoc
    forall a. Diagnostic a => a -> DecoratedSDoc
    diagnosticMessage
                    (PsMessage -> DecoratedSDoc)
    -> (MsgEnvelope PsMessage -> PsMessage)
    -> MsgEnvelope PsMessage
    -> DecoratedSDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MsgEnvelope PsMessage -> PsMessage
    forall e. MsgEnvelope e -> e
    errMsgDiagnostic
             in case (MsgEnvelope PsMessage -> Int)
    -> [MsgEnvelope PsMessage] -> [MsgEnvelope PsMessage]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    L.sortOn (Severity -> Int
    rateSeverity (Severity -> Int)
    -> (MsgEnvelope PsMessage -> Severity)
    -> MsgEnvelope PsMessage
    -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MsgEnvelope PsMessage -> Severity
    forall e. MsgEnvelope e -> Severity
    errMsgSeverity) [MsgEnvelope PsMessage]
    errs of
                  [] -> Maybe (SrcSpan, String)
    forall a. Maybe a
    Nothing
                  MsgEnvelope PsMessage
    err : [MsgEnvelope PsMessage]
    _ ->
                    -- Show instance returns a short error message
                    (SrcSpan, String) -> Maybe (SrcSpan, String)
    forall a. a -> Maybe a
    Just (SrcSpan -> SrcSpan
    fixupErrSpan (MsgEnvelope PsMessage -> SrcSpan
    forall e. MsgEnvelope e -> SrcSpan
    errMsgSpan MsgEnvelope PsMessage
    err), MsgEnvelope PsMessage -> String
    showErr MsgEnvelope PsMessage
    err)
          parser :: P (Located HsModule)
    parser = case SourceType
    cfgSourceType of
            SourceType
    ModuleSource -> P (Located HsModule)
    GHC.parseModule
            SourceType
    SignatureSource -> P (Located HsModule)
    GHC.parseSignature
          r :: Either (SrcSpan, String) ParseResult
    r = case P (Located HsModule)
    -> DynFlags -> String -> Text -> ParseResult (Located HsModule)
    forall a. P a -> DynFlags -> String -> Text -> ParseResult a
    runParser P (Located HsModule)
    parser DynFlags
    dynFlags String
    path Text
    input of
            GHC.PFailed PState
    pstate ->
              case PState -> Maybe (SrcSpan, String)
    pStateErrors PState
    pstate of
                Just (SrcSpan, String)
    err -> (SrcSpan, String) -> Either (SrcSpan, String) ParseResult
    forall a b. a -> Either a b
    Left (SrcSpan, String)
    err
                Maybe (SrcSpan, String)
    Nothing -> String -> Either (SrcSpan, String) ParseResult
    forall a. HasCallStack => String -> a
    error String
    "PFailed does not have an error"
            GHC.POk PState
    pstate (L SrcSpan
    _ (HsModule -> HsModule
    normalizeModule -> HsModule
    hsModule)) ->
              case PState -> Maybe (SrcSpan, String)
    pStateErrors PState
    pstate of
                -- Some parse errors (pattern/arrow syntax in expr context)
                -- do not cause a parse error, but they are replaced with "_"
                -- by the parser and the modified AST is propagated to the
                -- later stages; but we fail in those cases.
                Just (SrcSpan, String)
    err -> (SrcSpan, String) -> Either (SrcSpan, String) ParseResult
    forall a b. a -> Either a b
    Left (SrcSpan, String)
    err
                Maybe (SrcSpan, String)
    Nothing ->
                  let (Maybe (RealLocated Comment)
    stackHeader, [([RealLocated Comment], Pragma)]
    pragmas, CommentStream
    comments) =
                        Text
    -> HsModule
    -> (Maybe (RealLocated Comment), [([RealLocated Comment], Pragma)],
        CommentStream)
    mkCommentStream Text
    input HsModule
    hsModule
                   in ParseResult -> Either (SrcSpan, String) ParseResult
    forall a b. b -> Either a b
    Right
                        ParseResult
                          { prParsedSource :: HsModule
    prParsedSource = HsModule
    hsModule,
                            prSourceType :: SourceType
    prSourceType = SourceType
    cfgSourceType,
                            prStackHeader :: Maybe (RealLocated Comment)
    prStackHeader = Maybe (RealLocated Comment)
    stackHeader,
                            prPragmas :: [([RealLocated Comment], Pragma)]
    prPragmas = [([RealLocated Comment], Pragma)]
    pragmas,
                            prCommentStream :: CommentStream
    prCommentStream = CommentStream
    comments,
                            prExtensions :: EnumSet Extension
    prExtensions = DynFlags -> EnumSet Extension
    GHC.extensionFlags DynFlags
    dynFlags,
                            prFixityOverrides :: FixityMap
    prFixityOverrides = FixityMap
    cfgFixityOverrides,
                            prFixityMap :: LazyFixityMap
    prFixityMap = LazyFixityMap
    fixityMap,
                            prIndent :: Int
    prIndent = Int
    indent
                          }
      Either (SrcSpan, String) ParseResult
    -> IO (Either (SrcSpan, String) ParseResult)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either (SrcSpan, String) ParseResult
    r

    -- | Normalize a 'HsModule' by sorting its import\/export lists, dropping
    -- blank comments, etc.
    normalizeModule :: HsModule -> HsModule
    normalizeModule :: HsModule -> HsModule
    normalizeModule HsModule
    hsmod =
      (forall a. Data a => a -> a) -> forall a. Data a => a -> a
    everywhere
        ((a -> a)
    -> (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
        -> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
    -> a
    -> a
    forall a b.
    (Typeable a, Typeable b) =>
    (a -> a) -> (b -> b) -> a -> a
    extT ((GenLocated SrcSpanAnnA (HsType GhcPs)
     -> GenLocated SrcSpanAnnA (HsType GhcPs))
    -> a -> a
    forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
    mkT GenLocated SrcSpanAnnA (HsType GhcPs)
    -> GenLocated SrcSpanAnnA (HsType GhcPs)
    dropBlankTypeHaddocks) GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
    -> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
    LHsContext GhcPs -> LHsContext GhcPs
    patchContext)
        HsModule
    hsmod
          { hsmodImports :: [LImportDecl GhcPs]
    hsmodImports =
              [LImportDecl GhcPs] -> [LImportDecl GhcPs]
    normalizeImports (HsModule -> [LImportDecl GhcPs]
    hsmodImports HsModule
    hsmod),
            hsmodDecls :: [LHsDecl GhcPs]
    hsmodDecls =
              (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Bool)
    -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Bool)
    -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsDecl GhcPs -> Bool
    forall {pass}. HsDecl pass -> Bool
    isBlankDocD (HsDecl GhcPs -> Bool)
    -> (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> HsDecl GhcPs)
    -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA (HsDecl GhcPs) -> HsDecl GhcPs
    forall l e. GenLocated l e -> e
    unLoc) (HsModule -> [LHsDecl GhcPs]
    hsmodDecls HsModule
    hsmod),
            hsmodHaddockModHeader :: Maybe (LHsDoc GhcPs)
    hsmodHaddockModHeader =
              (LHsDoc GhcPs -> Bool)
    -> Maybe (LHsDoc GhcPs) -> Maybe (LHsDoc GhcPs)
    forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
    mfilter (Bool -> Bool
    not (Bool -> Bool) -> (LHsDoc GhcPs -> Bool) -> LHsDoc GhcPs -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHsDoc GhcPs -> Bool
    forall {l} {pass}.
    GenLocated l (WithHsDocIdentifiers HsDocString pass) -> Bool
    isBlankDocString) (HsModule -> Maybe (LHsDoc GhcPs)
    hsmodHaddockModHeader HsModule
    hsmod),
            hsmodExports :: Maybe (LocatedL [LIE GhcPs])
    hsmodExports =
              ((GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
     -> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
    -> Maybe
         (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
    -> Maybe
         (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
      -> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
     -> Maybe
          (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
     -> Maybe
          (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
    -> (([GenLocated SrcSpanAnnA (IE GhcPs)]
         -> [GenLocated SrcSpanAnnA (IE GhcPs)])
        -> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
        -> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
    -> ([GenLocated SrcSpanAnnA (IE GhcPs)]
        -> [GenLocated SrcSpanAnnA (IE GhcPs)])
    -> Maybe
         (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
    -> Maybe
         (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([GenLocated SrcSpanAnnA (IE GhcPs)]
     -> [GenLocated SrcSpanAnnA (IE GhcPs)])
    -> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
    -> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
    forall a b.
    (a -> b) -> GenLocated SrcSpanAnnL a -> GenLocated SrcSpanAnnL b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) ((GenLocated SrcSpanAnnA (IE GhcPs) -> Bool)
    -> [GenLocated SrcSpanAnnA (IE GhcPs)]
    -> [GenLocated SrcSpanAnnA (IE GhcPs)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> (GenLocated SrcSpanAnnA (IE GhcPs) -> Bool)
    -> GenLocated SrcSpanAnnA (IE GhcPs)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IE GhcPs -> Bool
    forall {pass}. IE pass -> Bool
    isBlankDocIE (IE GhcPs -> Bool)
    -> (GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs)
    -> GenLocated SrcSpanAnnA (IE GhcPs)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
    forall l e. GenLocated l e -> e
    unLoc)) (HsModule -> Maybe (LocatedL [LIE GhcPs])
    hsmodExports HsModule
    hsmod)
          }
      where
        isBlankDocString :: GenLocated l (WithHsDocIdentifiers HsDocString pass) -> Bool
    isBlankDocString = (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace (String -> Bool)
    -> (GenLocated l (WithHsDocIdentifiers HsDocString pass) -> String)
    -> GenLocated l (WithHsDocIdentifiers HsDocString pass)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsDocString -> String
    renderHsDocString (HsDocString -> String)
    -> (GenLocated l (WithHsDocIdentifiers HsDocString pass)
        -> HsDocString)
    -> GenLocated l (WithHsDocIdentifiers HsDocString pass)
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WithHsDocIdentifiers HsDocString pass -> HsDocString
    forall a pass. WithHsDocIdentifiers a pass -> a
    hsDocString (WithHsDocIdentifiers HsDocString pass -> HsDocString)
    -> (GenLocated l (WithHsDocIdentifiers HsDocString pass)
        -> WithHsDocIdentifiers HsDocString pass)
    -> GenLocated l (WithHsDocIdentifiers HsDocString pass)
    -> HsDocString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated l (WithHsDocIdentifiers HsDocString pass)
    -> WithHsDocIdentifiers HsDocString pass
    forall l e. GenLocated l e -> e
    unLoc
        isBlankDocD :: HsDecl pass -> Bool
    isBlankDocD = \case
          DocD XDocD pass
    _ DocDecl pass
    s -> GenLocated SrcSpan (WithHsDocIdentifiers HsDocString pass) -> Bool
    forall {l} {pass}.
    GenLocated l (WithHsDocIdentifiers HsDocString pass) -> Bool
    isBlankDocString (GenLocated SrcSpan (WithHsDocIdentifiers HsDocString pass)
     -> Bool)
    -> GenLocated SrcSpan (WithHsDocIdentifiers HsDocString pass)
    -> Bool
    forall a b. (a -> b) -> a -> b
    $ DocDecl pass
    -> GenLocated SrcSpan (WithHsDocIdentifiers HsDocString pass)
    forall pass. DocDecl pass -> LHsDoc pass
    docDeclDoc DocDecl pass
    s
          HsDecl pass
    _ -> Bool
    False
        isBlankDocIE :: IE pass -> Bool
    isBlankDocIE = \case
          IEGroup XIEGroup pass
    _ Int
    _ LHsDoc pass
    s -> LHsDoc pass -> Bool
    forall {l} {pass}.
    GenLocated l (WithHsDocIdentifiers HsDocString pass) -> Bool
    isBlankDocString LHsDoc pass
    s
          IEDoc XIEDoc pass
    _ LHsDoc pass
    s -> LHsDoc pass -> Bool
    forall {l} {pass}.
    GenLocated l (WithHsDocIdentifiers HsDocString pass) -> Bool
    isBlankDocString LHsDoc pass
    s
          IE pass
    _ -> Bool
    False
        dropBlankTypeHaddocks :: LHsType GhcPs -> LHsType GhcPs
    dropBlankTypeHaddocks = \case
          L SrcSpanAnnA
    _ (HsDocTy XDocTy GhcPs
    _ LHsType GhcPs
    ty LHsDoc GhcPs
    s) :: LHsType GhcPs
            | LHsDoc GhcPs -> Bool
    forall {l} {pass}.
    GenLocated l (WithHsDocIdentifiers HsDocString pass) -> Bool
    isBlankDocString LHsDoc GhcPs
    s -> LHsType GhcPs
    ty
          LHsType GhcPs
    a -> LHsType GhcPs
    a
        patchContext :: LHsContext GhcPs -> LHsContext GhcPs
        patchContext :: LHsContext GhcPs -> LHsContext GhcPs
    patchContext = ([GenLocated SrcSpanAnnA (HsType GhcPs)]
     -> [GenLocated SrcSpanAnnA (HsType GhcPs)])
    -> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
    -> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
    forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
    mapLoc (([GenLocated SrcSpanAnnA (HsType GhcPs)]
      -> [GenLocated SrcSpanAnnA (HsType GhcPs)])
     -> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
     -> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
    -> ([GenLocated SrcSpanAnnA (HsType GhcPs)]
        -> [GenLocated SrcSpanAnnA (HsType GhcPs)])
    -> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
    -> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
    forall a b. (a -> b) -> a -> b
    $ \case
          [x :: GenLocated SrcSpanAnnA (HsType GhcPs)
    x@(L SrcSpanAnnA
    _ (HsParTy XParTy GhcPs
    _ LHsType GhcPs
    _))] -> [GenLocated SrcSpanAnnA (HsType GhcPs)
    x]
          [x :: GenLocated SrcSpanAnnA (HsType GhcPs)
    x@(L SrcSpanAnnA
    lx HsType GhcPs
    _)] -> [SrcSpanAnnA
    -> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    lx (XParTy GhcPs -> LHsType GhcPs -> HsType GhcPs
    forall pass. XParTy pass -> LHsType pass -> HsType pass
    HsParTy XParTy GhcPs
    EpAnn AnnParen
    forall ann. EpAnn ann
    EpAnnNotUsed GenLocated SrcSpanAnnA (HsType GhcPs)
    LHsType GhcPs
    x)]
          [GenLocated SrcSpanAnnA (HsType GhcPs)]
    xs -> [GenLocated SrcSpanAnnA (HsType GhcPs)]
    xs

    -- | Enable all language extensions that we think should be enabled by
    -- default for ease of use.
    setDefaultExts :: DynFlags -> DynFlags
    setDefaultExts :: DynFlags -> DynFlags
    setDefaultExts DynFlags
    flags = (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
    L.foldl' DynFlags -> Extension -> DynFlags
    xopt_set (DynFlags -> Maybe Language -> DynFlags
    lang_set DynFlags
    flags (Language -> Maybe Language
    forall a. a -> Maybe a
    Just Language
    Haskell2010)) [Extension]
    autoExts
      where
        autoExts :: [Extension]
    autoExts = [Extension]
    allExts [Extension] -> [Extension] -> [Extension]
    forall a. Eq a => [a] -> [a] -> [a]
    L.\\ [Extension]
    manualExts
        allExts :: [Extension]
    allExts = [Extension
    forall a. Bounded a => a
    minBound .. Extension
    forall a. Bounded a => a
    maxBound]

    -- | Extensions that are not enabled automatically and should be activated
    -- by user.
    manualExts :: [Extension]
    manualExts :: [Extension]
    manualExts =
      [ Extension
    Arrows, -- steals proc
        Extension
    Cpp, -- forbidden
        Extension
    BangPatterns, -- makes certain patterns with ! fail
        Extension
    PatternSynonyms, -- steals the pattern keyword
        Extension
    RecursiveDo, -- steals the rec keyword
        Extension
    StaticPointers, -- steals static keyword
        Extension
    TransformListComp, -- steals the group keyword
        Extension
    UnboxedTuples, -- breaks (#) lens operator
        Extension
    MagicHash, -- screws {-# these things #-}
        Extension
    AlternativeLayoutRule,
        Extension
    AlternativeLayoutRuleTransitional,
        Extension
    MonadComprehensions,
        Extension
    UnboxedSums,
        Extension
    UnicodeSyntax, -- gives special meanings to operators like (→)
        Extension
    TemplateHaskell, -- changes how $foo is parsed
        Extension
    TemplateHaskellQuotes, -- enables TH subset of quasi-quotes, this
        -- apparently interferes with QuasiQuotes in
        -- weird ways
        Extension
    ImportQualifiedPost, -- affects how Ormolu renders imports, so the
        -- decision of enabling this style is left to the user
        Extension
    NegativeLiterals, -- with this, `- 1` and `-1` have differing AST
        Extension
    LexicalNegation, -- implies NegativeLiterals
        Extension
    LinearTypes, -- steals the (%) type operator in some cases
        Extension
    OverloadedRecordDot, -- f.g parses differently
        Extension
    OverloadedRecordUpdate -- qualified fields are not supported
      ]

    -- | Run a 'GHC.P' computation.
    runParser ::
      -- | Computation to run
      GHC.P a ->
      -- | Dynamic flags
      GHC.DynFlags ->
      -- | Module path
      FilePath ->
      -- | Module contents
      Text ->
      -- | Parse result
      GHC.ParseResult a
    runParser :: forall a. P a -> DynFlags -> String -> Text -> ParseResult a
    runParser P a
    parser DynFlags
    flags String
    filename Text
    input = P a -> PState -> ParseResult a
    forall a. P a -> PState -> ParseResult a
    GHC.unP P a
    parser PState
    parseState
      where
        location :: RealSrcLoc
    location = FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc (String -> FastString
    GHC.mkFastString String
    filename) Int
    1 Int
    1
        buffer :: StringBuffer
    buffer = Text -> StringBuffer
    textToStringBuffer Text
    input
        parseState :: PState
    parseState = ParserOpts -> StringBuffer -> RealSrcLoc -> PState
    GHC.initParserState (DynFlags -> ParserOpts
    initParserOpts DynFlags
    flags) StringBuffer
    buffer RealSrcLoc
    location

    ----------------------------------------------------------------------------
    -- Helpers taken from HLint

    parsePragmasIntoDynFlags ::
      -- | Pre-set 'DynFlags'
      DynFlags ->
      -- | Extra options (provided by user)
      [Located String] ->
      -- | File name (only for source location annotations)
      FilePath ->
      -- | Input for parser
      Text ->
      IO (Either String ([GHC.Warn], DynFlags))
    parsePragmasIntoDynFlags :: DynFlags
    -> [Located String]
    -> String
    -> Text
    -> IO (Either String ([Warn], DynFlags))
    parsePragmasIntoDynFlags DynFlags
    flags [Located String]
    extraOpts String
    filepath Text
    str =
      IO (Either String ([Warn], DynFlags))
    -> IO (Either String ([Warn], DynFlags))
    forall {m :: * -> *} {b}.
    (MonadMask m, MonadIO m) =>
    m (Either String b) -> m (Either String b)
    catchErrors (IO (Either String ([Warn], DynFlags))
     -> IO (Either String ([Warn], DynFlags)))
    -> IO (Either String ([Warn], DynFlags))
    -> IO (Either String ([Warn], DynFlags))
    forall a b. (a -> b) -> a -> b
    $ do
        let (Messages PsMessage
    _warnings, [Located String]
    fileOpts) =
              ParserOpts
    -> StringBuffer -> String -> (Messages PsMessage, [Located String])
    GHC.getOptions
                (DynFlags -> ParserOpts
    initParserOpts DynFlags
    flags)
                (Text -> StringBuffer
    textToStringBuffer Text
    str)
                String
    filepath
        (DynFlags
    flags', [Located String]
    leftovers, [Warn]
    warnings) <-
          DynFlags
    -> [Located String] -> IO (DynFlags, [Located String], [Warn])
    forall (m :: * -> *).
    MonadIO m =>
    DynFlags
    -> [Located String] -> m (DynFlags, [Located String], [Warn])
    parseDynamicFilePragma DynFlags
    flags ([Located String]
    extraOpts [Located String] -> [Located String] -> [Located String]
    forall a. Semigroup a => a -> a -> a
    <> [Located String]
    fileOpts)
        case [Located String] -> Maybe (NonEmpty (Located String))
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty [Located String]
    leftovers of
          Maybe (NonEmpty (Located String))
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          Just NonEmpty (Located String)
    unrecognizedOpts ->
            OrmoluException -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO (NonEmpty String -> OrmoluException
    OrmoluUnrecognizedOpts (Located String -> String
    forall l e. GenLocated l e -> e
    unLoc (Located String -> String)
    -> NonEmpty (Located String) -> NonEmpty String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NonEmpty (Located String)
    unrecognizedOpts))
        let flags'' :: DynFlags
    flags'' = DynFlags
    flags' DynFlags -> GeneralFlag -> DynFlags
    `gopt_set` GeneralFlag
    Opt_KeepRawTokenStream
        Either String ([Warn], DynFlags)
    -> IO (Either String ([Warn], DynFlags))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String ([Warn], DynFlags)
     -> IO (Either String ([Warn], DynFlags)))
    -> Either String ([Warn], DynFlags)
    -> IO (Either String ([Warn], DynFlags))
    forall a b. (a -> b) -> a -> b
    $ ([Warn], DynFlags) -> Either String ([Warn], DynFlags)
    forall a b. b -> Either a b
    Right ([Warn]
    warnings, DynFlags
    flags'')
      where
        catchErrors :: m (Either String b) -> m (Either String b)
    catchErrors m (Either String b)
    act =
          (GhcException -> m (Either String b))
    -> m (Either String b) -> m (Either String b)
    forall (m :: * -> *) a.
    ExceptionMonad m =>
    (GhcException -> m a) -> m a -> m a
    GHC.handleGhcException
            GhcException -> m (Either String b)
    forall {m :: * -> *} {a} {b}.
    (Monad m, Show a) =>
    a -> m (Either String b)
    reportErr
            ((SourceError -> m (Either String b))
    -> m (Either String b) -> m (Either String b)
    forall (m :: * -> *) a.
    MonadCatch m =>
    (SourceError -> m a) -> m a -> m a
    GHC.handleSourceError SourceError -> m (Either String b)
    forall {m :: * -> *} {a} {b}.
    (Monad m, Show a) =>
    a -> m (Either String b)
    reportErr m (Either String b)
    act)
        reportErr :: a -> m (Either String b)
    reportErr a
    e = Either String b -> m (Either String b)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String b -> m (Either String b))
    -> Either String b -> m (Either String b)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String b
    forall a b. a -> Either a b
    Left (a -> String
    forall a. Show a => a -> String
    show a
    e)