Use the HscEnv after summarising the module

ghcide-test/data/plugin-parser/cabal.project

@@ -0,0 +1,2 @@
+packages: ./plugin
+          ./usage

ghcide-test/data/plugin-parser/plugin/Plugin.hs

@@ -0,0 +1,37 @@
+{-# LANGUAGE RecordWildCards #-}
+module Plugin (plugin) where
+
+import Control.Monad.IO.Class (MonadIO (..))
+import Data.Foldable          (for_)
+import Data.List              (foldl')
+import Data.List.NonEmpty     (NonEmpty (..))
+import Data.Traversable       (for)
+
+import qualified Data.Generics as SYB
+
+import qualified GHC.Plugins  as GHC
+import           GHC
+
+plugin :: GHC.Plugin
+plugin = GHC.defaultPlugin
+    { GHC.parsedResultAction = \_cliOptions -> pluginImpl
+    }
+
+pluginImpl :: GHC.ModSummary -> GHC.ParsedResult -> GHC.Hsc GHC.ParsedResult
+pluginImpl _modSummary pm = do
+    let m = GHC.parsedResultModule pm
+    hpm_module' <- transform (GHC.hpm_module m)
+    let module' = m { GHC.hpm_module = hpm_module' }
+    return pm { GHC.parsedResultModule = module' }
+
+transform
+    :: GHC.Located (HsModule GhcPs)
+    -> GHC.Hsc (GHC.Located (HsModule GhcPs))
+transform = SYB.everywhereM (SYB.mkM transform') where
+    transform' :: LHsExpr GhcPs -> GHC.Hsc (LHsExpr GhcPs)
+    transform' expr@(L srcSpan (HsVar _ lvar)) =
+        if GHC.occNameString (GHC.occName $ GHC.unLoc lvar) == "pluginConstant"
+            then return (nlHsIntLit 0x42)
+            else return expr
+    transform' expr =
+        return expr

ghcide-test/data/plugin-parser/plugin/plugin.cabal

@@ -0,0 +1,9 @@
+cabal-version:  1.18
+name: plugin
+version: 1.0.0
+build-type: Simple
+
+library
+  build-depends: base, ghc, syb
+  exposed-modules: Plugin
+  hs-source-dirs: .

ghcide-test/data/plugin-parser/usage/File1.hs

@@ -0,0 +1,6 @@
+{-# OPTIONS_GHC -Wall #-}
+module File1 where
+
+import File2
+
+bar = foo * foo

ghcide-test/data/plugin-parser/usage/File2.hs

@@ -0,0 +1,4 @@
+module File2 where
+
+foo :: Int
+foo = pluginConstant

ghcide-test/data/plugin-parser/usage/usage.cabal

@@ -0,0 +1,10 @@
+cabal-version:  1.18
+name: usage
+version: 1.0.0
+build-type: Simple
+
+library
+  build-depends: base, plugin
+  exposed-modules: File1 File2
+  ghc-options: -fplugin Plugin
+  hs-source-dirs: .

ghcide-test/exe/PluginSimpleTests.hs

@@ -2,7 +2,6 @@
 module PluginSimpleTests (tests) where
 
 import           Config
-import           Control.Monad.IO.Class      (liftIO)
 import           Development.IDE.Test        (expectDiagnostics)
 import           Language.LSP.Protocol.Types hiding (SemanticTokenAbsolute (..),
                                               SemanticTokenRelative (..),
@@ -11,37 +10,70 @@ import           Language.LSP.Test
 import           System.FilePath
 import           Test.Hls.FileSystem
 import           Test.Tasty
+import qualified Test.Hls.FileSystem as FS
 
 tests :: TestTree
-tests =
-  -- Build profile: -w ghc-9.4.2 -O1
-  -- In order, the following will be built (use -v for more details):
-  -- - ghc-typelits-natnormalise-0.7.7 (lib) (requires build)
-  -- - ghc-typelits-knownnat-0.7.7 (lib) (requires build)
-  -- - plugin-1.0.0 (lib) (first run)
-  -- Starting     ghc-typelits-natnormalise-0.7.7 (lib)
-  -- Building     ghc-typelits-natnormalise-0.7.7 (lib)
-
-  -- Failed to build ghc-typelits-natnormalise-0.7.7.
-  -- Build log (
-  -- C:\cabal\logs\ghc-9.4.2\ghc-typelits-_-0.7.7-3f036a52a0d9bfc3389d1852a87da2e87c6de2e4.log
-  -- ):
-  -- Preprocessing library for ghc-typelits-natnormalise-0.7.7..
-  -- Building library for ghc-typelits-natnormalise-0.7.7..
-  -- [1 of 3] Compiling GHC.TypeLits.Normalise.SOP ( src\GHC\TypeLits\Normalise\SOP.hs, dist\build\GHC\TypeLits\Normalise\SOP.o )
-  -- [2 of 3] Compiling GHC.TypeLits.Normalise.Unify ( src\GHC\TypeLits\Normalise\Unify.hs, dist\build\GHC\TypeLits\Normalise\Unify.o )
-  -- [3 of 3] Compiling GHC.TypeLits.Normalise ( src-ghc-9.4\GHC\TypeLits\Normalise.hs, dist\build\GHC\TypeLits\Normalise.o )
-  -- C:\tools\ghc-9.4.2\lib\../mingw/bin/llvm-ar.exe: error: dist\build\objs-5156\libHSghc-typelits-_-0.7.7-3f036a52a0d9bfc3389d1852a87da2e87c6de2e4.a: No such file or directory
-
-  -- Error: cabal: Failed to build ghc-typelits-natnormalise-0.7.7 (which is
-  -- required by plugin-1.0.0). See the build log above for details.
-  testWithExtraFiles "simple plugin"  "plugin-knownnat" $ \dir -> do
-    _ <- openDoc (dir </> "KnownNat.hs") "haskell"
-    liftIO $ atomicFileWriteString (dir</>"hie.yaml")
-      "cradle: {cabal: [{path: '.', component: 'lib:plugin'}]}"
-
-    expectDiagnostics
-      [ ( "KnownNat.hs",
-          [(DiagnosticSeverity_Error, (9, 15), "Variable not in scope: c", Just "GHC-88464")]
-          )
-      ]
+tests = testGroup "ghc-plugins"
+  [
+    -- Build profile: -w ghc-9.4.2 -O1
+    -- In order, the following will be built (use -v for more details):
+    -- - ghc-typelits-natnormalise-0.7.7 (lib) (requires build)
+    -- - ghc-typelits-knownnat-0.7.7 (lib) (requires build)
+    -- - plugin-1.0.0 (lib) (first run)
+    -- Starting     ghc-typelits-natnormalise-0.7.7 (lib)
+    -- Building     ghc-typelits-natnormalise-0.7.7 (lib)
+
+    -- Failed to build ghc-typelits-natnormalise-0.7.7.
+    -- Build log (
+    -- C:\cabal\logs\ghc-9.4.2\ghc-typelits-_-0.7.7-3f036a52a0d9bfc3389d1852a87da2e87c6de2e4.log
+    -- ):
+    -- Preprocessing library for ghc-typelits-natnormalise-0.7.7..
+    -- Building library for ghc-typelits-natnormalise-0.7.7..
+    -- [1 of 3] Compiling GHC.TypeLits.Normalise.SOP ( src\GHC\TypeLits\Normalise\SOP.hs, dist\build\GHC\TypeLits\Normalise\SOP.o )
+    -- [2 of 3] Compiling GHC.TypeLits.Normalise.Unify ( src\GHC\TypeLits\Normalise\Unify.hs, dist\build\GHC\TypeLits\Normalise\Unify.o )
+    -- [3 of 3] Compiling GHC.TypeLits.Normalise ( src-ghc-9.4\GHC\TypeLits\Normalise.hs, dist\build\GHC\TypeLits\Normalise.o )
+    -- C:\tools\ghc-9.4.2\lib\../mingw/bin/llvm-ar.exe: error: dist\build\objs-5156\libHSghc-typelits-_-0.7.7-3f036a52a0d9bfc3389d1852a87da2e87c6de2e4.a: No such file or directory
+
+    -- Error: cabal: Failed to build ghc-typelits-natnormalise-0.7.7 (which is
+    -- required by plugin-1.0.0). See the build log above for details.
+    testWithDummyPlugin "simple plugin" pluginKnownNatVfs $ do
+      _ <- openDoc "KnownNat.hs" "haskell"
+
+      expectDiagnostics
+        [ ( "KnownNat.hs",
+            [(DiagnosticSeverity_Error, (9, 15), "Variable not in scope: c", Just "GHC-88464")]
+            )
+        ]
+  , testWithDummyPlugin "simple parser plugin" pluginParsreVfs $ do
+      _ <- openDoc "usage/File1.hs" "haskell"
+
+      expectDiagnostics
+        [ ( ("usage" </> "File1.hs"),
+            [(DiagnosticSeverity_Warning, (5, 0), "Top-level binding with no type signature: bar :: Int", Just "GHC-38417")]
+            )
+        ]
+  ]
+
+pluginKnownNatVfs :: VirtualFileTree
+pluginKnownNatVfs = FS.mkVirtualFileTree ("ghcide-test" </> "data" </> "plugin-knownnat") $
+  FS.simpleCabalProject
+    [ "cabal.project"
+    , "KnownNat.hs"
+    , "plugin.cabal"
+    ]
+
+pluginParsreVfs :: VirtualFileTree
+pluginParsreVfs = FS.mkVirtualFileTree ("ghcide-test" </> "data" </> "plugin-parser") $
+  [ simpleCabalCradle
+  , copy "cabal.project"
+  , directory "plugin"
+    [ copy "plugin/Plugin.hs"
+    , copy "plugin/plugin.cabal"
+    ]
+  , directory "usage"
+    [ copy "usage/File1.hs"
+    , copy "usage/File2.hs"
+    , copy "usage/usage.cabal"
+    ]
+  ]
+

ghcide/src/Development/IDE/Core/Rules.hs

@@ -744,18 +744,20 @@
     :: -- | full mod summary
         Bool ->
         GhcSessionDepsConfig -> HscEnvEq -> NormalizedFilePath -> Action (Maybe HscEnvEq)
-ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do
-    let hsc = hscEnv env
-
+ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} hscEnvEq file = do
     mbdeps <- mapM(fmap artifactFilePath . snd) <$> use_ GetLocatedImports file
     case mbdeps of
         Nothing -> return Nothing
         Just deps -> do
             when fullModuleGraph $ void $ use_ ReportImportCycles file
-            ms <- msrModSummary <$> if fullModSummary
+            msr <- if fullModSummary
                 then use_ GetModSummary file
                 else use_ GetModSummaryWithoutTimestamps file
-
+            let
+                ms = msrModSummary msr
+                -- This `HscEnv` has its plugins initialized in `parsePragmasIntoHscEnv`
+                -- Fixes the bug in #4631
+                env = msrHscEnv msr
             depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps
             ifaces <- uses_ GetModIface deps
             let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces
@@ -775,14 +777,14 @@
                       nubOrdOn mkNodeKey (ModuleNode final_deps ms : concatMap mgModSummaries' mgs)
                 liftIO $ evaluate $ liftRnf rwhnf module_graph_nodes
                 return $ mkModuleGraph module_graph_nodes
-            session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions
+            session' <- liftIO $ mergeEnvs env mg de ms inLoadOrder depSessions
 
             -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new
             -- ExportsMap when it is called. We only need to create the ExportsMap once per
             -- session, while `ghcSessionDepsDefinition` will be called for each file we need
             -- to compile. `updateHscEnvEq` will refresh the HscEnv (session') and also
             -- generate a new Unique.
-            Just <$> liftIO (updateHscEnvEq env session')
+            Just <$> liftIO (updateHscEnvEq hscEnvEq session')
 
 -- | Load a iface from disk, or generate it if there isn't one or it is out of date
 -- This rule also ensures that the `.hie` and `.o` (if needed) files are written out.
@@ -803,7 +805,7 @@
             { source_version = ver
             , old_value = m_old
             , get_file_version = use GetModificationTime_{missingFileDiagnostics = False}
             , get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs
             , get_module_graph = useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph f
             , regenerate = regenerateHiFile session f ms
             }