From d00e385942a90e7e0600ee878db5d6c9120a6558 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Sun, 13 Oct 2024 12:16:15 +0200 Subject: fix race on repository watch --- backend/app/Main.hs | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) (limited to 'backend/app/Main.hs') diff --git a/backend/app/Main.hs b/backend/app/Main.hs index c31ea7d..917a6d9 100644 --- a/backend/app/Main.hs +++ b/backend/app/Main.hs @@ -13,7 +13,7 @@ import Control.Concurrent import Control.Concurrent.STM import Control.Exception (throwIO) import Control.Monad -import Control.Monad.Catch (Exception) +import Control.Monad.Catch (Exception, SomeException, catch, displayException) import Control.Monad.Trans (liftIO) import Data.Aeson qualified as J import Data.Aeson.KeyMap qualified as JM @@ -127,13 +127,22 @@ watch repoT root ref = do addWatch i [Create, MoveIn] ".git/refs/heads" $ \e -> do when (e.filePath == B.fromString (takeBaseName (T.unpack ref))) do atomically (writeTQueue qT e) + repo <- initRepo root ref + atomically do putTMVar repoT repo forever do - repo <- initRepo root ref - atomically do putTMVar repoT repo _ <- atomically do let loop = maybe (pure ()) (const loop) =<< tryReadTQueue qT readTQueue qT >> loop - _ <- atomically do takeTMVar repoT + repo' <- atomically do takeTMVar repoT + catch + ( do + repo <- initRepo root ref + atomically do putTMVar repoT repo + ) + ( \(e :: SomeException) -> do + printf "warning: %s\n" (displayException e) + atomically do putTMVar repoT repo' + ) pure () initRepo :: FilePath -> G.RefName -> IO Repo -- cgit v1.2.3