module Unfork.Async.WithResult.STM
(
unforkAsyncSTM,
)
where
import Unfork.Async.Core
import Unfork.Async.WithResult.Task
import Prelude (IO, Maybe (..), pure)
import Control.Monad.STM (STM, atomically)
import qualified Control.Concurrent.STM as STM
unforkAsyncSTM ::
(task -> IO result)
-> ((task -> STM (STM (Maybe result))) -> IO conclusion)
-> IO conclusion
unforkAsyncSTM :: (task -> IO result)
-> ((task -> STM (STM (Maybe result))) -> IO conclusion)
-> IO conclusion
unforkAsyncSTM task -> IO result
action =
Unfork task (STM (STM (Maybe result)))
-> ((task -> STM (STM (Maybe result))) -> IO conclusion)
-> IO conclusion
forall a c b. Unfork a c -> ((a -> c) -> IO b) -> IO b
unforkAsync Unfork :: forall a c q. (Ctx q -> a -> c) -> (q -> IO ()) -> Unfork a c
Unfork{ Ctx (Task task (TVar (Maybe result)))
-> task -> STM (STM (Maybe result))
forall a a.
Ctx (Task a (TVar (Maybe a))) -> a -> STM (STM (Maybe a))
unforkedAction :: Ctx (Task task (TVar (Maybe result)))
-> task -> STM (STM (Maybe result))
unforkedAction :: forall a a.
Ctx (Task a (TVar (Maybe a))) -> a -> STM (STM (Maybe a))
unforkedAction, Task task (TVar (Maybe result)) -> IO ()
executeOneTask :: Task task (TVar (Maybe result)) -> IO ()
executeOneTask :: Task task (TVar (Maybe result)) -> IO ()
executeOneTask }
where
unforkedAction :: Ctx (Task a (TVar (Maybe a))) -> a -> STM (STM (Maybe a))
unforkedAction Ctx (Task a (TVar (Maybe a)))
ctx a
arg = do
TVar (Maybe a)
resultVar <- Maybe a -> STM (TVar (Maybe a))
forall a. a -> STM (TVar a)
STM.newTVar Maybe a
forall a. Maybe a
Nothing
Ctx (Task a (TVar (Maybe a))) -> Task a (TVar (Maybe a)) -> STM ()
forall q. Ctx q -> q -> STM ()
enqueue Ctx (Task a (TVar (Maybe a)))
ctx Task :: forall a b. a -> b -> Task a b
Task{ a
arg :: a
arg :: a
arg, TVar (Maybe a)
resultVar :: TVar (Maybe a)
resultVar :: TVar (Maybe a)
resultVar }
STM (Maybe a) -> STM (STM (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TVar (Maybe a) -> STM (Maybe a)
forall a. TVar a -> STM a
STM.readTVar TVar (Maybe a)
resultVar)
executeOneTask :: Task task (TVar (Maybe result)) -> IO ()
executeOneTask Task{ task
arg :: task
arg :: forall a b. Task a b -> a
arg, TVar (Maybe result)
resultVar :: TVar (Maybe result)
resultVar :: forall a b. Task a b -> b
resultVar } = do
result
b <- task -> IO result
action task
arg
STM () -> IO ()
forall a. STM a -> IO a
atomically (TVar (Maybe result) -> Maybe result -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (Maybe result)
resultVar (result -> Maybe result
forall a. a -> Maybe a
Just result
b))