refactor session loading to wait for pending files before cache check

Author: soulomoon

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

@@ -799,8 +799,11 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
     let lookupOrWaitCache :: FilePath -> IO (IdeResult HscEnvEq, DependencyInfo)
         lookupOrWaitCache absFile = do
             let ncfp = toNormalizedFilePath' absFile
-            -- check if in the cache
-            res <- atomically $ checkInCache ncfp
+            res <- atomically $ do
+                -- wait until target file is not in pendingFiles
+                Extra.whenM (S.lookup absFile pendingFileSet) STM.retry
+                -- check if in the cache
+                checkInCache ncfp
             logWith recorder Info $ LogLookupSessionCache absFile
             updateDateRes <-  case res of
                     Just r -> do
@@ -814,8 +817,6 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
                 Nothing -> do
                         -- if not ok, we need to reload the session
                         atomically $ S.insert absFile pendingFileSet
-                        -- wait until pendingFiles is not in pendingFiles
-                        atomically $ Extra.whenM (S.lookup absFile pendingFileSet) STM.retry
                         lookupOrWaitCache absFile
 
     -- see Note [Serializing runs in separate thread]

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

@@ -2,7 +2,9 @@ module Development.IDE.Session.OrderedSet where
 
 import           Control.Concurrent.STM        (STM, TQueue, newTQueueIO)
 import           Control.Concurrent.STM.TQueue (readTQueue, writeTQueue)
+import           Control.Monad                 (when)
 import           Data.Hashable                 (Hashable)
+import qualified Focus
 import qualified ListT                         as LT
 import qualified StmContainers.Set             as S
 import           StmContainers.Set             (Set)
@@ -12,9 +14,8 @@ type OrderedSet a = (TQueue a, Set a)
 
 insert :: Hashable a => a -> OrderedSet a -> STM ()
 insert a (que, s) = do
-    S.insert a s
-    writeTQueue que a
-    return ()
+    (_, inserted) <- S.focus (Focus.testingIfInserts $ Focus.insert ()) a s
+    when inserted $ writeTQueue que a
 
 newIO :: Hashable a => IO (OrderedSet a)
 newIO = do