WIP fix: do not check for file existance when added to the context and

add all alternate file to knownFiles

This need to be investigated.

The different `-boot` tests are flaky / failing in this MR because of
this.

Author: guibou

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

@@ -124,6 +124,9 @@ import           GHC.Driver.Errors.Types
 import           GHC.Types.Error                     (errMsgDiagnostic,
                                                       singleMessage)
 import           GHC.Unit.State
+import Debug.Trace (traceShow)
+import Text.Pretty.Simple (pPrint)
+import Debug.Pretty.Simple (pTraceShow, pTraceShowId)
 
 #if MIN_VERSION_ghc(9,13,0)
 import           GHC.Driver.Make                     (checkHomeUnitsClosed)
@@ -476,11 +479,11 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
                 -- If we don't generate a TargetFile for each potential location, we will only have
                 -- 'TargetFile Foo.hs' in the 'knownTargetsVar', thus not find 'TargetFile Foo.hs-boot'
                 -- and also not find 'TargetModule Foo'.
-                fs <- filterM (IO.doesFileExist . fromNormalizedFilePath) targetLocations
-                pure $ map (\fp -> (TargetFile fp, Set.singleton fp)) (nubOrd (f:fs))
+                pure $ do
+                  file <- nubOrd (f:targetLocations)
+                  pure $ (TargetFile file, Set.singleton file)
               TargetModule _ -> do
-                found <- filterM (IO.doesFileExist . fromNormalizedFilePath) targetLocations
-                return [(targetTarget, Set.fromList found)]
+                pure [(targetTarget, Set.fromList targetLocations)]
           hasUpdate <- atomically $ do
             known <- readTVar knownTargetsVar
             let known' = flip mapHashed known $ \k -> unionKnownTargets k (mkKnownTargets knownTargets)
@@ -544,9 +547,9 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
               pure (Map.insert hieYaml (NE.toList all_deps) m, (new,old))
 
 
-    let session :: (Maybe FilePath, NormalizedFilePath, ComponentOptions, FilePath)
+    let sessionTortue :: (Maybe FilePath, NormalizedFilePath, ComponentOptions, FilePath)
                 -> IO (IdeResult HscEnvEq,[FilePath])
-        session args@(hieYaml, _cfp, _opts, _libDir) = do
+        sessionTortue args@(hieYaml, _cfp, _opts, _libDir) = do
           (new_deps, old_deps) <- packageSetup args
 
           -- For each component, now make a new HscEnvEq which contains the
@@ -574,13 +577,13 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
                                          ])
                                        Nothing
 
-          void $ modifyVar' fileToFlags $ Map.insert hieYaml this_flags_map
+          void $ modifyVar' fileToFlags $ pTraceShow ("this_flags_map", this_flags_map) $ Map.insert hieYaml this_flags_map
           void $ modifyVar' filesMap $ flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets))
           -- The VFS doesn't change on cradle edits, re-use the old one.
           -- Invalidate all the existing GhcSession build nodes by restarting the Shake session
           keys2 <- invalidateShakeCache
           restartShakeSession VFSUnmodified "new component" [] $ do
-            keys1 <- extendKnownTargets all_targets
+            keys1 <- extendKnownTargets $ pTraceShow ("all_targets", all_targets) all_targets
             return [keys1, keys2]
 
           -- Typecheck all files in the project on startup
@@ -630,15 +633,15 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
                  ((runTime, _):_)
                    | compileTime == runTime -> do
                      atomicModifyIORef' cradle_files (\xs -> (cfp:xs,()))
-                     session (hieYaml, toNormalizedFilePath' cfp, opts, libDir)
+                     sessionTortue (hieYaml, toNormalizedFilePath' cfp, opts, libDir)
                    | otherwise -> return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[])
              -- Failure case, either a cradle error or the none cradle
              Left err -> do
                dep_info <- getDependencyInfo (maybeToList hieYaml)
                let ncfp = toNormalizedFilePath' cfp
                let res = (map (\err' -> renderCradleError err' cradle ncfp) err, Nothing)
                void $ modifyVar' fileToFlags $
-                    Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info))
+                    Map.insertWith HM.union hieYaml (pTraceShow ("ncfp", ncfp) $ HM.singleton ncfp (res, dep_info))
                void $ modifyVar' filesMap $ HM.insert ncfp hieYaml
                return (res, maybe [] pure hieYaml ++ concatMap cradleErrorDependencies err)
 
@@ -676,9 +679,11 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
 
           v <- Map.findWithDefault HM.empty hieYaml <$> readVar fileToFlags
           let cfp = toAbsolutePath file
+          pPrint ("sessionOpts", cfp)
           case HM.lookup (toNormalizedFilePath' cfp) v of
             Just (opts, old_di) -> do
               deps_ok <- checkDependencyInfo old_di
+              pPrint ("deps_ok", deps_ok, old_di)
               if not deps_ok
                 then do
                   -- If the dependencies are out of date then clear both caches and start
@@ -687,9 +692,12 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
                   modifyVar_ filesMap (const (return HM.empty))
                   -- Keep the same name cache
                   modifyVar_ hscEnvs (return . Map.adjust (const []) hieYaml )
+                  pPrint ("consultCradle not deps_ok", cfp)
                   consultCradle hieYaml cfp
                 else return (opts, Map.keys old_di)
-            Nothing -> consultCradle hieYaml cfp
+            Nothing -> do
+              pPrint ("consultCradle Nothing", cfp)
+              consultCradle hieYaml cfp
 
     -- The main function which gets options for a file. We only want one of these running
     -- at a time. Therefore the IORef contains the currently running cradle, if we try
@@ -764,6 +772,7 @@ data TargetDetails = TargetDetails
       targetDepends   :: !DependencyInfo,
       targetLocations :: ![NormalizedFilePath]
   }
+  deriving (Show)
 
 fromTargetId :: [FilePath]          -- ^ import paths
              -> [String]            -- ^ extensions to consider