diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index a672b5aea8..09d3012b98 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -83,7 +83,7 @@ produceCompletions = do case (global, inScope) of ((_, Just globalEnv), (_, Just inScopeEnv)) -> do let uri = fromNormalizedUri $ normalizedFilePathToUri file - cdata <- liftIO $ cacheDataProducer uri env (ms_mod ms) globalEnv inScopeEnv imps parsedDeps + cdata <- liftIO $ cacheDataProducer uri sess (ms_mod ms) globalEnv inScopeEnv imps parsedDeps return ([], Just cdata) (_diag, _) -> return ([], Nothing) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index b8832bab93..1e9ca2d20c 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -27,7 +27,6 @@ import HscTypes import Name import RdrName import Type -import Packages #if MIN_GHC_API_VERSION(8,10,0) import Predicate (isDictTy) import Pair @@ -59,6 +58,7 @@ import Data.Functor import Ide.PluginUtils (mkLspCommand) import Ide.Types (CommandId (..), PluginId, WithSnippets (..)) import Control.Monad +import Development.IDE.Types.HscEnvEq -- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs @@ -294,9 +294,10 @@ mkPragmaCompl label insertText = Nothing Nothing Nothing Nothing Nothing -cacheDataProducer :: Uri -> HscEnv -> Module -> GlobalRdrEnv-> GlobalRdrEnv -> [LImportDecl GhcPs] -> [ParsedModule] -> IO CachedCompletions -cacheDataProducer uri packageState curMod globalEnv inScopeEnv limports deps = do - let dflags = hsc_dflags packageState +cacheDataProducer :: Uri -> HscEnvEq -> Module -> GlobalRdrEnv-> GlobalRdrEnv -> [LImportDecl GhcPs] -> [ParsedModule] -> IO CachedCompletions +cacheDataProducer uri env curMod globalEnv inScopeEnv limports deps = do + let + packageState = hscEnv env curModName = moduleName curMod importMap = Map.fromList [ (getLoc imp, imp) | imp <- limports ] @@ -309,8 +310,6 @@ cacheDataProducer uri packageState curMod globalEnv inScopeEnv limports deps = d -- Full canonical names of imported modules importDeclerations = map unLoc limports - -- The list of all importable Modules from all packages - moduleNames = map showModName (listVisibleModuleNames dflags) -- The given namespaces for the imported modules (ie. full name, or alias if used) allModNamesAsNS = map (showModName . asNamespace) importDeclerations @@ -366,6 +365,9 @@ cacheDataProducer uri packageState curMod globalEnv inScopeEnv limports deps = d (unquals,quals) <- getCompls rdrElts + -- The list of all importable Modules from all packages + moduleNames <- maybe [] (map showModName) <$> envVisibleModuleNames env + return $ CC { allModNamesAsNS = allModNamesAsNS , unqualCompls = unquals diff --git a/ghcide/src/Development/IDE/Types/HscEnvEq.hs b/ghcide/src/Development/IDE/Types/HscEnvEq.hs index fdf29426a5..9a907149ff 100644 --- a/ghcide/src/Development/IDE/Types/HscEnvEq.hs +++ b/ghcide/src/Development/IDE/Types/HscEnvEq.hs @@ -6,6 +6,7 @@ module Development.IDE.Types.HscEnvEq newHscEnvEqWithImportPaths, envImportPaths, envPackageExports, + envVisibleModuleNames, deps ) where @@ -16,7 +17,7 @@ import Development.Shake.Classes import Module (InstalledUnitId) import System.Directory (canonicalizePath) import Development.IDE.GHC.Compat -import GhcPlugins(HscEnv (hsc_dflags), PackageState (explicitPackages), InstalledPackageInfo (exposedModules), Module(..), packageConfigId) +import GhcPlugins(HscEnv (hsc_dflags), PackageState (explicitPackages), InstalledPackageInfo (exposedModules), Module(..), packageConfigId, listVisibleModuleNames) import System.FilePath import Development.IDE.GHC.Util (lookupPackageConfig) import Control.Monad.IO.Class @@ -27,7 +28,10 @@ import OpenTelemetry.Eventlog (withSpan) import Control.Monad.Extra (mapMaybeM, join, eitherM) import Control.Concurrent.Extra (newVar, modifyVar) import Control.Concurrent.Async (Async, async, waitCatch) -import Control.Exception (throwIO, mask) +import Control.Exception (throwIO, mask, evaluate) +import Development.IDE.GHC.Error (catchSrcErrors) +import Control.DeepSeq (force) +import Data.Either (fromRight) -- | An 'HscEnv' with equality. Two values are considered equal -- if they are created with the same call to 'newHscEnvEq'. @@ -42,6 +46,11 @@ data HscEnvEq = HscEnvEq -- ^ If Just, import dirs originally configured in this env -- If Nothing, the env import dirs are unaltered , envPackageExports :: IO ExportsMap + , envVisibleModuleNames :: IO (Maybe [ModuleName]) + -- ^ 'listVisibleModuleNames' is a pure function, + -- but it could panic due to a ghc bug: https://github.com/haskell/haskell-language-server/issues/1365 + -- So it's wrapped in IO here for error handling + -- If Nothing, 'listVisibleModuleNames' panic } -- | Wrap an 'HscEnv' into an 'HscEnvEq'. @@ -58,12 +67,15 @@ newHscEnvEq cradlePath hscEnv0 deps = do newHscEnvEqWithImportPaths :: Maybe [String] -> HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do + + let dflags = hsc_dflags hscEnv + envUnique <- newUnique -- it's very important to delay the package exports computation envPackageExports <- onceAsync $ withSpan "Package Exports" $ \_sp -> do -- compute the package imports - let pkgst = pkgState (hsc_dflags hscEnv) + let pkgst = pkgState dflags depends = explicitPackages pkgst targets = [ (pkg, mn) @@ -82,6 +94,15 @@ newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do Maybes.Succeeded mi -> Just mi modIfaces <- mapMaybeM doOne targets return $ createExportsMap modIfaces + + -- similar to envPackageExports, evaluated lazily + envVisibleModuleNames <- onceAsync $ + fromRight Nothing + <$> catchSrcErrors + dflags + "listVisibleModuleNames" + (evaluate . force . Just $ listVisibleModuleNames dflags) + return HscEnvEq{..} -- | Wrap an 'HscEnv' into an 'HscEnvEq'. @@ -108,8 +129,8 @@ instance Eq HscEnvEq where a == b = envUnique a == envUnique b instance NFData HscEnvEq where - rnf (HscEnvEq a b c d _) = - -- deliberately skip the package exports map + rnf (HscEnvEq a b c d _ _) = + -- deliberately skip the package exports map and visible module names rnf (hashUnique a) `seq` b `seq` c `seq` rnf d instance Hashable HscEnvEq where