From 6111302e6288b8e213976671317a96d7bfcb49e3 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sun, 20 Feb 2022 00:34:08 +0100
Subject: [PATCH] Align function names
---
src/Quasar/Async/Fork.hs | 48 +++++++++++++++++++++++-----------------
src/Quasar/Async/V2.hs | 24 +++++++++++++-------
src/Quasar/Resources.hs | 2 +-
3 files changed, 45 insertions(+), 29 deletions(-)
diff --git a/src/Quasar/Async/Fork.hs b/src/Quasar/Async/Fork.hs
index aef8816..787db63 100644
--- a/src/Quasar/Async/Fork.hs
+++ b/src/Quasar/Async/Fork.hs
@@ -1,16 +1,18 @@
module Quasar.Async.Fork (
-- * Forking with an asynchronous exception channel
-- ** STM
- fork,
- fork_,
- forkWithUnmask,
- forkWithUnmask_,
+ forkSTM,
+ forkSTM_,
+ forkWithUnmaskSTM,
+ forkWithUnmaskSTM_,
+ forkAsyncSTM,
+ forkAsyncWithUnmaskSTM,
-- ** ShortIO
forkWithUnmaskShortIO,
forkWithUnmaskShortIO_,
- startIOThreadShortIO,
- startIOThreadWithUnmaskShortIO,
+ forkAsyncShortIO,
+ forkAsyncWithUnmaskShortIO,
) where
import Control.Concurrent (ThreadId)
@@ -25,18 +27,25 @@ import Quasar.Utils.ShortIO
-- * Fork in STM (with ExceptionChannel)
-fork :: IO () -> TIOWorker -> ExceptionChannel -> STM (Awaitable ThreadId)
-fork fn = forkWithUnmask (\unmask -> unmask fn)
+forkSTM :: IO () -> TIOWorker -> ExceptionChannel -> STM (Awaitable ThreadId)
+forkSTM fn = forkWithUnmaskSTM (\unmask -> unmask fn)
-fork_ :: IO () -> TIOWorker -> ExceptionChannel -> STM ()
-fork_ fn worker exChan = void $ fork fn worker exChan
+forkSTM_ :: IO () -> TIOWorker -> ExceptionChannel -> STM ()
+forkSTM_ fn worker exChan = void $ forkSTM fn worker exChan
-forkWithUnmask :: ((forall a. IO a -> IO a) -> IO ()) -> TIOWorker -> ExceptionChannel -> STM (Awaitable ThreadId)
-forkWithUnmask fn worker exChan = startShortIO (forkWithUnmaskShortIO fn exChan) worker exChan
+forkWithUnmaskSTM :: ((forall a. IO a -> IO a) -> IO ()) -> TIOWorker -> ExceptionChannel -> STM (Awaitable ThreadId)
+forkWithUnmaskSTM fn worker exChan = startShortIO (forkWithUnmaskShortIO fn exChan) worker exChan
-forkWithUnmask_ :: ((forall a. IO a -> IO a) -> IO ()) -> TIOWorker -> ExceptionChannel -> STM ()
-forkWithUnmask_ fn worker exChan = void $ forkWithUnmask fn worker exChan
+forkWithUnmaskSTM_ :: ((forall a. IO a -> IO a) -> IO ()) -> TIOWorker -> ExceptionChannel -> STM ()
+forkWithUnmaskSTM_ fn worker exChan = void $ forkWithUnmaskSTM fn worker exChan
+
+
+forkAsyncSTM :: forall a. IO a -> TIOWorker -> ExceptionChannel -> STM (Awaitable a)
+forkAsyncSTM fn worker exChan = join <$> startShortIO (forkAsyncShortIO fn exChan) worker exChan
+
+forkAsyncWithUnmaskSTM :: forall a. ((forall b. IO b -> IO b) -> IO a) -> TIOWorker -> ExceptionChannel -> STM (Awaitable a)
+forkAsyncWithUnmaskSTM fn worker exChan = join <$> startShortIO (forkAsyncWithUnmaskShortIO fn exChan) worker exChan
-- * Fork in ShortIO (with ExceptionChannel)
@@ -55,8 +64,11 @@ forkWithUnmaskShortIO_ fn exChan = void $ forkWithUnmaskShortIO fn exChan
-- * Fork in ShortIO while collecting the result (with ExceptionChannel)
-startIOThreadWithUnmaskShortIO :: forall a. ((forall b. IO b -> IO b) -> IO a) -> ExceptionChannel -> ShortIO (Awaitable a)
-startIOThreadWithUnmaskShortIO fn exChan = do
+forkAsyncShortIO :: forall a. IO a -> ExceptionChannel -> ShortIO (Awaitable a)
+forkAsyncShortIO fn = forkAsyncWithUnmaskShortIO ($ fn)
+
+forkAsyncWithUnmaskShortIO :: forall a. ((forall b. IO b -> IO b) -> IO a) -> ExceptionChannel -> ShortIO (Awaitable a)
+forkAsyncWithUnmaskShortIO fn exChan = do
resultVar <- newAsyncVarShortIO
forkWithUnmaskShortIO_ (runAndPut resultVar) exChan
pure $ toAwaitable resultVar
@@ -72,7 +84,3 @@ startIOThreadWithUnmaskShortIO fn exChan = do
failAsyncVar_ resultVar (AsyncException ex)
Right retVal -> do
putAsyncVar_ resultVar retVal
-
-
-startIOThreadShortIO :: forall a. IO a -> ExceptionChannel -> ShortIO (Awaitable a)
-startIOThreadShortIO fn = startIOThreadWithUnmaskShortIO ($ fn)
diff --git a/src/Quasar/Async/V2.hs b/src/Quasar/Async/V2.hs
index 8b66c93..5b4adfc 100644
--- a/src/Quasar/Async/V2.hs
+++ b/src/Quasar/Async/V2.hs
@@ -1,7 +1,9 @@
module Quasar.Async.V2 (
Async,
async,
+ async_,
asyncWithUnmask,
+ asyncWithUnmask_,
-- ** Async exceptions
CancelAsync(..),
@@ -11,8 +13,8 @@ module Quasar.Async.V2 (
isAsyncDisposed,
-- ** Unmanaged variants
- unmanagedAsync,
- unmanagedAsyncWithUnmask,
+ unmanagedAsyncSTM,
+ unmanagedAsyncWithUnmaskSTM,
) where
import Control.Concurrent (ThreadId)
@@ -38,15 +40,15 @@ instance IsAwaitable a (Async a) where
toAwaitable (Async awaitable _) = awaitable
-unmanagedAsync :: IO a -> TIOWorker -> ExceptionChannel -> STM (Async a)
-unmanagedAsync fn = unmanagedAsyncWithUnmask (\unmask -> unmask fn)
+unmanagedAsyncSTM :: IO a -> TIOWorker -> ExceptionChannel -> STM (Async a)
+unmanagedAsyncSTM fn = unmanagedAsyncWithUnmaskSTM (\unmask -> unmask fn)
-unmanagedAsyncWithUnmask :: forall a. ((forall b. IO b -> IO b) -> IO a) -> TIOWorker -> ExceptionChannel -> STM (Async a)
-unmanagedAsyncWithUnmask fn worker exChan = do
+unmanagedAsyncWithUnmaskSTM :: forall a. ((forall b. IO b -> IO b) -> IO a) -> TIOWorker -> ExceptionChannel -> STM (Async a)
+unmanagedAsyncWithUnmaskSTM fn worker exChan = do
key <- newUniqueSTM
resultVar <- newAsyncVarSTM
disposer <- mfix \disposer -> do
- tidAwaitable <- forkWithUnmask (runAndPut key resultVar disposer) worker exChan
+ tidAwaitable <- forkWithUnmaskSTM (runAndPut key resultVar disposer) worker exChan
newPrimitiveDisposer (disposeFn key resultVar tidAwaitable) worker exChan
pure $ Async (toAwaitable resultVar) disposer
where
@@ -78,6 +80,9 @@ unmanagedAsyncWithUnmask fn worker exChan = do
async :: MonadQuasar m => QuasarIO a -> m (Async a)
async fn = asyncWithUnmask ($ fn)
+async_ :: MonadQuasar m => QuasarIO () -> m ()
+async_ fn = void $ asyncWithUnmask ($ fn)
+
asyncWithUnmask :: MonadQuasar m => ((forall b. QuasarIO b -> QuasarIO b) -> QuasarIO a) -> m (Async a)
asyncWithUnmask fn = do
quasar <- askQuasar
@@ -85,7 +90,7 @@ asyncWithUnmask fn = do
exChan <- askExceptionChannel
rm <- askResourceManager
runSTM do
- as <- unmanagedAsyncWithUnmask (\unmask -> runReaderT (fn (liftUnmask unmask)) quasar) worker exChan
+ as <- unmanagedAsyncWithUnmaskSTM (\unmask -> runReaderT (fn (liftUnmask unmask)) quasar) worker exChan
attachResource rm as
pure as
where
@@ -93,3 +98,6 @@ asyncWithUnmask fn = do
liftUnmask unmask innerAction = do
quasar <- askQuasar
liftIO $ unmask $ runReaderT innerAction quasar
+
+asyncWithUnmask_ :: MonadQuasar m => ((forall b. QuasarIO b -> QuasarIO b) -> QuasarIO ()) -> m ()
+asyncWithUnmask_ fn = void $ asyncWithUnmask fn
diff --git a/src/Quasar/Resources.hs b/src/Quasar/Resources.hs
index 80d39ff..1d82df4 100644
--- a/src/Quasar/Resources.hs
+++ b/src/Quasar/Resources.hs
@@ -42,7 +42,7 @@ import Quasar.Resources.Disposer
newIODisposer :: IO () -> TIOWorker -> ExceptionChannel -> STM Disposer
-newIODisposer fn worker exChan = newPrimitiveDisposer (startIOThreadShortIO fn exChan) worker exChan
+newIODisposer fn worker exChan = newPrimitiveDisposer (forkAsyncShortIO fn exChan) worker exChan
newSTMDisposer :: STM () -> TIOWorker -> ExceptionChannel -> STM Disposer
newSTMDisposer fn = newIODisposer (atomically fn)
--
GitLab