Fix regression in Eval plugin and add test (#2441)

* Fix regression and add test

* Fix tests

Co-authored-by: Javier Neira <[email protected]>
Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>

Author: 3 people

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

@@ -12,6 +12,7 @@
 --   using the "Shaker" abstraction layer for in-memory use.
 --
 module Development.IDE.Core.RuleTypes(
+    GhcSessionDeps(.., GhcSessionDeps),
     module Development.IDE.Core.RuleTypes
     ) where
 
@@ -407,9 +408,15 @@ data GhcSession = GhcSession
 instance Hashable GhcSession
 instance NFData   GhcSession
 
-data GhcSessionDeps = GhcSessionDeps deriving (Eq, Show, Typeable, Generic)
-instance Hashable GhcSessionDeps
-instance NFData   GhcSessionDeps
+newtype GhcSessionDeps = GhcSessionDeps_
+    { -- | Load full ModSummary values in the GHC session.
+        -- Required for interactive evaluation, but leads to more cache invalidations
+        fullModSummary :: Bool
+    }
+    deriving newtype (Eq, Show, Typeable, Hashable, NFData)
+
+pattern GhcSessionDeps :: GhcSessionDeps
+pattern GhcSessionDeps = GhcSessionDeps_ False
 
 data GetModIfaceFromDisk = GetModIfaceFromDisk
     deriving (Eq, Show, Typeable, Generic)

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

@@ -697,22 +697,23 @@ loadGhcSession ghcSessionDepsConfig = do
                 Nothing -> LBS.toStrict $ B.encode (hash (snd val))
         return (Just cutoffHash, val)
 
-    defineNoDiagnostics $ \GhcSessionDeps file -> do
+    defineNoDiagnostics $ \(GhcSessionDeps_ fullModSummary) file -> do
         env <- use_ GhcSession file
-        ghcSessionDepsDefinition ghcSessionDepsConfig env file
+        ghcSessionDepsDefinition fullModSummary ghcSessionDepsConfig env file
 
-data GhcSessionDepsConfig = GhcSessionDepsConfig
+newtype GhcSessionDepsConfig = GhcSessionDepsConfig
     { checkForImportCycles :: Bool
-    , fullModSummary       :: Bool
     }
 instance Default GhcSessionDepsConfig where
   def = GhcSessionDepsConfig
     { checkForImportCycles = True
-    , fullModSummary = False
     }
 
-ghcSessionDepsDefinition :: GhcSessionDepsConfig -> HscEnvEq -> NormalizedFilePath -> Action (Maybe HscEnvEq)
-ghcSessionDepsDefinition GhcSessionDepsConfig{..} env file = do
+ghcSessionDepsDefinition
+    :: -- | full mod summary
+        Bool ->
+        GhcSessionDepsConfig -> HscEnvEq -> NormalizedFilePath -> Action (Maybe HscEnvEq)
+ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do
     let hsc = hscEnv env
 
     mbdeps <- mapM(fmap artifactFilePath . snd) <$> use_ GetLocatedImports file
@@ -724,7 +725,7 @@ ghcSessionDepsDefinition GhcSessionDepsConfig{..} env file = do
                 then uses_ GetModSummary deps
                 else uses_ GetModSummaryWithoutTimestamps deps
 
-            depSessions <- map hscEnv <$> uses_ GhcSessionDeps deps
+            depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps
             ifaces <- uses_ GetModIface deps
 
             let inLoadOrder = map hirHomeMod ifaces

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

@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP             #-}
 {-# LANGUAGE NoApplicativeDo #-}
 {-# LANGUAGE PackageImports  #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# HLINT ignore #-}
 module Development.IDE.Core.Tracing
     ( otTracedHandler

plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs

@@ -49,7 +49,7 @@ import           Development.IDE                 (GetModSummary (..),
                                                   GhcSessionIO (..), IdeState,
                                                   ModSummaryResult (..),
                                                   NeedsCompilation (NeedsCompilation),
-                                                  evalGhcEnv, hscEnv,
+                                                  evalGhcEnv,
                                                   hscEnvWithImportPaths,
                                                   prettyPrint, runAction,
                                                   textToStringBuffer,
@@ -541,9 +541,8 @@ runGetSession st nfp = liftIO $ runAction "eval" st $ do
     let env = fromMaybe (error $ "Unknown file: " <> fp) res
         ghcSessionDepsConfig = def
             { checkForImportCycles = False
-            , fullModSummary = True
             }
-    res <- fmap hscEnvWithImportPaths <$> ghcSessionDepsDefinition ghcSessionDepsConfig env nfp
+    res <- fmap hscEnvWithImportPaths <$> ghcSessionDepsDefinition True ghcSessionDepsConfig env nfp
     return $ fromMaybe (error $ "Unable to load file: " <> fp) res
 
 needsQuickCheck :: [(Section, Test)] -> Bool

plugins/hls-eval-plugin/test/Main.hs

@@ -112,6 +112,7 @@ tests =
   , goldenWithEval "Evaluate expressions in Haddock comments in both single line and multi line format" "THaddock" "hs"
   , goldenWithEval "Compare results (for Haddock tests only)" "TCompare" "hs"
   , goldenWithEval "Local Modules imports are accessible in a test" "TLocalImport" "hs"
+  , goldenWithEval "Transitive local dependency" "TTransitive" "hs"
   -- , goldenWithEval "Local Modules can be imported in a test" "TLocalImportInTest" "hs"
   , goldenWithEval "Setting language option TupleSections" "TLanguageOptionsTupleSections" "hs"
   , goldenWithEval ":set accepts ghci flags" "TFlags" "hs"

plugins/hls-eval-plugin/test/testdata/TLocalImport.expected.hs

@@ -4,3 +4,6 @@ import qualified Util
 
 -- >>> Util.tst 11 11
 -- True
+
+tst' :: Eq a => a -> a -> Bool
+tst' = Util.tst

plugins/hls-eval-plugin/test/testdata/TLocalImport.hs

@@ -3,3 +3,6 @@ module TLocalImport where
 import qualified Util
 
 -- >>> Util.tst 11 11
+
+tst' :: Eq a => a -> a -> Bool
+tst' = Util.tst

plugins/hls-eval-plugin/test/testdata/TTransitive.expected.hs

@@ -0,0 +1,6 @@
+module TTransitive where
+
+import TLocalImport
+
+-- >>> tst' 11 11
+-- True

plugins/hls-eval-plugin/test/testdata/TTransitive.hs

@@ -0,0 +1,5 @@
+module TTransitive where
+
+import TLocalImport
+
+-- >>> tst' 11 11