ihaskell: support GHC 9.2

ihaskell.cabal

@@ -95,7 +95,7 @@ library
                        utf8-string          -any,
                        vector               -any,
                        ipython-kernel       >=0.10.2.0,
-                       ghc-boot             >=8.0 && <9.1
+                       ghc-boot             >=8.0 && <9.3
 
   exposed-modules: IHaskell.Display
                    IHaskell.Convert
@@ -149,10 +149,10 @@ executable ihaskell
   default-language:    Haskell2010
   build-depends:
                        ihaskell -any,
-                       base                 >=4.9 && < 4.16,
+                       base                 >=4.9 && < 4.17,
                        text                 >=0.11,
                        transformers         -any,
-                       ghc                  >=8.0 && < 9.1,
+                       ghc                  >=8.0 && < 9.3,
                        process              >=1.1,
                        aeson                >=0.7,
                        bytestring           >=0.10,

src/IHaskell/Eval/Completion.hs

@@ -22,7 +22,13 @@ import qualified Data.List.Split.Internals as Split
 import           System.Environment (getEnv)
 
 import           GHC
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+import           GHC.Unit.Database
+import           GHC.Unit.State
+import           GHC.Driver.Ppr
+import           GHC.Driver.Session
+import           GHC.Driver.Monad as GhcMonad
+#elif MIN_VERSION_ghc(9,0,0)
 import           GHC.Unit.Database
 import           GHC.Unit.State
 import           GHC.Driver.Session
@@ -81,8 +87,12 @@ complete code posOffset = do
   let isQualified = ('.' `elem`)
       unqualNames = nub $ filter (not . isQualified) rdrNames
       qualNames = nub $ scopeNames ++ filter isQualified rdrNames
-
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+  logger <- getLogger
+  (db, _, _, _) <- liftIO $ initUnits logger flags Nothing
+  let getNames = map (moduleNameString . exposedName) . unitExposedModules
+      moduleNames = nub $ concatMap getNames $ concatMap unitDatabaseUnits db
+#elif MIN_VERSION_ghc(9,0,0)
   let Just db = unitDatabases flags
       getNames = map (moduleNameString . exposedName) . unitExposedModules
       moduleNames = nub $ concatMap getNames $ concatMap unitDatabaseUnits db

src/IHaskell/Eval/Evaluate.hs

@@ -37,7 +37,21 @@ import           System.Exit
 import           Data.Maybe (mapMaybe)
 import           System.Environment (getEnv)
 
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+import qualified GHC.Runtime.Debugger as Debugger
+import           GHC.Runtime.Eval
+import           GHC.Driver.Session
+import           GHC.Unit.State
+import           Control.Monad.Catch as MC
+import           GHC.Utils.Outputable hiding ((<>))
+import           GHC.Data.Bag
+import           GHC.Driver.Backend
+import           GHC.Driver.Ppr
+import           GHC.Runtime.Context
+import           GHC.Types.SourceError
+import           GHC.Unit.Types (UnitId)
+import qualified GHC.Utils.Error as ErrUtils
+#elif MIN_VERSION_ghc(9,0,0)
 import qualified GHC.Runtime.Debugger as Debugger
 import           GHC.Runtime.Eval
 import           GHC.Driver.Session
@@ -87,6 +101,11 @@ import           Paths_ihaskell (version)
 import           Data.Version (versionBranch)
 #endif
 
+#if MIN_VERSION_ghc(9,2,0)
+showSDocUnqual :: DynFlags -> SDoc -> String
+showSDocUnqual = showSDoc
+#endif
+
 #if MIN_VERSION_ghc(9,0,0)
 gcatch :: Ghc a -> (SomeException -> Ghc a) -> Ghc a
 gcatch = MC.catch
@@ -192,29 +211,43 @@ interpret libdir allowedStdin needsSupportLibraries action = runGhc (Just libdir
   -- Run the rest of the interpreter
   action hasSupportLibraries
 
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+packageIdString' :: Logger -> DynFlags -> UnitInfo -> IO String
+packageIdString' logger dflags pkg_cfg = do
+    (_, unitState, _, _) <- initUnits logger dflags Nothing
+    case (lookupUnit unitState $ mkUnit pkg_cfg) of
+      Nothing -> pure "(unknown)"
+      Just cfg -> let
+        PackageName name = unitPackageName cfg
+        in pure $ unpackFS name
+#elif MIN_VERSION_ghc(9,0,0)
 packageIdString' :: DynFlags -> UnitInfo -> String
-#else
-packageIdString' :: DynFlags -> PackageConfig -> String
-#endif
 packageIdString' dflags pkg_cfg =
-#if MIN_VERSION_ghc(9,0,0)
     case (lookupUnit (unitState dflags) $ mkUnit pkg_cfg) of
       Nothing -> "(unknown)"
       Just cfg -> let
         PackageName name = unitPackageName cfg
         in unpackFS name
 #elif MIN_VERSION_ghc(8,2,0)
+packageIdString' :: DynFlags -> PackageConfig -> String
+packageIdString' dflags pkg_cfg =
     case (lookupPackage dflags $ packageConfigId pkg_cfg) of
       Nothing -> "(unknown)"
       Just cfg -> let
         PackageName name = packageName cfg
         in unpackFS name
 #else
+packageIdString' :: DynFlags -> PackageConfig -> String
+packageIdString' dflags pkg_cfg =
     fromMaybe "(unknown)" (unitIdPackageIdString dflags $ packageConfigId pkg_cfg)
 #endif
 
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+getPackageConfigs :: Logger -> DynFlags -> IO [GenUnitInfo UnitId]
+getPackageConfigs logger dflags = do
+    (pkgDb, _, _, _) <- initUnits logger dflags Nothing
+    pure $ foldMap unitDatabaseUnits pkgDb
+#elif MIN_VERSION_ghc(9,0,0)
 getPackageConfigs :: DynFlags -> [GenUnitInfo UnitId]
 getPackageConfigs dflags =
     foldMap unitDatabaseUnits pkgDb
@@ -236,16 +269,28 @@ initializeImports importSupportLibraries = do
   -- version of the ihaskell library. Also verify that the packages we load are not broken.
   dflags <- getSessionDynFlags
   broken <- liftIO getBrokenPackages
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+  let dflgs = dflags
+#elif MIN_VERSION_ghc(9,0,0)
   dflgs <- liftIO $ initUnits dflags
 #else
   (dflgs, _) <- liftIO $ initPackages dflags
 #endif
+
+#if MIN_VERSION_ghc(9,2,0)
+  logger <- getLogger
+  db <- liftIO $ getPackageConfigs logger dflgs
+  packageNames <- liftIO $ mapM (packageIdString' logger dflgs) db
+  let hiddenPackages = Set.intersection hiddenPackageNames (Set.fromList packageNames)
+      hiddenFlags = fmap HidePackage $ Set.toList hiddenPackages
+      initStr = "ihaskell-"
+#else
   let db = getPackageConfigs dflgs
       packageNames = map (packageIdString' dflgs) db
       hiddenPackages = Set.intersection hiddenPackageNames (Set.fromList packageNames)
       hiddenFlags = fmap HidePackage $ Set.toList hiddenPackages
       initStr = "ihaskell-"
+#endif
 
 #if MIN_VERSION_ghc(8,2,0)
       -- Name of the ihaskell package, i.e. "ihaskell"
@@ -464,9 +509,13 @@ flushWidgetMessages state evalmsgs widgetHandler = do
         let commMessages = evalmsgs ++ messages
         widgetHandler state commMessages
 
-
+#if MIN_VERSION_ghc(9,2,0)
+getErrMsgDoc :: ErrUtils.WarnMsg -> SDoc
+getErrMsgDoc = ErrUtils.pprLocMsgEnvelope
+#else
 getErrMsgDoc :: ErrUtils.ErrMsg -> SDoc
 getErrMsgDoc = ErrUtils.pprLocErrMsg
+#endif
 
 safely :: KernelState -> Interpreter EvalOut -> Interpreter EvalOut
 safely state = ghandle handler . ghandle sourceErrorHandler
@@ -862,9 +911,16 @@ evalCommand _ (Directive SPrint binding) state = wrapExecution state $ do
 #else
   let action = \_dflags _sev _srcspan _ppr _style msg -> modifyIORef' contents (showSDoc flags msg :)
 #endif
+#if MIN_VERSION_ghc(9,2,0)
+  pushLogHookM (const action)
+#else
   let flags' = flags { log_action = action }
   _ <- setSessionDynFlags flags'
+#endif
   Debugger.pprintClosureCommand False False binding
+#if MIN_VERSION_ghc(9,2,0)
+  popLogHookM
+#endif
   _ <- setSessionDynFlags flags
   sprint <- liftIO $ readIORef contents
   return $ formatType (unlines sprint)
@@ -1100,13 +1156,21 @@ doLoadModule name modName = do
     -- Compile loaded modules.
     flags <- getSessionDynFlags
     errRef <- liftIO $ newIORef []
+#if MIN_VERSION_ghc(9,0,0)
+    let logAction = \_dflags _warn _sev _srcspan msg -> modifyIORef' errRef (showSDoc flags msg :)
+#else
+    let logAction = \_dflags _sev _srcspan _ppr _style msg -> modifyIORef' errRef (showSDoc flags msg :)
+#endif
+#if MIN_VERSION_ghc(9,2,0)
+    pushLogHookM (const logAction)
+#endif
     _ <- setSessionDynFlags $ flip gopt_set Opt_BuildDynamicToo
       flags
-        { hscTarget = objTarget flags
-#if MIN_VERSION_ghc(9,0,0)
-        , log_action = \_dflags _warn _sev _srcspan msg -> modifyIORef' errRef (showSDoc flags msg :)
+#if MIN_VERSION_ghc(9,2,0)
+        { backend = objTarget flags
 #else
-        , log_action = \_dflags _sev _srcspan _ppr _style msg -> modifyIORef' errRef (showSDoc flags msg :)
+        { hscTarget = objTarget flags
+        , log_action = logAction
 #endif
         }
 
@@ -1134,6 +1198,9 @@ doLoadModule name modName = do
 
     -- Switch back to interpreted mode.
     _ <- setSessionDynFlags flags
+#if MIN_VERSION_ghc(9,2,0)
+    popLogHookM
+#endif
 
     case result of
       Succeeded -> return mempty
@@ -1151,7 +1218,11 @@ doLoadModule name modName = do
 
       -- Switch to interpreted mode!
       flags <- getSessionDynFlags
+#if MIN_VERSION_ghc(9,2,0)
+      _ <- setSessionDynFlags flags { backend = Interpreter }
+#else
       _ <- setSessionDynFlags flags { hscTarget = HscInterpreted }
+#endif
 
       -- Return to old context, make sure we have `it`.
       setContext imported
@@ -1170,10 +1241,13 @@ doReload = do
     errRef <- liftIO $ newIORef []
     _ <- setSessionDynFlags $ flip gopt_set Opt_BuildDynamicToo
       flags
+#if MIN_VERSION_ghc(9,2,0)
+        { backend = objTarget flags
+#elif MIN_VERSION_ghc(9,0,0)
         { hscTarget = objTarget flags
-#if MIN_VERSION_ghc(9,0,0)
         , log_action = \_dflags _warn _sev _srcspan msg -> modifyIORef' errRef (showSDoc flags msg :)
 #else
+        { hscTarget = objTarget flags
         , log_action = \_dflags _sev _srcspan _ppr _style msg -> modifyIORef' errRef (showSDoc flags msg :)
 #endif
         }
@@ -1212,7 +1286,11 @@ doReload = do
 
       -- Switch to interpreted mode!
       flags <- getSessionDynFlags
+#if MIN_VERSION_ghc(9,2,0)
+      _ <- setSessionDynFlags flags { backend = Interpreter }
+#else
       _ <- setSessionDynFlags flags { hscTarget = HscInterpreted }
+#endif
 
       -- Return to old context, make sure we have `it`.
       setContext imported
@@ -1220,10 +1298,14 @@ doReload = do
 
       return $ displayError $ "Failed to reload."
 
+#if MIN_VERSION_ghc(9,2,0)
+objTarget :: DynFlags -> Backend
+objTarget = platformDefaultBackend . targetPlatform
+#elif MIN_VERSION_ghc(8,10,0)
 objTarget :: DynFlags -> HscTarget
-#if MIN_VERSION_ghc(8,10,0)
 objTarget = defaultObjectTarget
 #else
+objTarget :: DynFlags -> HscTarget
 objTarget flags = defaultObjectTarget $ targetPlatform flags
 #endif
 

src/IHaskell/Eval/Info.hs

@@ -8,7 +8,10 @@ import           IHaskellPrelude
 import           IHaskell.Eval.Evaluate (typeCleaner, Interpreter)
 
 import           GHC
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+import           GHC.Driver.Ppr
+import           Control.Monad.Catch (handle)
+#elif MIN_VERSION_ghc(9,0,0)
 import           GHC.Utils.Outputable
 import           Control.Monad.Catch (handle)
 #else

src/IHaskell/Eval/Util.hs

@@ -33,7 +33,23 @@ import qualified Data.ByteString.Char8 as CBS
 #endif
 
 -- GHC imports.
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+import           GHC.Core.InstEnv (is_cls, is_tys)
+import           GHC.Core.Unify
+import           GHC.Types.TyThing.Ppr
+import           GHC.Driver.CmdLine
+import           GHC.Driver.Monad (modifySession)
+import           GHC.Driver.Ppr
+import           GHC.Driver.Session
+import           GHC.Driver.Env.Types
+import           GHC.Runtime.Context
+import           GHC.Types.Name (pprInfixName)
+import           GHC.Types.Name.Set
+import           GHC.Types.TyThing
+import qualified GHC.Driver.Session as DynFlags
+import qualified GHC.Utils.Outputable as O
+import qualified GHC.Utils.Ppr as Pretty
+#elif MIN_VERSION_ghc(9,0,0)
 import           GHC.Core.InstEnv (is_cls, is_tys)
 import           GHC.Core.Unify
 import           GHC.Core.Ppr.TyThing
@@ -218,7 +234,12 @@ setFlags :: GhcMonad m => [String] -> m [String]
 setFlags ext = do
   -- Try to parse flags.
   flags <- getSessionDynFlags
+#if MIN_VERSION_ghc(9,2,0)
+  logger <- getLogger
+  (flags', unrecognized, warnings) <- parseDynamicFlags logger flags (map noLoc ext)
+#else
   (flags', unrecognized, warnings) <- parseDynamicFlags flags (map noLoc ext)
+#endif
 
   -- First, try to check if this flag matches any extension name.
   let restoredPkgs = flags' { packageFlags = packageFlags flags }
@@ -252,8 +273,13 @@ doc sdoc = do
   let style = O.mkUserStyle unqual O.AllTheWay
 #endif
   let cols = pprCols flags
+#if MIN_VERSION_ghc(9,2,0)
+      d = O.runSDoc sdoc (initSDocContext flags style)
+  return $ Pretty.fullRender (Pretty.PageMode False) cols 1.5 string_txt "" d
+#else
       d = O.runSDoc sdoc (O.initSDocContext flags style)
   return $ Pretty.fullRender Pretty.PageMode cols 1.5 string_txt "" d
+#endif
 
   where
     string_txt :: Pretty.TextDetails -> String -> String
@@ -279,7 +305,12 @@ doc sdoc = do
 initGhci :: GhcMonad m => Maybe String -> m ()
 initGhci sandboxPackages = do
   -- Initialize dyn flags. Start with -XExtendedDefaultRules and -XNoMonomorphismRestriction.
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+  -- We start handling GHC environment files
+  originalFlagsNoPackageEnv <- getSessionDynFlags
+  logger <- getLogger
+  originalFlags <- liftIO $ interpretPackageEnv logger originalFlagsNoPackageEnv
+#elif MIN_VERSION_ghc(9,0,0)
   -- We start handling GHC environment files
   originalFlagsNoPackageEnv <- getSessionDynFlags
   originalFlags <- liftIO $ interpretPackageEnv originalFlagsNoPackageEnv
@@ -302,7 +333,11 @@ initGhci sandboxPackages = do
             in packageDBFlags originalFlags ++ [pkg]
 
   void $ setSessionDynFlags $ dflags
+#if MIN_VERSION_ghc(9,2,0)
+    { backend = Interpreter
+#else
     { hscTarget = HscInterpreted
+#endif
     , ghcLink = LinkInMemory
     , pprCols = 300
     , packageDBFlags = pkgFlags
@@ -394,7 +429,11 @@ evalDeclarations decl = do
   names <- runDecls decl
   cleanUpDuplicateInstances
   flags <- getSessionDynFlags
+#if MIN_VERSION_ghc(9,2,0)
+  return $ map (replace ":Interactive." "" . showPpr flags) names
+#else
   return $ map (replace ":Interactive." "" . O.showPpr flags) names
+#endif
 
 cleanUpDuplicateInstances :: GhcMonad m => m ()
 cleanUpDuplicateInstances = modifySession $ \hscEnv ->
@@ -421,7 +460,11 @@ getType expr = do
   result <- exprType expr
 #endif
   flags <- getSessionDynFlags
+#if MIN_VERSION_ghc(9,2,0)
+  let typeStr = showSDoc flags $ O.ppr result
+#else
   let typeStr = O.showSDocUnqual flags $ O.ppr result
+#endif
   return typeStr
 
 -- | This is unfoldM from monad-loops. It repeatedly runs an IO action until it return Nothing, and

src/tests/IHaskell/Test/Completion.hs

@@ -14,8 +14,13 @@ import           Control.Monad.IO.Class (liftIO)
 import           System.Environment (setEnv)
 import           System.Directory (setCurrentDirectory, getCurrentDirectory)
 
+#if MIN_VERSION_ghc(9,2,0)
+import           GHC (getSessionDynFlags, setSessionDynFlags, DynFlags(..), GhcLink(..), setContext,
+                      parseImportDecl, Backend(..), InteractiveImport(..))
+#else
 import           GHC (getSessionDynFlags, setSessionDynFlags, DynFlags(..), GhcLink(..), setContext,
                       parseImportDecl, HscTarget(..), InteractiveImport(..))
+#endif
 
 import           Test.Hspec
 
@@ -61,7 +66,11 @@ completionHas string expected = do
 initCompleter :: Interpreter ()
 initCompleter = do
   flags <- getSessionDynFlags
+#if MIN_VERSION_ghc(9,2,0)
+  _ <- setSessionDynFlags $ flags { backend = Interpreter, ghcLink = LinkInMemory }
+#else
   _ <- setSessionDynFlags $ flags { hscTarget = HscInterpreted, ghcLink = LinkInMemory }
+#endif
 
   -- Import modules.
   imports <- mapM parseImportDecl

src/tests/IHaskell/Test/Eval.hs

@@ -161,7 +161,10 @@ testEval =
       ":! printf \"hello\\nworld\"" `becomes` ["hello\nworld"]
 
     it "evaluates directives" $ do
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+      -- It's `a` instead of `p`
+      ":typ 3" `becomes` ["3 :: forall {a}. Num a => a"]
+#elif MIN_VERSION_ghc(9,0,0)
       -- brackets around the type variable
       ":typ 3" `becomes` ["3 :: forall {p}. Num p => p"]
 #elif MIN_VERSION_ghc(8,2,0)

src/tests/IHaskell/Test/Parser.hs

@@ -232,7 +232,9 @@ testParseString = describe "Parser" $ do
 #else
     dataKindsError = ParseError (Loc 1 10) msg
 #endif
-#if MIN_VERSION_ghc(8,8,0)
+#if MIN_VERSION_ghc(9,2,0)
+    msg = "Cannot parse data constructor in a data/newtype declaration: 3"
+#elif MIN_VERSION_ghc(8,8,0)
     msg = "Cannot parse data constructor in a data/newtype declaration:\n  3"
 #else
     msg = "Cannot parse data constructor in a data/newtype declaration: 3"