Preserve import paths for implicit cradles (#768)

* Preserve import paths for implicit cradles

Implicit cradles do not list targets, see discussion in

https://github.com/haskell/ghcide/issues/765

* Really preserve import paths

session-loader/Development/IDE/Session.hs

@@ -212,7 +212,8 @@ loadSession 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 logger hscEnv uids
+          let new_cache = newComponentCache logger isImplicit hscEnv uids
+              isImplicit = isNothing hieYaml
           (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
@@ -369,16 +370,18 @@ setNameCache nc hsc = hsc { hsc_NC = nc }
 -- | Create a mapping from FilePaths to HscEnvEqs
 newComponentCache
          :: Logger
+         -> Bool    -- ^ Is this for an implicit/crappy cradle
          -> HscEnv
          -> [(InstalledUnitId, DynFlags)]
          -> ComponentInfo
          -> IO ([(NormalizedFilePath, (IdeResult HscEnvEq, DependencyInfo))], (IdeResult HscEnvEq, DependencyInfo))
-newComponentCache logger hsc_env uids ci = do
+newComponentCache logger isImplicit hsc_env uids ci = do
     let df = componentDynFlags ci
     let hscEnv' = hsc_env { hsc_dflags = df
                           , hsc_IC = (hsc_IC hsc_env) { ic_dflags = df } }
 
-    henv <- newHscEnvEq hscEnv' uids
+    let newFunc = if isImplicit then newHscEnvEqPreserveImportPaths else newHscEnvEq
+    henv <- newFunc hscEnv' uids
     let res = (([], Just henv), componentDependencyInfo ci)
     logDebug logger ("New Component Cache HscEnvEq: " <> T.pack (show res))
 

src/Development/IDE/GHC/Util.hs

@@ -30,7 +30,7 @@ module Development.IDE.GHC.Util(
     setHieDir,
     dontWriteHieFiles,
     disableWarningsAsErrors,
-    ) where
+    newHscEnvEqPreserveImportPaths) where
 
 import Control.Concurrent
 import Data.List.Extra
@@ -178,24 +178,35 @@ data HscEnvEq = HscEnvEq
                -- ^ In memory components for this HscEnv
                -- This is only used at the moment for the import dirs in
                -- the DynFlags
-    , envImportPaths :: [String]
-        -- ^ Import dirs originally configured in this env
-        --   We remove them to prevent GHC from loading modules on its own
+    , envImportPaths :: Maybe [String]
+        -- ^ If Just, import dirs originally configured in this env
+        --   If Nothing, the env import dirs are unaltered
     }
 
 -- | Wrap an 'HscEnv' into an 'HscEnvEq'.
 newHscEnvEq :: HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq
 newHscEnvEq hscEnv0 deps = do
     envUnique <- newUnique
-    let envImportPaths = importPaths $ hsc_dflags hscEnv0
+    let envImportPaths = Just $ importPaths $ hsc_dflags hscEnv0
         hscEnv = removeImportPaths hscEnv0
     return HscEnvEq{..}
 
+-- | Wrap an 'HscEnv' into an 'HscEnvEq'.
+newHscEnvEqPreserveImportPaths
+    :: HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq
+newHscEnvEqPreserveImportPaths hscEnv deps = do
+    let envImportPaths = Nothing
+    envUnique <- newUnique
+    return HscEnvEq{..}
+
 -- | Unwrap the 'HscEnv' with the original import paths.
 --   Used only for locating imports
 hscEnvWithImportPaths :: HscEnvEq -> HscEnv
-hscEnvWithImportPaths HscEnvEq{..} =
-    hscEnv{hsc_dflags = (hsc_dflags hscEnv){importPaths = envImportPaths}}
+hscEnvWithImportPaths HscEnvEq{..}
+    | Just imps <- envImportPaths
+    = hscEnv{hsc_dflags = (hsc_dflags hscEnv){importPaths = imps}}
+    | otherwise
+    = hscEnv
 
 removeImportPaths :: HscEnv -> HscEnv
 removeImportPaths hsc = hsc{hsc_dflags = (hsc_dflags hsc){importPaths = []}}