From dcd2163d81f4bb3228203598a761b005c54b1796 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 8 Dec 2021 01:26:01 +0000 Subject: [PATCH] Fix regression in Eval plugin and add test (#2441) * Fix regression and add test * Fix tests Co-authored-by: Javier Neira Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com> --- ghcide/src/Development/IDE/Core/RuleTypes.hs | 13 ++++++++++--- ghcide/src/Development/IDE/Core/Rules.hs | 17 +++++++++-------- ghcide/src/Development/IDE/Core/Tracing.hs | 1 + .../src/Ide/Plugin/Eval/CodeLens.hs | 5 ++--- plugins/hls-eval-plugin/test/Main.hs | 1 + .../test/testdata/TLocalImport.expected.hs | 3 +++ .../test/testdata/TLocalImport.hs | 3 +++ .../test/testdata/TTransitive.expected.hs | 6 ++++++ .../test/testdata/TTransitive.hs | 5 +++++ 9 files changed, 40 insertions(+), 14 deletions(-) create mode 100644 plugins/hls-eval-plugin/test/testdata/TTransitive.expected.hs create mode 100644 plugins/hls-eval-plugin/test/testdata/TTransitive.hs diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 53f66ee7e3..fb4738c83e 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/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) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 6707d44163..91932459be 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/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 diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs index 39fde44191..d4bc94b09e 100644 --- a/ghcide/src/Development/IDE/Core/Tracing.hs +++ b/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 diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 744d039542..5ecbab38b6 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/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 diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs index 2e66d599c1..6c69dbbaa7 100644 --- a/plugins/hls-eval-plugin/test/Main.hs +++ b/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" diff --git a/plugins/hls-eval-plugin/test/testdata/TLocalImport.expected.hs b/plugins/hls-eval-plugin/test/testdata/TLocalImport.expected.hs index b01851afb4..39d10a9a4c 100644 --- a/plugins/hls-eval-plugin/test/testdata/TLocalImport.expected.hs +++ b/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 diff --git a/plugins/hls-eval-plugin/test/testdata/TLocalImport.hs b/plugins/hls-eval-plugin/test/testdata/TLocalImport.hs index 38d2d0bcc0..73e327c489 100644 --- a/plugins/hls-eval-plugin/test/testdata/TLocalImport.hs +++ b/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 diff --git a/plugins/hls-eval-plugin/test/testdata/TTransitive.expected.hs b/plugins/hls-eval-plugin/test/testdata/TTransitive.expected.hs new file mode 100644 index 0000000000..13dc64b913 --- /dev/null +++ b/plugins/hls-eval-plugin/test/testdata/TTransitive.expected.hs @@ -0,0 +1,6 @@ +module TTransitive where + +import TLocalImport + +-- >>> tst' 11 11 +-- True diff --git a/plugins/hls-eval-plugin/test/testdata/TTransitive.hs b/plugins/hls-eval-plugin/test/testdata/TTransitive.hs new file mode 100644 index 0000000000..39d54c3ed0 --- /dev/null +++ b/plugins/hls-eval-plugin/test/testdata/TTransitive.hs @@ -0,0 +1,5 @@ +module TTransitive where + +import TLocalImport + +-- >>> tst' 11 11