dont wrap action with hiedb retry on the writer side, give hiedb retry wrapper to action instead

Author: eddiemundo

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

@@ -253,7 +253,7 @@ runWithDb logger fp k = do
       _ <- garbageCollectTypeNames db
       forever $ do
         k <- atomically $ readTQueue chan
-        retryOnSqliteBusy logger db oneSecond oneMillisecond maxRetryCount rng k
+        k (retryOnSqliteBusy logger db oneSecond oneMillisecond maxRetryCount rng)
           `Safe.catch` \e@SQLError{} -> do
             logDebug logger $ T.pack $ "SQLite error in worker, ignoring: " ++ show e
           `Safe.catchAny` \e -> do

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

@@ -521,7 +521,7 @@ indexHieFile se mod_summary srcPath !hash hf = do
       -- hiedb doesn't use the Haskell src, so we clear it to avoid unnecessarily keeping it around
       let !hf' = hf{hie_hs_src = mempty}
       modifyTVar' indexPending $ HashMap.insert srcPath hash
-      writeTQueue indexQueue $ \db -> do
+      writeTQueue indexQueue $ \withHieDb -> do
         -- We are now in the worker thread
         -- Check if a newer index of this file has been scheduled, and if so skip this one
         newerScheduled <- atomically $ do
@@ -532,7 +532,7 @@ indexHieFile se mod_summary srcPath !hash hf = do
             Just pendingHash -> pendingHash /= hash
         unless newerScheduled $ do
           pre optProgressStyle
-          addRefsFromLoaded db targetPath (RealFile $ fromNormalizedFilePath srcPath) hash hf'
+          withHieDb (\db -> HieDb.addRefsFromLoaded db targetPath (HieDb.RealFile $ fromNormalizedFilePath srcPath) hash hf')
           post
   where
     mod_location    = ms_location mod_summary

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

@@ -294,7 +294,7 @@ setSomethingModified state keys reason = do
         fail "setSomethingModified can't be called on this type of VFSHandle"
     -- Update database to remove any files that might have been renamed/deleted
     atomically $ do
-        writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) deleteMissingRealFiles
+        writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles)
         modifyTVar' (dirtyKeys $ shakeExtras state) $ \x ->
             foldl' (flip HSet.insert) x keys
     void $ restartShakeSession (shakeExtras state) reason []

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

@@ -183,7 +183,9 @@ data HieDbWriter
   }
 
 -- | Actions to queue up on the index worker thread
-type IndexQueue = TQueue (HieDb -> IO ())
+-- The inner `(HieDb -> IO ()) -> IO ()` wraps `HieDb -> IO ()`
+-- with (currently) retry functionality
+type IndexQueue = TQueue (((HieDb -> IO ()) -> IO ()) -> IO ())
 
 -- | Intended to represent HieDb calls wrapped with (currently) retry
 -- functionality