Add ShakeExtras arg to newHscEnvEq

Author: nlander

ghcide/session-loader/Development/IDE/Session.hs

@@ -585,7 +585,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
 
           -- New HscEnv for the component in question, returns the new HscEnvEq and
           -- a mapping from FilePath to the newly created HscEnvEq.
-          let new_cache = newComponentCache recorder optExtensions hieYaml _cfp hscEnv uids
+          let new_cache = newComponentCache recorder extras optExtensions hieYaml _cfp hscEnv uids
           (cs, res) <- new_cache new
           -- Modified cache targets for everything else in the hie.yaml file
           -- which now uses the same EPS and so on
@@ -793,14 +793,15 @@ setNameCache nc hsc = hsc { hsc_NC = nc }
 -- | Create a mapping from FilePaths to HscEnvEqs
 newComponentCache
          :: Recorder (WithPriority Log)
+         -> ShakeExtras
          -> [String]       -- File extensions to consider
          -> Maybe FilePath -- Path to cradle
          -> NormalizedFilePath -- Path to file that caused the creation of this component
          -> HscEnv
          -> [(UnitId, DynFlags)]
          -> ComponentInfo
          -> IO ( [TargetDetails], (IdeResult HscEnvEq, DependencyInfo))
-newComponentCache recorder exts cradlePath cfp hsc_env uids ci = do
+newComponentCache recorder extras exts cradlePath cfp hsc_env uids ci = do
     let df = componentDynFlags ci
     hscEnv' <-
 #if MIN_VERSION_ghc(9,3,0)
@@ -823,7 +824,7 @@ newComponentCache recorder exts cradlePath cfp hsc_env uids ci = do
 #endif
 
     let newFunc = maybe newHscEnvEqPreserveImportPaths newHscEnvEq cradlePath
-    henv <- newFunc hscEnv' uids
+    henv <- newFunc extras hscEnv' uids
     let targetEnv = ([], Just henv)
         targetDepends = componentDependencyInfo ci
         res = (targetEnv, targetDepends)

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

@@ -31,7 +31,7 @@ import           Development.IDE.GHC.CoreFile
 import           Development.IDE.GHC.Util
 import           Development.IDE.Graph
 import           Development.IDE.Import.DependencyInformation
-import           Development.IDE.Types.HscEnvEq               (HscEnvEq)
+import {-# SOURCE #-} Development.IDE.Types.HscEnvEq          (HscEnvEq)
 import           Development.IDE.Types.KnownTargets
 import           GHC.Generics                                 (Generic)
 

ghcide/src/Development/IDE/Types/HscEnvEq.hs

@@ -22,6 +22,7 @@ import           Data.Set                        (Set)
 import qualified Data.Set                        as Set
 import           Data.Unique                     (Unique)
 import qualified Data.Unique                     as Unique
+import           Development.IDE.Core.Shake      (ShakeExtras)
 import           Development.IDE.GHC.Compat
 import qualified Development.IDE.GHC.Compat.Util as Maybes
 import           Development.IDE.GHC.Error       (catchSrcErrors)
@@ -59,19 +60,19 @@ updateHscEnvEq oldHscEnvEq newHscEnv = do
   update <$> Unique.newUnique
 
 -- | Wrap an 'HscEnv' into an 'HscEnvEq'.
-newHscEnvEq :: FilePath -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
-newHscEnvEq cradlePath hscEnv0 deps = do
+newHscEnvEq :: FilePath -> ShakeExtras -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
+newHscEnvEq cradlePath se hscEnv0 deps = do
     let relativeToCradle = (takeDirectory cradlePath </>)
         hscEnv = removeImportPaths hscEnv0
 
     -- Make Absolute since targets are also absolute
     importPathsCanon <-
       mapM makeAbsolute $ relativeToCradle <$> importPaths (hsc_dflags hscEnv0)
 
-    newHscEnvEqWithImportPaths (Just $ Set.fromList importPathsCanon) hscEnv deps
+    newHscEnvEqWithImportPaths (Just $ Set.fromList importPathsCanon) se hscEnv deps
 
-newHscEnvEqWithImportPaths :: Maybe (Set FilePath) -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
-newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do
+newHscEnvEqWithImportPaths :: Maybe (Set FilePath) -> ShakeExtras -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
+newHscEnvEqWithImportPaths envImportPaths se hscEnv deps = do
 
     let dflags = hsc_dflags hscEnv
 
@@ -115,7 +116,7 @@ newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do
 
 -- | Wrap an 'HscEnv' into an 'HscEnvEq'.
 newHscEnvEqPreserveImportPaths
-    :: HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
+    :: ShakeExtras -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
 newHscEnvEqPreserveImportPaths = newHscEnvEqWithImportPaths Nothing
 
 -- | Unwrap the 'HscEnv' with the original import paths.

ghcide/src/Development/IDE/Types/HscEnvEq.hs-boot

@@ -0,0 +1,26 @@
+module Development.IDE.Types.HscEnvEq (HscEnvEq) where
+
+import           Data.Set                        (Set)
+import           Data.Unique                     (Unique)
+import           Development.IDE.GHC.Compat
+import           Development.IDE.Types.Exports   (ExportsMap)
+
+-- | An 'HscEnv' with equality. Two values are considered equal
+--   if they are created with the same call to 'newHscEnvEq'.
+data HscEnvEq = HscEnvEq
+    { envUnique             :: !Unique
+    , hscEnv                :: !HscEnv
+    , deps                  :: [(UnitId, DynFlags)]
+               -- ^ In memory components for this HscEnv
+               -- This is only used at the moment for the import dirs in
+               -- the DynFlags
+    , envImportPaths        :: Maybe (Set FilePath)
+        -- ^ 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
+    }