{-

STM, asynchronous, with task results available

To make task results available, we maintain a queue that contains not only each the task itself, but also a TVar to store its result. Each step of the queue loop runs the action and then places the result into the TVar.

-}

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

{- |

    Unforks an action, with the new action's asynchronous result available as @('STM' ('Maybe' result))@

    Related functions:

      - Use 'Unfork.unforkAsyncSTM_' if you do not need to know when the action has completed or obtain its result value
      - Use 'Unfork.unforkAsyncIO' if you do not need the composability of 'STM'

-}

unforkAsyncSTM ::
    (task -> IO result) -- ^ Action that needs to be run serially
    -> ((task -> STM (STM (Maybe result))) -> IO conclusion) -- ^ Continuation with the unforked action
    -> 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))