diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for pinned-warnings +## 0.1.1.0 + +* Support GHC 9.8.x +* Drop support for GHC 9.2 and 8.10 + ## 0.1.0.14 * Support GHC 9.6.x diff --git a/pinned-warnings.cabal b/pinned-warnings.cabal --- a/pinned-warnings.cabal +++ b/pinned-warnings.cabal @@ -4,7 +4,7 @@ -- http://haskell.org/cabal/users-guide/ name: pinned-warnings -version: 0.1.0.15 +version: 0.1.1.0 synopsis: Preserve warnings in a GHCi session description: Please see the README on GitHub at homepage: https://github.com/aaronallen8455/pinned-warnings#readme @@ -19,7 +19,7 @@ extra-source-files: README.md CHANGELOG.md -tested-with: GHC ==8.10.4 || ==8.10.5 || ==8.10.6 || ==8.10.7 || ==9.0.1 || ==9.2.2 || ==9.4.2 || ==9.6.1 +tested-with: GHC ==9.2.2 || ==9.4.2 || ==9.6.1 || ==9.8.1 library exposed-modules: PinnedWarnings @@ -28,12 +28,12 @@ Internal.GhcFacade Internal.Types - build-depends: ghc >= 8.10 && < 9.7, - base >= 4.14.1 && < 5, - bytestring >= 0.10.12, - containers >= 0.6.2, - directory >= 1.3.6, - time >= 1.9.3, + build-depends: ghc >= 9.2 && < 9.9, + base >= 4.16.0 && < 5, + bytestring >= 0.11.3 && < 0.13, + containers >= 0.6.5 && < 0.7, + directory >= 1.3.6 && < 1.4, + time >= 1.11.1 && < 1.13, transformers >= 0.5.6 && < 0.7 hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Internal/GhcFacade.hs b/src/Internal/GhcFacade.hs --- a/src/Internal/GhcFacade.hs +++ b/src/Internal/GhcFacade.hs @@ -2,12 +2,8 @@ {-# LANGUAGE PatternSynonyms #-} module Internal.GhcFacade ( module X - , pattern RealSrcLoc' -#if MIN_VERSION_ghc(9,2,0) -#else - , log_action' -#endif , TcPluginResult' + , pattern CDictCan' ) where #if MIN_VERSION_ghc(9,6,0) @@ -30,6 +26,7 @@ import GHC.Utils.Error as X import GHC.Utils.Logger as X import GHC.Utils.Outputable as X +import GHC.Driver.Config.Diagnostic as X #elif MIN_VERSION_ghc(9,4,0) import GHC as X hiding (FunDep) @@ -51,6 +48,7 @@ import GHC.Utils.Error as X import GHC.Utils.Logger as X import GHC.Utils.Outputable as X +import GHC.Driver.Config.Diagnostic as X #elif MIN_VERSION_ghc(9,2,0) import GHC as X hiding (FunDep) @@ -71,71 +69,22 @@ import GHC.Utils.Error as X import GHC.Utils.Logger as X import GHC.Utils.Outputable as X - -#elif MIN_VERSION_ghc(9,0,0) -import GHC as X -import GHC.Core.Class as X -import GHC.Core.Make as X -import GHC.Data.Bag as X -import GHC.Data.FastString as X -import GHC.Data.IOEnv as X -import GHC.Driver.Plugins as X hiding (TcPlugin) -import GHC.Driver.Session -import GHC.Driver.Types as X -import GHC.Tc.Plugin as X -import GHC.Tc.Types as X -import GHC.Tc.Types.Constraint as X -import GHC.Tc.Types.Evidence as X -import GHC.Types.Name.Occurrence as X -import GHC.Types.SrcLoc as X -import GHC.Utils.Error as X - -#elif MIN_VERSION_ghc(8,10,0) -import Bag as X -import Class as X -import Constraint as X -import DynFlags as X -import ErrUtils as X -import FastString as X -import GHC as X -import HscMain as X -import HscTypes as X -import IOEnv as X -import MkCore as X -import OccName as X -import Outputable as X -import Plugins as X hiding (TcPlugin) -import SrcLoc as X -import TcEvidence as X -import TcPluginM as X -import TcRnTypes as X #endif -pattern RealSrcLoc' :: RealSrcLoc -> SrcLoc -pattern RealSrcLoc' s <- -#if MIN_VERSION_ghc(9,0,1) - RealSrcLoc s _ -#elif MIN_VERSION_ghc(8,10,0) - RealSrcLoc s -#endif - -#if MIN_VERSION_ghc(9,2,0) -#else -log_action' :: LogAction -> (DynFlags -> Severity -> SrcSpan -> MsgDoc -> IO ()) -> LogAction -#endif -#if MIN_VERSION_ghc(9,2,0) -#elif MIN_VERSION_ghc(9,0,1) -log_action' action withStuff dflags warnReason severity srcSpan msgDoc = do - withStuff dflags severity srcSpan msgDoc - action dflags warnReason severity srcSpan msgDoc -#elif MIN_VERSION_ghc(8,10,0) -log_action' action withStuff dflags warnReason severity srcSpan pprStyle msgDoc = do - withStuff dflags severity srcSpan msgDoc - action dflags warnReason severity srcSpan pprStyle msgDoc -#endif - #if MIN_VERSION_ghc(9,4,0) type TcPluginResult' = X.TcPluginSolveResult #else type TcPluginResult' = X.TcPluginResult +#endif + +pattern CDictCan' + :: CtEvidence + -> Class + -> [Xi] + -> Ct +pattern CDictCan' diEv diCls diTys +#if MIN_VERSION_ghc(9,8,0) + <- CDictCan (DictCt diEv diCls diTys _) +#else + <- CDictCan { cc_ev = diEv, cc_class = diCls, cc_tyargs = diTys } #endif diff --git a/src/Internal/Types.hs b/src/Internal/Types.hs --- a/src/Internal/Types.hs +++ b/src/Internal/Types.hs @@ -24,8 +24,6 @@ :: Ghc.MsgEnvelope Ghc.DiagnosticMessage #elif MIN_VERSION_ghc(9,2,0) :: Ghc.MsgEnvelope Ghc.DecoratedSDoc -#else - :: Ghc.WarnMsg #endif } @@ -51,8 +49,6 @@ } in foldMap (Ghc.showSDocOneLine sdocCtx) . Ghc.unDecorated . Ghc.errMsgDiagnostic . unWarning -#else - show . unWarning #endif instance Eq Warning where diff --git a/src/PinnedWarnings.hs b/src/PinnedWarnings.hs --- a/src/PinnedWarnings.hs +++ b/src/PinnedWarnings.hs @@ -38,11 +38,7 @@ Ghc.defaultPlugin { Ghc.tcPlugin = const $ Just tcPlugin , Ghc.parsedResultAction = const resetPinnedWarnsForMod -#if MIN_VERSION_ghc(9,2,0) , Ghc.driverPlugin = const (pure . addWarningCapture) -#else - , Ghc.dynflagsPlugin = const (pure . addWarningCapture) -#endif , Ghc.pluginRecompile = Ghc.purePlugin } @@ -100,7 +96,7 @@ = fmap (flip Ghc.TcPluginOk [] . catMaybes) . traverse go where - go ct@Ghc.CDictCan { Ghc.cc_class = cls } + go ct@(Ghc.CDictCan' _ cls _) | Ghc.classTyCon cls == showWarningsClass pluginState = do counter <- Ghc.tcPluginIO $ readIORef (counterRef pluginState) @@ -154,9 +150,6 @@ #elif MIN_VERSION_ghc(9,2,0) $ \messages -> (Ghc.mkMessages pinnedWarns `Ghc.unionMessages` messages, ()) -#else - $ \(warnings, errors) -> - ((Ghc.unionBags pinnedWarns warnings, errors), ()) #endif -- | Remove warnings for modules that no longer exist @@ -207,8 +200,8 @@ #else Ghc.MCDiagnostic Ghc.SevWarning _ #endif - | Ghc.RealSrcLoc' start <- Ghc.srcSpanStart srcSpan - , Ghc.RealSrcLoc' end <- Ghc.srcSpanEnd srcSpan + | Ghc.RealSrcLoc start _ <- Ghc.srcSpanStart srcSpan + , Ghc.RealSrcLoc end _ <- Ghc.srcSpanEnd srcSpan , Just modFile <- Ghc.srcSpanFileName_maybe srcSpan -> do let diag = @@ -217,12 +210,9 @@ , Ghc.diagReason = Ghc.WarningWithoutFlag , Ghc.diagHints = [] } - warn = Warning Ghc.MsgEnvelope - { Ghc.errMsgSpan = srcSpan - , Ghc.errMsgContext = Ghc.neverQualify - , Ghc.errMsgDiagnostic = diag - , Ghc.errMsgSeverity = Ghc.SevWarning - } + diagOpts = Ghc.initDiagOpts $ Ghc.hsc_dflags hscEnv + warn = Warning $ + Ghc.mkMsgEnvelope diagOpts srcSpan Ghc.neverQualify diag addWarningToGlobalState start end modFile warn _ -> pure () logAction dynFlags messageClass srcSpan sdoc @@ -237,8 +227,8 @@ warningsHook logAction dynFlags warnReason severity srcSpan sdoc = do case severity of Ghc.SevWarning - | Ghc.RealSrcLoc' start <- Ghc.srcSpanStart srcSpan - , Ghc.RealSrcLoc' end <- Ghc.srcSpanEnd srcSpan + | Ghc.RealSrcLoc start _ <- Ghc.srcSpanStart srcSpan + , Ghc.RealSrcLoc end _ <- Ghc.srcSpanEnd srcSpan , Just modFile <- Ghc.srcSpanFileName_maybe srcSpan -> do let warn = Warning $ Ghc.mkPlainWarnMsg srcSpan sdoc @@ -246,23 +236,6 @@ _ -> pure () logAction dynFlags warnReason severity srcSpan sdoc -#else -addWarningCapture :: Ghc.DynFlags -> Ghc.DynFlags -addWarningCapture dynFlags = do - dynFlags - { Ghc.log_action = Ghc.log_action' (Ghc.log_action dynFlags) $ - \dyn severity srcSpan msgDoc -> do - case severity of - Ghc.SevWarning - | Ghc.RealSrcLoc' start <- Ghc.srcSpanStart srcSpan - , Ghc.RealSrcLoc' end <- Ghc.srcSpanEnd srcSpan - , Just modFile <- Ghc.srcSpanFileName_maybe srcSpan - -> do - let warn = Warning - $ Ghc.mkWarnMsg dyn srcSpan Ghc.alwaysQualify msgDoc - addWarningToGlobalState start end modFile warn - _ -> pure () - } #endif -- | Adds a warning to the global state variable