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 = hostIsDynamic
#else
dynamicGhc :: Bool
dynamicGhc = Bool
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 = GHC.initLogger
putLogMsg = GHC.putLogMsg
pushLogHook = GHC.pushLogHook
modifyLogger = GHC.modifyLogger
#else
type Logger = LogAction
initLogger :: IO Logger
initLogger = Logger -> IO Logger
forall (f :: * -> *) a. Applicative f => a -> f a
pure Logger
GHC.defaultLogAction
putLogMsg :: Logger -> Logger
putLogMsg = Logger -> Logger
forall a. a -> a
id
pushLogHook :: (Logger -> Logger) -> Logger -> Logger
pushLogHook = (Logger -> Logger) -> Logger -> Logger
forall a. a -> a
id
modifyLogger :: (Logger -> Logger) -> m ()
modifyLogger f :: Logger -> Logger
f = do
DynFlags
df <- m DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
[InstalledUnitId]
_ <- DynFlags -> m [InstalledUnitId]
forall (m :: * -> *). GhcMonad m => DynFlags -> m [InstalledUnitId]
setSessionDynFlags DynFlags
df{log_action :: Logger
log_action = Logger -> Logger
f (Logger -> Logger) -> Logger -> Logger
forall a b. (a -> b) -> a -> b
$ DynFlags -> Logger
DynFlags.log_action DynFlags
df}
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif
emptyUnitState :: UnitState
#if MIN_VERSION_ghc(9,2,0)
type UnitState = GHC.UnitState
emptyUnitState = GHC.emptyUnitState
#else
type UnitState = ()
emptyUnitState :: ()
emptyUnitState = ()
#endif
showSDocForUser :: DynFlags -> UnitState -> PrintUnqualified -> SDoc -> String
#if MIN_VERSION_ghc(9,2,0)
showSDocForUser = GHC.showSDocForUser
#else
showSDocForUser :: DynFlags -> () -> PrintUnqualified -> SDoc -> String
showSDocForUser df :: DynFlags
df _ = DynFlags -> PrintUnqualified -> SDoc -> String
GHC.showSDocForUser DynFlags
df
#endif
mkParserOpts :: DynFlags -> ParserOpts
initParserState :: ParserOpts -> StringBuffer -> RealSrcLoc -> GHC.PState
#if MIN_VERSION_ghc(9,2,0)
type ParserOpts = GHC.ParserOpts
mkParserOpts =
GHC.mkParserOpts
<$> DynFlags.warningFlags
<*> DynFlags.extensionFlags
<*> DynFlags.safeImportsOn
<*> gopt Opt_Haddock
<*> gopt Opt_KeepRawTokenStream
<*> const True
initParserState = GHC.initParserState
#else
type ParserOpts = GHC.ParserFlags
mkParserOpts :: DynFlags -> ParserOpts
mkParserOpts = DynFlags -> ParserOpts
GHC.mkParserFlags
initParserState :: ParserOpts -> StringBuffer -> RealSrcLoc -> PState
initParserState = ParserOpts -> StringBuffer -> RealSrcLoc -> PState
GHC.mkPStatePure
#endif
getErrorMessages :: GHC.PState -> DynFlags -> GHC.ErrorMessages
pprErrorMessages :: GHC.ErrorMessages -> [SDoc]
#if MIN_VERSION_ghc(9,2,0)
getErrorMessages pstate _ = fmap GHC.pprError $ GHC.getErrorMessages pstate
pprErrorMessages = bagToList . fmap pprErrorMessage
where
pprErrorMessage = vcat . GHC.unDecorated . GHC.errMsgDiagnostic
#elif MIN_VERSION_ghc(8,10,0)
getErrorMessages = GHC.getErrorMessages
pprErrorMessages = GHC.pprErrMsgBagWithLoc
#else
getErrorMessages :: PState -> DynFlags -> ErrorMessages
getErrorMessages _ _ = ErrorMessages
forall a. Bag a
emptyBag
pprErrorMessages :: ErrorMessages -> [SDoc]
pprErrorMessages = ErrorMessages -> [SDoc]
GHC.pprErrMsgBagWithLoc
#endif
defaultSDocContext :: SDocContext
#if MIN_VERSION_ghc(9,2,0)
type SDocContext = GHC.SDocContext
defaultSDocContext = GHC.defaultSDocContext
#else
type SDocContext = ()
defaultSDocContext :: ()
defaultSDocContext = ()
#endif
showGhcException :: SDocContext -> GhcException -> ShowS
#if MIN_VERSION_ghc(9,2,0)
showGhcException = GHC.showGhcException
#else
showGhcException :: () -> GhcException -> ShowS
showGhcException _ = GhcException -> ShowS
GHC.showGhcException
#endif
addWay :: Way -> DynFlags -> DynFlags
#if MIN_VERSION_ghc(9,2,0)
addWay way df =
df
{ targetWays_ = Set.insert way $ DynFlags.targetWays_ df
}
#else
addWay :: Way -> DynFlags -> DynFlags
addWay = Way -> DynFlags -> DynFlags
GHC.addWay'
#endif
setBackendToInterpreter :: DynFlags -> DynFlags
#if MIN_VERSION_ghc(9,2,0)
setBackendToInterpreter df = df{backend = Interpreter}
#else
setBackendToInterpreter :: DynFlags -> DynFlags
setBackendToInterpreter df :: DynFlags
df = DynFlags
df{hscTarget :: HscTarget
hscTarget = HscTarget
HscInterpreted}
#endif
parseDynamicFlags :: MonadIO m => Logger -> DynFlags -> [Located String] -> m (DynFlags, [Located String], [Warn])
#if MIN_VERSION_ghc(9,2,0)
parseDynamicFlags = GHC.parseDynamicFlags
#else
parseDynamicFlags :: Logger
-> DynFlags
-> [Located String]
-> m (DynFlags, [Located String], [Warn])
parseDynamicFlags _ = DynFlags
-> [Located String] -> m (DynFlags, [Located String], [Warn])
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located String] -> m (DynFlags, [Located String], [Warn])
GHC.parseDynamicFlags
#endif