re-inline the old file instead of loading it twice

Author: soulomoon

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

@@ -772,9 +772,8 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
     -- at a time. Therefore the IORef contains the currently running cradle, if we try
     -- to get some more options then we wait for the currently running action to finish
     -- before attempting to do so.
-    let getOptionsWorker :: FilePath -> IO ()
-        getOptionsWorker file = do
-            logWith recorder Debug (LogGetOptionsLoop file)
+    let getOptions :: FilePath -> IO ()
+        getOptions file = do
             let ncfp = toNormalizedFilePath' file
             cachedHieYamlLocation <- atomically $ STM.lookup ncfp filesMap
             hieYaml <- cradleLoc file
@@ -788,6 +787,14 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
                           -- delete file from pending files
                           S.delete file pendingFileSet
 
+    let getOptionsLoop :: IO ()
+        getOptionsLoop = do
+            -- Get the next file to load
+            absFile <- atomically $ S.readQueue pendingFileSet
+            logWith recorder Debug (LogGetOptionsLoop absFile)
+            getOptions absFile
+            getOptionsLoop
+
     -- | Given a file, this function will return the HscEnv and the dependencies
     -- it would look up the cache first, if the cache is not available, it would
     -- submit a request to the getOptionsLoop to get the options for the file
@@ -813,12 +820,11 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
                 Nothing -> do
                         -- if not ok, we need to reload the session
                         atomically $ S.insert absFile pendingFileSet
-                        -- line up the session to load
-                        atomically $ writeTQueue que (getOptionsWorker absFile)
                         lookupOrWaitCache absFile
 
     -- see Note [Serializing runs in separate thread]
     -- Start the getOptionsLoop if the queue is empty
+    liftIO $ atomically $ Extra.whenM (isEmptyTQueue que) $ writeTQueue que getOptionsLoop
     returnWithVersion $ \file -> do
       let absFile = toAbsolutePath file
       second Map.keys <$> lookupOrWaitCache absFile

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

@@ -1,6 +1,7 @@
 module Development.IDE.Session.OrderedSet where
 
-import           Control.Concurrent.STM        (STM, TQueue, newTQueueIO)
+import           Control.Concurrent.STM        (STM, TQueue, flushTQueue,
+                                                newTQueueIO)
 import           Control.Concurrent.STM.TQueue (readTQueue, writeTQueue)
 import           Control.Monad                 (when)
 import           Data.Hashable                 (Hashable)
@@ -15,7 +16,14 @@ type OrderedSet a = (TQueue a, Set a)
 insert :: Hashable a => a -> OrderedSet a -> STM ()
 insert a (que, s) = do
     (_, inserted) <- S.focus (Focus.testingIfInserts $ Focus.insert ()) a s
-    when inserted $ writeTQueue que a
+    -- if already in the set
+    -- update the position of the element in the queue
+    when (not inserted) $ do
+            items <- filter (==a) <$> flushTQueue que
+            mapM_ (writeTQueue que) items
+            return ()
+    writeTQueue que a
+            -- when que $ writeTQueue que a
 
 newIO :: Hashable a => IO (OrderedSet a)
 newIO = do
@@ -27,7 +35,7 @@ readQueue :: Hashable a => OrderedSet a -> STM a
 readQueue rs@(que, s) = do
                 f <- readTQueue que
                 b <- S.lookup f s
-                -- retry if the file is already in done
+                -- retry if no files are left in the queue
                 if b then return f else readQueue rs
 
 lookup :: Hashable a => a -> OrderedSet a -> STM Bool