Unify defintions of ghcSessionDeps

Author: pepeiborra

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

@@ -689,27 +689,29 @@ loadGhcSession = do
                 Nothing -> LBS.toStrict $ B.encode (hash (snd val))
         return (Just cutoffHash, val)
 
-    defineNoDiagnostics $ \GhcSessionDeps file -> Just <$> ghcSessionDepsDefinition file
-
-ghcSessionDepsDefinition :: NormalizedFilePath -> Action HscEnvEq
-ghcSessionDepsDefinition file = do
+    defineNoDiagnostics $ \GhcSessionDeps file -> do
         env <- use_ GhcSession file
-        let hsc = hscEnv env
-        deps <- mapMaybe (fmap artifactFilePath . snd) <$> use_ GetLocatedImports file
-        ms:mss <- map msrModSummary <$> 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
-                  then uses_ GetModIface deps
-                  else uses_ GetModIfaceWithoutLinkable deps
-
-        let inLoadOrder = map hirHomeMod ifaces
-        session' <- liftIO $ mergeEnvs hsc mss inLoadOrder depSessions
-
-        liftIO $ newHscEnvEqWithImportPaths (envImportPaths env) session' []
+        Just <$> ghcSessionDepsDefinition False env file
+
+ghcSessionDepsDefinition :: Bool -> HscEnvEq -> NormalizedFilePath -> Action HscEnvEq
+ghcSessionDepsDefinition forceLinkable env file = do
+    let hsc = hscEnv env
+    deps <- mapMaybe (fmap artifactFilePath . snd) <$> use_ GetLocatedImports file
+    _ <- uses_ ReportImportCycles deps
+    ms:mss <- map msrModSummary <$> 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 || forceLinkable
+                then uses_ GetModIface deps
+                else uses_ GetModIfaceWithoutLinkable deps
+
+    let inLoadOrder = map hirHomeMod ifaces
+    session' <- liftIO $ mergeEnvs hsc mss inLoadOrder depSessions
+
+    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.

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

@@ -52,7 +52,7 @@ import           Development.IDE                 (Action, GetDependencies (..),
                                                   HscEnvEq, IdeState,
                                                   ModSummaryResult (..),
                                                   NeedsCompilation (NeedsCompilation),
-                                                  evalGhcEnv,
+                                                  evalGhcEnv, hscEnv,
                                                   hscEnvWithImportPaths,
                                                   prettyPrint, runAction,
                                                   textToStringBuffer,
@@ -61,7 +61,8 @@ import           Development.IDE                 (Action, GetDependencies (..),
                                                   useWithStale_, use_, uses_)
 import           Development.IDE.Core.Compile    (loadModulesHome,
                                                   setupFinderCache)
-import           Development.IDE.Core.Rules      (TransitiveDependencies (transitiveModuleDeps))
+import           Development.IDE.Core.Rules      (TransitiveDependencies (transitiveModuleDeps),
+                                                  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 +534,17 @@ 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
+    hscEnv <$> ghcSessionDepsDefinition False env nfp
 
 needsQuickCheck :: [(Section, Test)] -> Bool
 needsQuickCheck = any (isProperty . snd)