diff --git a/ghcide/.hlint.yaml b/ghcide/.hlint.yaml
index 01f035184a4ce1e7b6436ffe2ab14439954a3423..84cd0879a88b2f53d21a107af3461d677ee2fbb1 100644
--- a/ghcide/.hlint.yaml
+++ b/ghcide/.hlint.yaml
@@ -133,7 +133,7 @@
   # Things that are unsafe in Haskell base library
   - {name: unsafeInterleaveIO, within: [Development.IDE.LSP.LanguageServer]}
   - {name: unsafeDupablePerformIO, within: []}
-  - {name: unsafeCoerce, within: [Ide.Plugin.Eval.Code, Development.IDE.Types.Shake]}
+  - {name: unsafeCoerce, within: [Ide.Plugin.Eval.Code, Development.IDE.Core.Compile, Development.IDE.Types.Shake]}
   # Things that are a bit dangerous in the GHC API
   - {name: nameModule, within: []}
 
diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs
index 78af32e8ba33c3d47ddce6ee5e2f70bd85f4d832..1e4f3671402d0bc2f7b75604834f945e348dc490 100644
--- a/ghcide/exe/Main.hs
+++ b/ghcide/exe/Main.hs
@@ -8,6 +8,7 @@ module Main(main) where
 import           Arguments                         (Arguments (..),
                                                     getArguments)
 import           Control.Monad.Extra               (unless, whenJust)
+import           Data.Default                      (def)
 import           Data.Version                      (showVersion)
 import           Development.GitRev                (gitHash)
 import           Development.IDE                   (Priority (Debug, Info),
@@ -60,7 +61,7 @@ main = withTelemetryLogger $ \telemetryLogger -> do
 
         ,Main.argsRules = do
             -- install the main and ghcide-plugin rules
-            mainRule
+            mainRule def
             -- install the kick action, which triggers a typecheck on every
             -- Shake database restart, i.e. on every user edit.
             unless argsDisableKick $
diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal
index a6da170c1413b9894bcf1d75f64bc7a15b49dec8..aa5a0e1b9f640e021cd2a6312fdab7ec061cc604 100644
--- a/ghcide/ghcide.cabal
+++ b/ghcide/ghcide.cabal
@@ -2,7 +2,7 @@ cabal-version:      2.4
 build-type:         Simple
 category:           Development
 name:               ghcide
-version:            1.4.2.3
+version:            1.4.2.4
 license:            Apache-2.0
 license-file:       LICENSE
 author:             Digital Asset and Ghcide contributors
diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs
index 13de867963b22144a72f7507d5176889a00a3609..75d5870e243a05dd20a6a5da7a4199538a726704 100644
--- a/ghcide/src/Development/IDE/Core/Compile.hs
+++ b/ghcide/src/Development/IDE/Core/Compile.hs
@@ -30,7 +30,7 @@ module Development.IDE.Core.Compile
   , setupFinderCache
   , getDocsBatch
   , lookupName
-  ) where
+  ,mergeEnvs) where
 
 import           Development.IDE.Core.Preprocessor
 import           Development.IDE.Core.RuleTypes
@@ -89,8 +89,10 @@ import           System.Directory
 import           System.FilePath
 import           System.IO.Extra                   (fixIO, newTempFileWithin)
 
+-- GHC API imports
 -- GHC API imports
 import           GHC                               (GetDocsFailure (..),
+                                                    mgModSummaries,
                                                     parsedSource)
 
 import           Control.Concurrent.Extra
@@ -100,11 +102,14 @@ import           Data.Binary
 import           Data.Coerce
 import           Data.Functor
 import qualified Data.HashMap.Strict               as HashMap
+import           Data.Map                          (Map)
 import           Data.Tuple.Extra                  (dupe)
 import           Data.Unique                       as Unique
 import           Development.IDE.Core.Tracing      (withTrace)
+import           Development.IDE.GHC.Compat.Util   (emptyUDFM, plusUDFM)
 import qualified Language.LSP.Server               as LSP
 import qualified Language.LSP.Types                as LSP
+import           Unsafe.Coerce
 
 -- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'.
 parseModule
@@ -686,6 +691,30 @@ loadModulesHome mod_infos e =
     where
       mod_name = moduleName . mi_module . hm_iface
 
+-- Merge the HPTs, module graphs and FinderCaches
+mergeEnvs :: HscEnv -> [ModSummary] -> [HomeModInfo] -> [HscEnv] -> IO HscEnv
+mergeEnvs env extraModSummaries extraMods envs = do
+    prevFinderCache <- concatFC <$> mapM (readIORef . hsc_FC) envs
+    let ims  = map (Compat.installedModule (homeUnitId_ $ hsc_dflags env) . moduleName . ms_mod) extraModSummaries
+        ifrs = zipWith (\ms -> InstalledFound (ms_location ms)) extraModSummaries ims
+    newFinderCache <- newIORef $
+            foldl'
+                (\fc (im, ifr) -> Compat.extendInstalledModuleEnv fc im ifr) prevFinderCache
+                $ zip ims ifrs
+    return $ loadModulesHome extraMods $ env{
+        hsc_HPT = foldMapBy plusUDFM emptyUDFM hsc_HPT envs,
+        hsc_FC = newFinderCache,
+        hsc_mod_graph = mkModuleGraph $ extraModSummaries ++ nubOrdOn ms_mod (concatMap (mgModSummaries . hsc_mod_graph) envs)
+    }
+    where
+    -- required because 'FinderCache':
+    --  1) doesn't have a 'Monoid' instance,
+    --  2) is abstract and doesn't export constructors
+    -- To work around this, we coerce to the underlying type
+    -- To remove this, I plan to upstream the missing Monoid instance
+        concatFC :: [FinderCache] -> FinderCache
+        concatFC = unsafeCoerce (mconcat @(Map InstalledModule InstalledFindResult))
+
 withBootSuffix :: HscSource -> ModLocation -> ModLocation
 withBootSuffix HsBootFile = addBootSuffixLocnOut
 withBootSuffix _          = id
diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs
index 6f8900b54e9fd172ca0fae23dffe29145fb11531..5d98fd873b7bca143d4e3fb9bc68e67f9b0e2480 100644
--- a/ghcide/src/Development/IDE/Core/RuleTypes.hs
+++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs
@@ -73,10 +73,6 @@ type instance RuleResult GetParsedModuleWithComments = ParsedModule
 -- a module could not be parsed or an import cycle.
 type instance RuleResult GetDependencyInformation = DependencyInformation
 
--- | Transitive module and pkg dependencies based on the information produced by GetDependencyInformation.
--- This rule is also responsible for calling ReportImportCycles for each file in the transitive closure.
-type instance RuleResult GetDependencies = TransitiveDependencies
-
 type instance RuleResult GetModuleGraph = DependencyInformation
 
 data GetKnownTargets = GetKnownTargets
@@ -234,6 +230,7 @@ type instance RuleResult GetDocMap = DocAndKindMap
 type instance RuleResult GhcSession = HscEnvEq
 
 -- | A GHC session preloaded with all the dependencies
+-- This rule is also responsible for calling ReportImportCycles for the direct dependencies
 type instance RuleResult GhcSessionDeps = HscEnvEq
 
 -- | Resolve the imports in a module to the file path of a module in the same package
@@ -389,11 +386,6 @@ data ReportImportCycles = ReportImportCycles
 instance Hashable ReportImportCycles
 instance NFData   ReportImportCycles
 
-data GetDependencies = GetDependencies
-    deriving (Eq, Show, Typeable, Generic)
-instance Hashable GetDependencies
-instance NFData   GetDependencies
-
 data TypeCheck = TypeCheck
     deriving (Eq, Show, Typeable, Generic)
 instance Hashable TypeCheck
diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs
index 23fa70d3df12b0e89a6e2acb435631c2b6cc985e..1dc0c0f2a20796e0ebfea7e7655dc81e52002104 100644
--- a/ghcide/src/Development/IDE/Core/Rules.hs
+++ b/ghcide/src/Development/IDE/Core/Rules.hs
@@ -11,7 +11,7 @@
 --
 module Development.IDE.Core.Rules(
     -- * Types
-    IdeState, GetDependencies(..), GetParsedModule(..), TransitiveDependencies(..),
+    IdeState, GetParsedModule(..), TransitiveDependencies(..),
     Priority(..), GhcSessionIO(..), GetClientSettings(..),
     -- * Functions
     priorityTypeCheck,
@@ -22,6 +22,7 @@ module Development.IDE.Core.Rules(
     defineNoFile,
     defineEarlyCutOffNoFile,
     mainRule,
+    RulesConfig(..),
     getDependencies,
     getParsedModule,
     getParsedModuleWithComments,
@@ -35,7 +36,6 @@ module Development.IDE.Core.Rules(
     getLocatedImportsRule,
     getDependencyInformationRule,
     reportImportCyclesRule,
-    getDependenciesRule,
     typeCheckRule,
     getDocMapRule,
     loadGhcSession,
@@ -57,6 +57,7 @@ module Development.IDE.Core.Rules(
     ghcSessionDepsDefinition,
     getParsedModuleDefinition,
     typeCheckRuleDefinition,
+    GhcSessionDepsConfig(..),
     ) where
 
 #if !MIN_VERSION_ghc(8,8,0)
@@ -139,8 +140,7 @@ import qualified Language.LSP.Server                          as LSP
 import           Language.LSP.Types                           (SMethod (SCustomMethod))
 import           Language.LSP.VFS
 import           System.Directory                             (canonicalizePath, makeAbsolute)
-
-import           Data.Default                                 (def)
+import           Data.Default                                 (def, Default)
 import           Ide.Plugin.Properties                        (HasProperty,
                                                                KeyNameProxy,
                                                                Properties,
@@ -149,7 +149,6 @@ import           Ide.Plugin.Properties                        (HasProperty,
 import           Ide.PluginUtils                              (configForPlugin)
 import           Ide.Types                                    (DynFlagsModifications (dynFlagsModifyGlobal, dynFlagsModifyParser),
                                                                PluginId)
-import qualified Data.HashSet as HS
 
 -- | This is useful for rules to convert rules that can only produce errors or
 -- a result into the more general IdeResult type that supports producing
@@ -163,7 +162,8 @@ toIdeResult = either (, Nothing) (([],) . Just)
 -- | Get all transitive file dependencies of a given module.
 -- Does not include the file itself.
 getDependencies :: NormalizedFilePath -> Action (Maybe [NormalizedFilePath])
-getDependencies file = fmap transitiveModuleDeps <$> use GetDependencies file
+getDependencies file =
+    fmap transitiveModuleDeps . (`transitiveDeps` file) <$> use_ GetDependencyInformation file
 
 getSourceFileSource :: NormalizedFilePath -> Action BS.ByteString
 getSourceFileSource nfp = do
@@ -334,7 +334,7 @@ getLocatedImportsRule =
                     return $ if itExists then Just nfp' else Nothing
                 | Just tt <- HM.lookup (TargetModule modName) targets = do
                     -- reuse the existing NormalizedFilePath in order to maximize sharing
-                    let ttmap = HM.mapWithKey const (HS.toMap tt)
+                    let ttmap = HM.mapWithKey const (HashSet.toMap tt)
                         nfp' = HM.lookupDefault nfp nfp ttmap
                     itExists <- getFileExists nfp'
                     return $ if itExists then Just nfp' else Nothing
@@ -492,18 +492,6 @@ reportImportCyclesRule =
            pure (moduleNameString . moduleName . ms_mod $ ms)
           showCycle mods  = T.intercalate ", " (map T.pack mods)
 
--- returns all transitive dependencies in topological order.
--- NOTE: result does not include the argument file.
-getDependenciesRule :: Rules ()
-getDependenciesRule =
-    defineEarlyCutoff $ RuleNoDiagnostics $ \GetDependencies file -> do
-        depInfo <- use_ GetDependencyInformation file
-        let allFiles = reachableModules depInfo
-        _ <- uses_ ReportImportCycles allFiles
-        opts <- getIdeOptions
-        let mbFingerprints = map (Util.fingerprintString . fromNormalizedFilePath) allFiles <$ optShakeFiles opts
-        return (fingerprintToBS . Util.fingerprintFingerprints <$> mbFingerprints, transitiveDeps depInfo file)
-
 getHieAstsRule :: Rules ()
 getHieAstsRule =
     define $ \GetHieAst f -> do
@@ -654,8 +642,8 @@ currentLinkables = do
   where
     go (mod, time) = LM time mod []
 
-loadGhcSession :: Rules ()
-loadGhcSession = do
+loadGhcSession :: GhcSessionDepsConfig -> Rules ()
+loadGhcSession ghcSessionDepsConfig = do
     -- This function should always be rerun because it tracks changes
     -- to the version of the collection of HscEnv's.
     defineEarlyCutOffNoFile $ \GhcSessionIO -> do
@@ -691,49 +679,65 @@ loadGhcSession = do
                 Nothing -> LBS.toStrict $ B.encode (hash (snd val))
         return (Just cutoffHash, val)
 
-    define $ \GhcSessionDeps file -> ghcSessionDepsDefinition file
-
-ghcSessionDepsDefinition :: NormalizedFilePath -> Action (IdeResult HscEnvEq)
-ghcSessionDepsDefinition file = do
+    defineNoDiagnostics $ \GhcSessionDeps file -> do
         env <- use_ GhcSession file
-        let hsc = hscEnv env
-        ms <- msrModSummary <$> use_ GetModSummaryWithoutTimestamps file
-        deps <- use_ GetDependencies file
-        let tdeps = transitiveModuleDeps deps
-            uses_th_qq =
-              xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
-            dflags = ms_hspp_opts ms
-        ifaces <- if uses_th_qq
-                  then uses_ GetModIface tdeps
-                  else uses_ GetModIfaceWithoutLinkable tdeps
-
-        -- Currently GetDependencies returns things in topological order so A comes before B if A imports B.
-        -- We need to reverse this as GHC gets very unhappy otherwise and complains about broken interfaces.
-        -- Long-term we might just want to change the order returned by GetDependencies
-        let inLoadOrder = reverse (map hirHomeMod ifaces)
-
-        session' <- liftIO $ loadModulesHome inLoadOrder <$> setupFinderCache (map hirModSummary ifaces) hsc
-
-        res <- liftIO $ newHscEnvEqWithImportPaths (envImportPaths env) session' []
-        return ([], Just res)
+        ghcSessionDepsDefinition ghcSessionDepsConfig env file
+
+data GhcSessionDepsConfig = GhcSessionDepsConfig
+    { checkForImportCycles :: Bool
+    , forceLinkables       :: Bool
+    , fullModSummary       :: Bool
+    }
+instance Default GhcSessionDepsConfig where
+  def = GhcSessionDepsConfig
+    { checkForImportCycles = True
+    , forceLinkables = False
+    , fullModSummary = False
+    }
+
+ghcSessionDepsDefinition :: GhcSessionDepsConfig -> HscEnvEq -> NormalizedFilePath -> Action (Maybe HscEnvEq)
+ghcSessionDepsDefinition GhcSessionDepsConfig{..} env file = do
+    let hsc = hscEnv env
+
+    mbdeps <- mapM(fmap artifactFilePath . snd) <$> use_ GetLocatedImports file
+    case mbdeps of
+        Nothing -> return Nothing
+        Just deps -> do
+            when checkForImportCycles $ void $ uses_ ReportImportCycles deps
+            ms:mss <- map msrModSummary <$> if fullModSummary
+                then uses_ GetModSummary (file:deps)
+                else uses_ GetModSummaryWithoutTimestamps (file:deps)
+
+            depSessions <- map hscEnv <$> uses_ GhcSessionDeps deps
+            let uses_th_qq =
+                    xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
+                dflags = ms_hspp_opts ms
+            ifaces <- if uses_th_qq || forceLinkables
+                        then uses_ GetModIface deps
+                        else uses_ GetModIfaceWithoutLinkable deps
+
+            let inLoadOrder = map hirHomeMod ifaces
+            session' <- liftIO $ mergeEnvs hsc mss inLoadOrder depSessions
+
+            Just <$> liftIO (newHscEnvEqWithImportPaths (envImportPaths env) 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.
 getModIfaceFromDiskRule :: Rules ()
 getModIfaceFromDiskRule = defineEarlyCutoff $ Rule $ \GetModIfaceFromDisk f -> do
   ms <- msrModSummary <$> use_ GetModSummary f
-  (diags_session, mb_session) <- ghcSessionDepsDefinition f
+  mb_session <- use GhcSessionDeps f
   case mb_session of
-    Nothing -> return (Nothing, (diags_session, Nothing))
+    Nothing -> return (Nothing, ([], Nothing))
     Just session -> do
       sourceModified <- use_ IsHiFileStable f
       linkableType <- getLinkableType f
       r <- loadInterface (hscEnv session) ms sourceModified linkableType (regenerateHiFile session f ms)
       case r of
-        (diags, Nothing) -> return (Nothing, (diags ++ diags_session, Nothing))
+        (diags, Nothing) -> return (Nothing, (diags, Nothing))
         (diags, Just x) -> do
           let !fp = Just $! hiFileFingerPrint x
-          return (fp, (diags <> diags_session, Just x))
+          return (fp, (diags, Just x))
 
 -- | Check state of hiedb after loading an iface from disk - have we indexed the corresponding `.hie` file?
 -- This function is responsible for ensuring database consistency
@@ -1055,9 +1059,18 @@ writeHiFileAction hsc hiFile = do
         resetInterfaceStore extras $ toNormalizedFilePath' targetPath
         writeHiFile hsc hiFile
 
+data RulesConfig = RulesConfig
+    { -- | Disable import cycle checking for improved performance in large codebases
+      checkForImportCycles :: Bool
+    -- | Disable TH for improved performance in large codebases
+    , enableTemplateHaskell :: Bool
+    }
+
+instance Default RulesConfig where def = RulesConfig True True
+
 -- | A rule that wires per-file rules together
-mainRule :: Rules ()
-mainRule = do
+mainRule :: RulesConfig -> Rules ()
+mainRule RulesConfig{..} = do
     linkables <- liftIO $ newVar emptyModuleEnv
     addIdeGlobal $ CompiledLinkables linkables
     getParsedModuleRule
@@ -1065,10 +1078,9 @@ mainRule = do
     getLocatedImportsRule
     getDependencyInformationRule
     reportImportCyclesRule
-    getDependenciesRule
     typeCheckRule
     getDocMapRule
-    loadGhcSession
+    loadGhcSession def{checkForImportCycles}
     getModIfaceFromDiskRule
     getModIfaceFromDiskAndIndexRule
     getModIfaceRule
@@ -1086,8 +1098,10 @@ mainRule = do
     --   * ObjectLinkable -> BCOLinkable : the prev linkable can be reused,  signal "no change"
     --   * Object/BCO -> NoLinkable      : the prev linkable can be ignored, signal "no change"
     --   * otherwise                     : the prev linkable cannot be reused, signal "value has changed"
-    defineEarlyCutoff $ RuleWithCustomNewnessCheck (<=) $ \NeedsCompilation file ->
-        needsCompilationRule file
+    if enableTemplateHaskell
+      then defineEarlyCutoff $ RuleWithCustomNewnessCheck (<=) $ \NeedsCompilation file ->
+                needsCompilationRule file
+      else defineNoDiagnostics $ \NeedsCompilation _ -> return $ Just Nothing
     generateCoreRule
     getImportMapRule
     getAnnotatedParsedSourceRule
diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs
index d36ad94bc8d9ee53cc641d627516a0d8901b099f..61f8d82644f55feb418705217e778c4c0db6bf98 100644
--- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs
+++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs
@@ -45,6 +45,7 @@ module Development.IDE.GHC.Compat.Units (
     ExternalPackageState(..),
     -- * Utils
     filterInplaceUnits,
+    FinderCache,
     ) where
 
 #if MIN_VERSION_ghc(9,0,0)
@@ -53,6 +54,7 @@ import qualified GHC.Data.ShortText              as ST
 import           GHC.Driver.Env                  (hsc_unit_dbs)
 import           GHC.Unit.Env
 import           GHC.Unit.External
+import           GHC.Unit.Finder
 #else
 import           GHC.Driver.Types
 #endif
diff --git a/ghcide/src/Development/IDE/GHC/Compat/Util.hs b/ghcide/src/Development/IDE/GHC/Compat/Util.hs
index 198a94c03b418fd250888f16db68a9f8e5bb8fb3..0b1ff0f6c01b8a13ca01b635a4d7fcd040607575 100644
--- a/ghcide/src/Development/IDE/GHC/Compat/Util.hs
+++ b/ghcide/src/Development/IDE/GHC/Compat/Util.hs
@@ -59,6 +59,9 @@ module Development.IDE.GHC.Compat.Util (
     Unique,
     mkUnique,
     newTagUnique,
+    -- * UniqDFM
+    emptyUDFM,
+    plusUDFM,
     -- * String Buffer
     StringBuffer(..),
     hGetStringBuffer,
@@ -76,6 +79,7 @@ import           GHC.Data.Maybe
 import           GHC.Data.Pair
 import           GHC.Data.StringBuffer
 import           GHC.Types.Unique
+import           GHC.Types.Unique.DFM
 import           GHC.Utils.Fingerprint
 import           GHC.Utils.Misc
 import           GHC.Utils.Outputable    (pprHsString)
@@ -94,6 +98,7 @@ import           Pair
 import           Outputable              (pprHsString)
 import           Panic                   hiding (try)
 import           StringBuffer
+import           UniqDFM
 import           Unique
 import           Util
 #endif
diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs
index 9e58cbd0f6a3b34144d68c99af5d1849b0600883..6f85af7678a49edfc792292fbe5ebc8d807d7d6e 100644
--- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs
+++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs
@@ -327,6 +327,7 @@ immediateReverseDependencies file DependencyInformation{..} = do
   FilePathId cur_id <- lookupPathToId depPathIdMap file
   return $ map (idToPath depPathIdMap . FilePathId) (maybe mempty IntSet.toList (IntMap.lookup cur_id depReverseModuleDeps))
 
+-- | returns all transitive dependencies in topological order.
 transitiveDeps :: DependencyInformation -> NormalizedFilePath -> Maybe TransitiveDependencies
 transitiveDeps DependencyInformation{..} file = do
   let !fileId = pathToId depPathIdMap file
diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs
index a732fcd6fba2536618edc2f873c93860b0d6e4cb..f35c45d5266d5ce6733d1c56b5e66de5cb919030 100644
--- a/ghcide/src/Development/IDE/Main.hs
+++ b/ghcide/src/Development/IDE/Main.hs
@@ -187,7 +187,7 @@ defaultArguments priority = Arguments
         { argsOTMemoryProfiling = False
         , argCommand = LSP
         , argsLogger = stderrLogger priority
-        , argsRules = mainRule >> action kick
+        , argsRules = mainRule def >> action kick
         , argsGhcidePlugin = mempty
         , argsHlsPlugins = pluginDescToIdePlugins Ghcide.descriptors
         , argsSessionLoadingOptions = def
diff --git a/ghcide/src/Development/IDE/Plugin/Test.hs b/ghcide/src/Development/IDE/Plugin/Test.hs
index 881aed4406c6afd2900defbba40936e05bfe5600..14e861f38be9c39c0d5482266497890b7d781b52 100644
--- a/ghcide/src/Development/IDE/Plugin/Test.hs
+++ b/ghcide/src/Development/IDE/Plugin/Test.hs
@@ -150,7 +150,6 @@ parseAction "getparsedmodule" fp = Right . isJust <$> use GetParsedModule fp
 parseAction "ghcsession" fp = Right . isJust <$> use GhcSession fp
 parseAction "ghcsessiondeps" fp = Right . isJust <$> use GhcSessionDeps fp
 parseAction "gethieast" fp = Right . isJust <$> use GetHieAst fp
-parseAction "getDependencies" fp = Right . isJust <$> use GetDependencies fp
 parseAction "getFileContents" fp = Right . isJust <$> use GetFileContents fp
 parseAction other _ = return $ Left $ "Cannot parse ide rule: " <> pack (original other)
 
diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
index 14fa2f6a8a8cef5a06ef72aab5e55614b26a27f9..d021feea4908bbb9f6df7c0f47d2aaa8d701ead7 100644
--- a/ghcide/test/exe/Main.hs
+++ b/ghcide/test/exe/Main.hs
@@ -410,6 +410,30 @@ diagnosticTests = testGroup "diagnostics"
           , [(DsError, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")]
           )
         ]
+  , testSession' "deeply nested cyclic module dependency" $ \path -> do
+      let contentA = unlines
+            [ "module ModuleA where" , "import ModuleB" ]
+      let contentB = unlines
+            [ "module ModuleB where" , "import ModuleA" ]
+      let contentC = unlines
+            [ "module ModuleC where" , "import ModuleB" ]
+      let contentD = T.unlines
+            [ "module ModuleD where" , "import ModuleC" ]
+          cradle =
+            "cradle: {direct: {arguments: [ModuleA, ModuleB, ModuleC, ModuleD]}}"
+      liftIO $ writeFile (path </> "ModuleA.hs") contentA
+      liftIO $ writeFile (path </> "ModuleB.hs") contentB
+      liftIO $ writeFile (path </> "ModuleC.hs") contentC
+      liftIO $ writeFile (path </> "hie.yaml") cradle
+      _ <- createDoc "ModuleD.hs" "haskell" contentD
+      expectDiagnostics
+        [ ( "ModuleA.hs"
+          , [(DsError, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")]
+          )
+        , ( "ModuleB.hs"
+          , [(DsError, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")]
+          )
+        ]
   , testSessionWait "cyclic module dependency with hs-boot" $ do
       let contentA = T.unlines
             [ "module ModuleA where"
@@ -669,9 +693,9 @@ diagnosticTests = testGroup "diagnostics"
       expectDiagnostics [("Foo.hs", [(DsError, (1,7), "Could not find module 'MissingModule'")])]
 
   , testGroup "Cancellation"
-    [ cancellationTestGroup "edit header" editHeader yesDepends yesSession noParse  noTc
-    , cancellationTestGroup "edit import" editImport noDepends  noSession  yesParse noTc
-    , cancellationTestGroup "edit body"   editBody   yesDepends yesSession yesParse yesTc
+    [ cancellationTestGroup "edit header" editHeader yesSession noParse  noTc
+    , cancellationTestGroup "edit import" editImport noSession  yesParse noTc
+    , cancellationTestGroup "edit body"   editBody   yesSession yesParse yesTc
     ]
   ]
   where
@@ -685,17 +709,14 @@ diagnosticTests = testGroup "diagnostics"
       noParse = False
       yesParse = True
 
-      noDepends = False
-      yesDepends = True
-
       noSession = False
       yesSession = True
 
       noTc = False
       yesTc = True
 
-cancellationTestGroup :: TestName -> (TextDocumentContentChangeEvent, TextDocumentContentChangeEvent) -> Bool -> Bool -> Bool -> Bool -> TestTree
-cancellationTestGroup name edits dependsOutcome sessionDepsOutcome parseOutcome tcOutcome = testGroup name
+cancellationTestGroup :: TestName -> (TextDocumentContentChangeEvent, TextDocumentContentChangeEvent) -> Bool -> Bool -> Bool -> TestTree
+cancellationTestGroup name edits sessionDepsOutcome parseOutcome tcOutcome = testGroup name
     [ cancellationTemplate edits Nothing
     , cancellationTemplate edits $ Just ("GetFileContents", True)
     , cancellationTemplate edits $ Just ("GhcSession", True)
@@ -704,7 +725,6 @@ cancellationTestGroup name edits dependsOutcome sessionDepsOutcome parseOutcome
     , cancellationTemplate edits $ Just ("GetModSummaryWithoutTimestamps", True)
       -- getLocatedImports never fails
     , cancellationTemplate edits $ Just ("GetLocatedImports", True)
-    , cancellationTemplate edits $ Just ("GetDependencies", dependsOutcome)
     , cancellationTemplate edits $ Just ("GhcSessionDeps", sessionDepsOutcome)
     , cancellationTemplate edits $ Just ("GetParsedModule", parseOutcome)
     , cancellationTemplate edits $ Just ("TypeCheck", tcOutcome)
@@ -3843,9 +3863,6 @@ checkFileCompiles fp diag =
 pluginSimpleTests :: TestTree
 pluginSimpleTests =
   ignoreInWindowsForGHC88And810 $
-#if __GLASGOW_HASKELL__ == 810 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 5
-  expectFailBecause "known broken for ghc 8.10.5 (see GHC #19763)" $
-#endif
   testSessionWithExtraFiles "plugin-knownnat" "simple plugin" $ \dir -> do
     _ <- openDoc (dir </> "KnownNat.hs") "haskell"
     liftIO $ writeFile (dir</>"hie.yaml")
diff --git a/plugins/hls-eval-plugin/hls-eval-plugin.cabal b/plugins/hls-eval-plugin/hls-eval-plugin.cabal
index e37acde140c5d1df747324a8021f4d5e70dc89a5..e3114e165626cadb1e3e6fd8a3ac60f5568545b1 100644
--- a/plugins/hls-eval-plugin/hls-eval-plugin.cabal
+++ b/plugins/hls-eval-plugin/hls-eval-plugin.cabal
@@ -55,6 +55,7 @@ library
     , aeson
     , base                  >=4.12  && <5
     , containers
+    , data-default
     , deepseq
     , Diff                  ^>=0.4.0
     , directory
@@ -64,7 +65,7 @@ library
     , ghc
     , ghc-boot-th
     , ghc-paths
-    , ghcide                >=1.2   && <1.5
+    , ghcide                >=1.4.2.4 && <1.5
     , hashable
     , hls-graph
     , hls-plugin-api        ^>=1.2
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 41dea1bd482f283a668d838e31a4d022a38b3839..ef9541eba0c923e40ce085a04e083ff015a584e5 100644
--- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs
+++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs
@@ -27,7 +27,7 @@ module Ide.Plugin.Eval.CodeLens (
 
 import           Control.Applicative             (Alternative ((<|>)))
 import           Control.Arrow                   (second, (>>>))
-import           Control.Exception               (assert, try)
+import           Control.Exception               (try)
 import qualified Control.Exception               as E
 import           Control.Lens                    (_1, _3, (%~), (<&>), (^.))
 import           Control.Monad                   (guard, join, void, when)
@@ -35,33 +35,29 @@ import           Control.Monad.IO.Class          (MonadIO (liftIO))
 import           Control.Monad.Trans.Except      (ExceptT (..))
 import           Data.Aeson                      (toJSON)
 import           Data.Char                       (isSpace)
+import           Data.Default
 import qualified Data.HashMap.Strict             as HashMap
 import           Data.List                       (dropWhileEnd, find,
                                                   intercalate, intersperse)
-import           Data.Maybe                      (catMaybes, fromMaybe, isJust)
+import           Data.Maybe                      (catMaybes, fromMaybe)
 import           Data.String                     (IsString)
 import           Data.Text                       (Text)
 import qualified Data.Text                       as T
 import           Data.Time                       (getCurrentTime)
 import           Data.Typeable                   (Typeable)
-import           Development.IDE                 (Action, GetDependencies (..),
-                                                  GetModIface (..),
-                                                  GetModSummary (..),
-                                                  GhcSessionIO (..),
-                                                  HiFileResult (hirHomeMod, hirModSummary),
-                                                  HscEnvEq, IdeState,
+import           Development.IDE                 (GetModSummary (..),
+                                                  GhcSessionIO (..), IdeState,
                                                   ModSummaryResult (..),
                                                   NeedsCompilation (NeedsCompilation),
-                                                  evalGhcEnv,
+                                                  evalGhcEnv, hscEnv,
                                                   hscEnvWithImportPaths,
                                                   prettyPrint, runAction,
                                                   textToStringBuffer,
                                                   toNormalizedFilePath',
                                                   uriToFilePath', useNoFile_,
-                                                  useWithStale_, use_, uses_)
-import           Development.IDE.Core.Compile    (loadModulesHome,
-                                                  setupFinderCache)
-import           Development.IDE.Core.Rules      (TransitiveDependencies (transitiveModuleDeps))
+                                                  useWithStale_, use_)
+import           Development.IDE.Core.Rules      (GhcSessionDepsConfig (..),
+                                                  ghcSessionDepsDefinition)
 import           Development.IDE.GHC.Compat      hiding (typeKind, unitState)
 import qualified Development.IDE.GHC.Compat      as Compat
 import qualified Development.IDE.GHC.Compat      as SrcLoc
@@ -533,30 +529,23 @@ prettyWarn Warn{..} =
     prettyPrint (SrcLoc.getLoc warnMsg) <> ": warning:\n"
     <> "    " <> SrcLoc.unLoc warnMsg
 
-ghcSessionDepsDefinition :: HscEnvEq -> NormalizedFilePath -> Action HscEnv
-ghcSessionDepsDefinition env file = do
-        let hsc = hscEnvWithImportPaths env
-        deps <- use_ GetDependencies file
-        let tdeps = transitiveModuleDeps deps
-        ifaces <- uses_ GetModIface tdeps
-        liftIO $ assert (all (isJust . hm_linkable . hirHomeMod) ifaces) $ pure ()
-
-        -- Currently GetDependencies returns things in topological order so A comes before B if A imports B.
-        -- We need to reverse this as GHC gets very unhappy otherwise and complains about broken interfaces.
-        -- Long-term we might just want to change the order returned by GetDependencies
-        let inLoadOrder = reverse (map hirHomeMod ifaces)
-
-        liftIO $ loadModulesHome inLoadOrder <$> setupFinderCache (map hirModSummary ifaces) hsc
-
 runGetSession :: MonadIO m => IdeState -> NormalizedFilePath -> m HscEnv
 runGetSession st nfp = liftIO $ runAction "eval" st $ do
     -- Create a new GHC Session rather than reusing an existing one
     -- to avoid interfering with ghcide
+    -- UPDATE: I suspect that this doesn't really work, we always get the same Session
+    --         we probably cache hscEnvs in the Session state
     IdeGhcSession{loadSessionFun} <- useNoFile_ GhcSessionIO
     let fp = fromNormalizedFilePath nfp
     ((_, res),_) <- liftIO $ loadSessionFun fp
-    let hscEnv = fromMaybe (error $ "Unknown file: " <> fp) res
-    ghcSessionDepsDefinition hscEnv nfp
+    let env = fromMaybe (error $ "Unknown file: " <> fp) res
+        ghcSessionDepsConfig = def
+            { forceLinkables = True
+            , checkForImportCycles = False
+            , fullModSummary = True
+            }
+    res <- fmap hscEnvWithImportPaths <$> ghcSessionDepsDefinition ghcSessionDepsConfig env nfp
+    return $ fromMaybe (error $ "Unable to load file: " <> fp) res
 
 needsQuickCheck :: [(Section, Test)] -> Bool
 needsQuickCheck = any (isProperty . snd)