From b641f4e669ba3ecb8e89b783cd541a5d392597c0 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sun, 20 Feb 2022 00:59:09 +0100
Subject: [PATCH] Optimize newSTMDisposer

---
 src/Quasar/Resources.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/src/Quasar/Resources.hs b/src/Quasar/Resources.hs
index 1d82df4..342de39 100644
--- a/src/Quasar/Resources.hs
+++ b/src/Quasar/Resources.hs
@@ -39,13 +39,19 @@ import Quasar.Exceptions
 import Quasar.Monad
 import Quasar.Prelude
 import Quasar.Resources.Disposer
+import Quasar.Utils.ShortIO
 
 
 newIODisposer :: IO () -> TIOWorker -> ExceptionChannel -> STM Disposer
 newIODisposer fn worker exChan = newPrimitiveDisposer (forkAsyncShortIO fn exChan) worker exChan
 
 newSTMDisposer :: STM () -> TIOWorker -> ExceptionChannel -> STM Disposer
-newSTMDisposer fn = newIODisposer (atomically fn)
+newSTMDisposer fn worker exChan = newPrimitiveDisposer disposeFn worker exChan
+  where
+    disposeFn :: ShortIO (Awaitable ())
+    disposeFn = unsafeShortIO $ atomically $
+      -- Spawn a thread only if the transaction retries
+      (pure <$> fn) `orElse` forkAsyncSTM (atomically fn) worker exChan
 
 
 registerResource :: (Resource a, MonadQuasar m) => a -> m ()
-- 
GitLab