From a53fb7fc0053c31984876d9c411719d2d9a31c5d Mon Sep 17 00:00:00 2001 From: Daniil Iaitskov Date: Tue, 5 Aug 2025 14:59:39 -0800 Subject: [PATCH] required-type-arguments use-required-type-arguments for annotations --- src/Control/Monad/Ghc.hs | 2 ++ src/Hint/Annotations.hs | 38 ++++++++++++++++++++++++++--- src/Hint/Base.hs | 6 +++++ src/Hint/Configuration.hs | 2 ++ src/Hint/GHC.hs | 2 ++ src/Hint/InterpreterT.hs | 7 +++++- src/Language/Haskell/Interpreter.hs | 3 +++ 7 files changed, 56 insertions(+), 4 deletions(-) diff --git a/src/Control/Monad/Ghc.hs b/src/Control/Monad/Ghc.hs index d85e87b..15e01b1 100644 --- a/src/Control/Monad/Ghc.hs +++ b/src/Control/Monad/Ghc.hs @@ -19,7 +19,9 @@ import qualified GHC.Utils.Logger as GHC #endif #if MIN_VERSION_ghc(9,0,0) import qualified GHC.Utils.Monad as GHC +#if !MIN_VERSION_ghc(9,12,0) import qualified GHC.Utils.Exception as GHC +#endif import qualified GHC.Driver.Monad as GHC import qualified GHC.Driver.Session as GHC diff --git a/src/Hint/Annotations.hs b/src/Hint/Annotations.hs index 831daad..626db42 100644 --- a/src/Hint/Annotations.hs +++ b/src/Hint/Annotations.hs @@ -1,6 +1,13 @@ +#if MIN_VERSION_ghc(9,10,0) +{-# LANGUAGE RequiredTypeArguments #-} +#endif module Hint.Annotations ( getModuleAnnotations, - getValAnnotations + getValAnnotations, +#if MIN_VERSION_ghc(9,10,0) + getModuleAnnotations', + getValAnnotations', +#endif ) where import Data.Data @@ -27,17 +34,42 @@ import MonadUtils (concatMapM) #endif -- Get the annotations associated with a particular module. -getModuleAnnotations :: (Data a, MonadInterpreter m) => a -> String -> m [a] +getModuleAnnotations :: forall m a. (Data a, MonadInterpreter m) => a -> String -> m [a] +#if MIN_VERSION_ghc(9,10,0) +getModuleAnnotations _ = getModuleAnnotations' a +#else getModuleAnnotations _ x = do mods <- GHC.mgModSummaries . hsc_mod_graph <$> runGhc GHC.getSession let x' = filter ((==) x . GHC.moduleNameString . GHC.moduleName . ms_mod) mods concatMapM (anns . ModuleTarget . ms_mod) x' +#endif + +#if MIN_VERSION_ghc(9,10,0) +-- Get the annotations associated with a particular module. +getModuleAnnotations' :: MonadInterpreter m => forall a -> Data a => String -> m [a] +getModuleAnnotations' _ x = do + mods <- GHC.mgModSummaries . hsc_mod_graph <$> runGhc GHC.getSession + let x' = filter ((==) x . GHC.moduleNameString . GHC.moduleName . ms_mod) mods + concatMapM (anns . ModuleTarget . ms_mod) x' +#endif -- Get the annotations associated with a particular function. -getValAnnotations :: (Data a, MonadInterpreter m) => a -> String -> m [a] +getValAnnotations :: forall m a. (Data a, MonadInterpreter m) => a -> String -> m [a] +#if MIN_VERSION_ghc(9,10,0) +getValAnnotations _ = getValAnnotations' a +#else getValAnnotations _ s = do names <- runGhc $ GHC.parseName s concatMapM (anns . NamedTarget) names +#endif + +#if MIN_VERSION_ghc(9,10,0) +-- Get the annotations associated with a particular function. +getValAnnotations' :: MonadInterpreter m => forall a -> Data a => String -> m [a] +getValAnnotations' _ s = do + names <- runGhc $ GHC.parseName s + concatMapM (anns . NamedTarget) names +#endif anns :: (MonadInterpreter m, Data a) => AnnTarget GHC.Name -> m [a] anns target = runGhc $ GHC.findGlobalAnns deserializeWithData target diff --git a/src/Hint/Base.hs b/src/Hint/Base.hs index f1bafc7..5336670 100644 --- a/src/Hint/Base.hs +++ b/src/Hint/Base.hs @@ -21,7 +21,9 @@ import Control.Monad.IO.Class import Control.Monad.Catch as MC import Data.IORef +#if !MIN_VERSION_ghc(9,12,0) import Data.Dynamic +#endif import qualified Data.List import qualified Hint.GHC as GHC @@ -53,7 +55,11 @@ data InterpreterError = UnknownError String -- | GhcExceptions from the underlying GHC API are caught -- and rethrown as this. | GhcException String +#if MIN_VERSION_ghc(9,12,0) + deriving (Show) +#else deriving (Show, Typeable) +#endif data InterpreterState = St { activePhantoms :: [PhantomModule], diff --git a/src/Hint/Configuration.hs b/src/Hint/Configuration.hs index 47156ed..42fb3e9 100644 --- a/src/Hint/Configuration.hs +++ b/src/Hint/Configuration.hs @@ -17,7 +17,9 @@ module Hint.Configuration ( import Control.Monad import Control.Monad.Catch import Data.Char +#if !MIN_VERSION_ghc(9,12,0) import Data.Maybe (maybe) +#endif import Data.List (intercalate) import qualified Hint.GHC as GHC diff --git a/src/Hint/GHC.hs b/src/Hint/GHC.hs index 02f342f..7c26711 100644 --- a/src/Hint/GHC.hs +++ b/src/Hint/GHC.hs @@ -187,7 +187,9 @@ import qualified Data.Set as Set -- parseDynamicFlags import qualified GHC (parseDynamicFlags) +#if !MIN_VERSION_ghc(9,12,0) import GHC.Driver.CmdLine (Warn) +#endif -- pprTypeForUser import qualified GHC.Core.TyCo.Ppr as GHC (pprSigmaType) diff --git a/src/Hint/InterpreterT.hs b/src/Hint/InterpreterT.hs index 5d279ca..2e97853 100644 --- a/src/Hint/InterpreterT.hs +++ b/src/Hint/InterpreterT.hs @@ -18,9 +18,11 @@ import Control.Monad.Trans.Class import Control.Monad.Trans.Reader import Control.Monad.Catch as MC +#if !MIN_VERSION_ghc(9,12,0) import Data.Typeable (Typeable) import Control.Concurrent.MVar import System.IO.Unsafe (unsafePerformIO) +#endif import Data.IORef import Data.Maybe @@ -152,7 +154,10 @@ ifInterpreterNotRunning action = liftIO (tryTakeMVar uniqueToken) >>= \ case -- | The installed version of ghc is not thread-safe. This exception -- is thrown whenever you try to execute @runInterpreter@ while another -- instance is already running. -data MultipleInstancesNotAllowed = MultipleInstancesNotAllowed deriving Typeable +data MultipleInstancesNotAllowed = MultipleInstancesNotAllowed +#if !MIN_VERSION_ghc(9,12,0) + deriving Typeable +#endif instance Exception MultipleInstancesNotAllowed diff --git a/src/Language/Haskell/Interpreter.hs b/src/Language/Haskell/Interpreter.hs index 1d2b4ec..ef77f2f 100644 --- a/src/Language/Haskell/Interpreter.hs +++ b/src/Language/Haskell/Interpreter.hs @@ -23,6 +23,9 @@ module Language.Haskell.Interpreter( -- to mean \'{\' and \'}\' respectively. We cannot put the -- pragmas inline in the code since GHC scarfs them up. getModuleAnnotations, getValAnnotations, +#if MIN_VERSION_ghc(9,10,0) + getModuleAnnotations', getValAnnotations', +#endif -- ** Type inference typeChecksWithDetails, typeOf, typeChecks, kindOf, normalizeType,