module Hint.GHC (
dynamicGhc,
Message,
Logger,
initLogger,
putLogMsg,
pushLogHook,
modifyLogger,
UnitState,
emptyUnitState,
showSDocForUser,
ParserOpts,
mkParserOpts,
initParserState,
getErrorMessages,
pprErrorMessages,
SDocContext,
defaultSDocContext,
showGhcException,
addWay,
setBackendToInterpreter,
parseDynamicFlags,
module X,
) where
import GHC as X hiding (Phase, GhcT, parseDynamicFlags, runGhcT, showGhcException
#if MIN_VERSION_ghc(9,2,0)
, Logger
, modifyLogger
, pushLogHook
#endif
)
import Control.Monad.Ghc as X (GhcT, runGhcT)
#if MIN_VERSION_ghc(9,2,0)
import GHC.Types.SourceError as X (SourceError, srcErrorMessages)
import GHC.Driver.Ppr as X (showSDoc)
import GHC.Types.SourceFile as X (HscSource(HsSrcFile))
import GHC.Utils.Logger as X (LogAction)
import GHC.Platform.Ways as X (Way (..))
import GHC.Types.TyThing.Ppr as X (pprTypeForUser)
#elif MIN_VERSION_ghc(9,0,0)
import GHC.Driver.Types as X (SourceError, srcErrorMessages, GhcApiError)
import GHC.Utils.Outputable as X (showSDoc)
import GHC.Driver.Phases as X (HscSource(HsSrcFile))
import GHC.Driver.Session as X (LogAction, addWay')
import GHC.Driver.Ways as X (Way (..))
import GHC.Core.Ppr.TyThing as X (pprTypeForUser)
#else
import HscTypes as X (SourceError, srcErrorMessages, GhcApiError)
import Outputable as X (showSDoc)
import DriverPhases as X (HscSource(HsSrcFile))
import DynFlags as X (LogAction, addWay', Way(..))
import PprTyThing as X (pprTypeForUser)
#endif
#if MIN_VERSION_ghc(9,0,0)
import GHC.Utils.Outputable as X (PprStyle, SDoc, Outputable(ppr),
withPprStyle, defaultErrStyle, vcat)
import GHC.Utils.Error as X (mkLocMessage, errMsgSpan)
import GHC.Driver.Phases as X (Phase(Cpp))
import GHC.Data.StringBuffer as X (stringToStringBuffer)
import GHC.Parser.Lexer as X (P(..), ParseResult(..))
import GHC.Parser as X (parseStmt, parseType)
import GHC.Data.FastString as X (fsLit)
import GHC.Driver.Session as X (xFlags, xopt, FlagSpec(..), WarnReason(NoReason))
import GHC.Types.SrcLoc as X (combineSrcSpans, mkRealSrcLoc)
import GHC.Core.ConLike as X (ConLike(RealDataCon))
#else
import HscTypes as X (mgModSummaries)
import Outputable as X (PprStyle, SDoc, Outputable(ppr),
withPprStyle, defaultErrStyle, vcat)
import ErrUtils as X (mkLocMessage, errMsgSpan)
import DriverPhases as X (Phase(Cpp))
import StringBuffer as X (stringToStringBuffer)
import Lexer as X (P(..), ParseResult(..), mkPState)
import Parser as X (parseStmt, parseType)
import FastString as X (fsLit)
import DynFlags as X (xFlags, xopt, FlagSpec(..), WarnReason(NoReason))
import SrcLoc as X (combineSrcSpans, mkRealSrcLoc)
import ConLike as X (ConLike(RealDataCon))
#endif
import Control.Monad.IO.Class (MonadIO)
#if MIN_VERSION_ghc(9,2,0)
import GHC.Platform.Ways (hostIsDynamic)
import qualified GHC.Utils.Logger as GHC (Logger, initLogger, putLogMsg, pushLogHook)
import qualified GHC.Driver.Monad as GHC (modifyLogger)
import qualified GHC.Unit.State as GHC (UnitState, emptyUnitState)
import qualified GHC.Driver.Ppr as GHC (showSDocForUser)
import qualified GHC.Parser.Lexer as GHC (PState, ParserOpts, mkParserOpts, initParserState)
import GHC.Data.StringBuffer (StringBuffer)
import qualified GHC.Driver.Session as DynFlags (warningFlags, extensionFlags, safeImportsOn)
import qualified GHC.Parser.Errors.Ppr as GHC (pprError)
import qualified GHC.Parser.Lexer as GHC (getErrorMessages)
import qualified GHC.Types.Error as GHC (ErrorMessages, errMsgDiagnostic, unDecorated)
import GHC.Data.Bag (bagToList)
import qualified GHC (showGhcException)
import qualified GHC.Utils.Outputable as GHC (SDocContext, defaultSDocContext)
import qualified GHC.Driver.Session as DynFlags (targetWays_)
import qualified Data.Set as Set
import qualified GHC (parseDynamicFlags)
import GHC.Driver.CmdLine (Warn)
#elif MIN_VERSION_ghc(9,0,0)
import GHC.Driver.Ways (hostIsDynamic)
import qualified GHC.Utils.Error as GHC (MsgDoc)
import qualified GHC.Driver.Session as GHC (defaultLogAction)
import qualified GHC.Driver.Session as DynFlags (log_action)
import qualified GHC.Utils.Outputable as GHC (showSDocForUser)
import qualified GHC.Parser.Lexer as GHC (PState, ParserFlags, mkParserFlags, mkPStatePure)
import GHC.Data.StringBuffer (StringBuffer)
import qualified GHC.Utils.Error as GHC (ErrorMessages, pprErrMsgBagWithLoc)
import qualified GHC.Parser.Lexer as GHC (getErrorMessages)
import qualified GHC (showGhcException)
import qualified GHC.Driver.Session as GHC (addWay')
import qualified GHC (parseDynamicFlags)
import GHC.Driver.CmdLine (Warn)
#else
import qualified DynFlags as GHC (dynamicGhc)
import qualified ErrUtils as GHC (MsgDoc)
import qualified DynFlags as GHC (defaultLogAction)
import qualified DynFlags (log_action)
import qualified Outputable as GHC (showSDocForUser)
import qualified Lexer as GHC (PState, ParserFlags, mkParserFlags, mkPStatePure)
import StringBuffer (StringBuffer)
import qualified ErrUtils as GHC (ErrorMessages, pprErrMsgBagWithLoc)
#if MIN_VERSION_ghc(8,10,0)
import qualified Lexer as GHC (getErrorMessages)
#else
import Bag (emptyBag)
#endif
import qualified GHC (showGhcException)
import qualified DynFlags as GHC (addWay')
import qualified GHC (parseDynamicFlags)
import CmdLineParser (Warn)
#endif
dynamicGhc :: Bool
#if MIN_VERSION_ghc(9,0,0)
dynamicGhc :: Bool
dynamicGhc = Bool
hostIsDynamic
#else
dynamicGhc = GHC.dynamicGhc
#endif
#if MIN_VERSION_ghc(9,2,0)
type Message = SDoc
#else
type Message = GHC.MsgDoc
#endif
initLogger :: IO Logger
putLogMsg :: Logger -> LogAction
pushLogHook :: (LogAction -> LogAction) -> Logger -> Logger
modifyLogger :: GhcMonad m => (Logger -> Logger) -> m ()
#if MIN_VERSION_ghc(9,2,0)
type Logger = GHC.Logger
initLogger :: IO Logger
initLogger = IO Logger
GHC.initLogger
putLogMsg :: Logger -> LogAction
putLogMsg = Logger -> LogAction
GHC.putLogMsg
pushLogHook :: (LogAction -> LogAction) -> Logger -> Logger
pushLogHook = (LogAction -> LogAction) -> Logger -> Logger
GHC.pushLogHook
modifyLogger :: forall (m :: * -> *). GhcMonad m => (Logger -> Logger) -> m ()
modifyLogger = (Logger -> Logger) -> m ()
forall (m :: * -> *). GhcMonad m => (Logger -> Logger) -> m ()
GHC.modifyLogger
#else
type Logger = LogAction
initLogger = pure GHC.defaultLogAction
putLogMsg = id
pushLogHook = id
modifyLogger f = do
df <- getSessionDynFlags
_ <- setSessionDynFlags df{log_action = f $ DynFlags.log_action df}
return ()
#endif
emptyUnitState :: UnitState
#if MIN_VERSION_ghc(9,2,0)
type UnitState = GHC.UnitState
emptyUnitState :: UnitState
emptyUnitState = UnitState
GHC.emptyUnitState
#else
type UnitState = ()
emptyUnitState = ()
#endif
showSDocForUser :: DynFlags -> UnitState -> PrintUnqualified -> SDoc -> String
#if MIN_VERSION_ghc(9,2,0)
showSDocForUser :: DynFlags -> UnitState -> PrintUnqualified -> SDoc -> String
showSDocForUser = DynFlags -> UnitState -> PrintUnqualified -> SDoc -> String
GHC.showSDocForUser
#else
showSDocForUser df _ = GHC.showSDocForUser df
#endif
mkParserOpts :: DynFlags -> ParserOpts
initParserState :: ParserOpts -> StringBuffer -> RealSrcLoc -> GHC.PState
#if MIN_VERSION_ghc(9,2,0)
type ParserOpts = GHC.ParserOpts
mkParserOpts :: DynFlags -> ParserOpts
mkParserOpts =
EnumSet WarningFlag
-> EnumSet Extension -> Bool -> Bool -> Bool -> Bool -> ParserOpts
GHC.mkParserOpts
(EnumSet WarningFlag
-> EnumSet Extension -> Bool -> Bool -> Bool -> Bool -> ParserOpts)
-> (DynFlags -> EnumSet WarningFlag)
-> DynFlags
-> EnumSet Extension
-> Bool
-> Bool
-> Bool
-> Bool
-> ParserOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> EnumSet WarningFlag
DynFlags.warningFlags
(DynFlags
-> EnumSet Extension -> Bool -> Bool -> Bool -> Bool -> ParserOpts)
-> (DynFlags -> EnumSet Extension)
-> DynFlags
-> Bool
-> Bool
-> Bool
-> Bool
-> ParserOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DynFlags -> EnumSet Extension
DynFlags.extensionFlags
(DynFlags -> Bool -> Bool -> Bool -> Bool -> ParserOpts)
-> (DynFlags -> Bool)
-> DynFlags
-> Bool
-> Bool
-> Bool
-> ParserOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DynFlags -> Bool
DynFlags.safeImportsOn
(DynFlags -> Bool -> Bool -> Bool -> ParserOpts)
-> (DynFlags -> Bool) -> DynFlags -> Bool -> Bool -> ParserOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Haddock
(DynFlags -> Bool -> Bool -> ParserOpts)
-> (DynFlags -> Bool) -> DynFlags -> Bool -> ParserOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_KeepRawTokenStream
(DynFlags -> Bool -> ParserOpts)
-> (DynFlags -> Bool) -> DynFlags -> ParserOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> DynFlags -> Bool
forall a b. a -> b -> a
const Bool
True
initParserState :: ParserOpts -> StringBuffer -> RealSrcLoc -> PState
initParserState = ParserOpts -> StringBuffer -> RealSrcLoc -> PState
GHC.initParserState
#else
type ParserOpts = GHC.ParserFlags
mkParserOpts = GHC.mkParserFlags
initParserState = GHC.mkPStatePure
#endif
getErrorMessages :: GHC.PState -> DynFlags -> GHC.ErrorMessages
pprErrorMessages :: GHC.ErrorMessages -> [SDoc]
#if MIN_VERSION_ghc(9,2,0)
getErrorMessages :: PState -> DynFlags -> ErrorMessages
getErrorMessages PState
pstate DynFlags
_ = (PsError -> MsgEnvelope DecoratedSDoc)
-> Bag PsError -> ErrorMessages
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PsError -> MsgEnvelope DecoratedSDoc
GHC.pprError (Bag PsError -> ErrorMessages) -> Bag PsError -> ErrorMessages
forall a b. (a -> b) -> a -> b
$ PState -> Bag PsError
GHC.getErrorMessages PState
pstate
pprErrorMessages :: ErrorMessages -> [SDoc]
pprErrorMessages = Bag SDoc -> [SDoc]
forall a. Bag a -> [a]
bagToList (Bag SDoc -> [SDoc])
-> (ErrorMessages -> Bag SDoc) -> ErrorMessages -> [SDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MsgEnvelope DecoratedSDoc -> SDoc) -> ErrorMessages -> Bag SDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MsgEnvelope DecoratedSDoc -> SDoc
pprErrorMessage
where
pprErrorMessage :: MsgEnvelope DecoratedSDoc -> SDoc
pprErrorMessage = [SDoc] -> SDoc
vcat ([SDoc] -> SDoc)
-> (MsgEnvelope DecoratedSDoc -> [SDoc])
-> MsgEnvelope DecoratedSDoc
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoratedSDoc -> [SDoc]
GHC.unDecorated (DecoratedSDoc -> [SDoc])
-> (MsgEnvelope DecoratedSDoc -> DecoratedSDoc)
-> MsgEnvelope DecoratedSDoc
-> [SDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgEnvelope DecoratedSDoc -> DecoratedSDoc
forall e. MsgEnvelope e -> e
GHC.errMsgDiagnostic
#elif MIN_VERSION_ghc(8,10,0)
getErrorMessages = GHC.getErrorMessages
pprErrorMessages = GHC.pprErrMsgBagWithLoc
#else
getErrorMessages _ _ = emptyBag
pprErrorMessages = GHC.pprErrMsgBagWithLoc
#endif
defaultSDocContext :: SDocContext
#if MIN_VERSION_ghc(9,2,0)
type SDocContext = GHC.SDocContext
defaultSDocContext :: SDocContext
defaultSDocContext = SDocContext
GHC.defaultSDocContext
#else
type SDocContext = ()
defaultSDocContext = ()
#endif
showGhcException :: SDocContext -> GhcException -> ShowS
#if MIN_VERSION_ghc(9,2,0)
showGhcException :: SDocContext -> GhcException -> ShowS
showGhcException = SDocContext -> GhcException -> ShowS
GHC.showGhcException
#else
showGhcException _ = GHC.showGhcException
#endif
addWay :: Way -> DynFlags -> DynFlags
#if MIN_VERSION_ghc(9,2,0)
addWay :: Way -> DynFlags -> DynFlags
addWay Way
way DynFlags
df =
DynFlags
df
{ targetWays_ :: Ways
targetWays_ = Way -> Ways -> Ways
forall a. Ord a => a -> Set a -> Set a
Set.insert Way
way (Ways -> Ways) -> Ways -> Ways
forall a b. (a -> b) -> a -> b
$ DynFlags -> Ways
DynFlags.targetWays_ DynFlags
df
}
#else
addWay = GHC.addWay'
#endif
setBackendToInterpreter :: DynFlags -> DynFlags
#if MIN_VERSION_ghc(9,2,0)
setBackendToInterpreter :: DynFlags -> DynFlags
setBackendToInterpreter DynFlags
df = DynFlags
df{backend :: Backend
backend = Backend
Interpreter}
#else
setBackendToInterpreter df = df{hscTarget = HscInterpreted}
#endif
parseDynamicFlags :: MonadIO m => Logger -> DynFlags -> [Located String] -> m (DynFlags, [Located String], [Warn])
#if MIN_VERSION_ghc(9,2,0)
parseDynamicFlags :: forall (m :: * -> *).
MonadIO m =>
Logger
-> DynFlags
-> [Located String]
-> m (DynFlags, [Located String], [Warn])
parseDynamicFlags = Logger
-> DynFlags
-> [Located String]
-> m (DynFlags, [Located String], [Warn])
forall (m :: * -> *).
MonadIO m =>
Logger
-> DynFlags
-> [Located String]
-> m (DynFlags, [Located String], [Warn])
GHC.parseDynamicFlags
#else
parseDynamicFlags _ = GHC.parseDynamicFlags
#endif