Fix eval plugin

haskell · Nov 22, 2023 · b86b98d · b86b98d
1 parent 7ab7b45
commit b86b98d
Show file tree

Hide file tree

Showing 2 changed files with 24 additions and 5 deletions.
diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs
@@ -116,7 +116,8 @@ import           Ide.Plugin.Eval.Config                       (EvalConfig (..),
 import           Ide.Plugin.Eval.GHC                          (addImport,
                                                                addPackages,
                                                                hasPackage,
-                                                               showDynFlags)
+                                                               showDynFlags,
+                                                               setSessionAndInteractiveDynFlags)
 import           Ide.Plugin.Eval.Parse.Comments               (commentsToSections)
 import           Ide.Plugin.Eval.Parse.Option                 (parseSetFlags)
 import           Ide.Plugin.Eval.Rules                        (queueForEvaluation,
@@ -465,9 +466,7 @@ evals mark_exception (st, fp) df stmts = do
                                 <> T.pack (intercalate ", " $ map SrcLoc.unLoc ignoreds)
                                 ]
                     dbg "post set" $ showDynFlags df'
-                    _ <- setSessionDynFlags df'
-                    sessDyns <- getSessionDynFlags
-                    setInteractiveDynFlags sessDyns
+                    setSessionAndInteractiveDynFlags df'
                     pure $ warnings <> igns
         | -- A type/kind command
           Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =
@@ -689,4 +688,3 @@ parseGhciLikeCmd :: Text -> Maybe (Text, Text)
 parseGhciLikeCmd input = do
     (':', rest) <- T.uncons $ T.stripStart input
     pure $ second T.strip $ T.break isSpace rest
-
diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                 #-}
 {-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving  #-}
@@ -11,6 +12,7 @@ module Ide.Plugin.Eval.GHC (
     addPackages,
     modifyFlags,
     showDynFlags,
+    setSessionAndInteractiveDynFlags,
 ) where
 
 import           Data.List                       (isPrefixOf)
@@ -25,6 +27,12 @@ import           Development.IDE.GHC.Util        (printOutputable)
 import           GHC.LanguageExtensions.Type     (Extension (..))
 import           Ide.Plugin.Eval.Util            (gStrictTry)
 
+#if MIN_VERSION_ghc(9,3,0)
+import           GHC                             (setUnitDynFlags, setTopSessionDynFlags)
+import           GHC.Driver.Session              (getDynFlags)
+import           GHC.Driver.Env
+#endif
+
 {- $setup
 >>> import GHC
 >>> import GHC.Paths
@@ -164,3 +172,16 @@ showDynFlags df =
 
 vList :: [String] -> SDoc
 vList = vcat . map text
+
+setSessionAndInteractiveDynFlags :: DynFlags -> Ghc ()
+setSessionAndInteractiveDynFlags df = do
+#if MIN_VERSION_ghc(9,3,0)
+    _ <- setUnitDynFlags (homeUnitId_ df) df
+    modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ df))
+    df' <- getDynFlags
+    setTopSessionDynFlags df'
+#else
+    _ <- setSessionDynFlags df
+#endif
+    sessDyns <- getSessionDynFlags
+    setInteractiveDynFlags sessDyns