{-# LANGUAGE DefaultSignatures #-}
module Multitasking.AsyncOperations where
import Control.Concurrent.STM
import Multitasking.MonadSTM
class Await t where
type Payload t
await :: (MonadSTM m) => t -> m (Payload t)
probe :: (MonadSTM m) => t -> m (Maybe (Payload t))
{-# MINIMAL await | probe #-}
default await :: (MonadSTM m) => t -> m (Payload t)
await t
t = STM (Payload t) -> m (Payload t)
forall a. STM a -> m a
forall (m :: * -> *) a. MonadSTM m => STM a -> m a
liftSTM (STM (Payload t) -> m (Payload t))
-> STM (Payload t) -> m (Payload t)
forall a b. (a -> b) -> a -> b
$ do
maybePayload <- t -> STM (Maybe (Payload t))
forall t (m :: * -> *).
(Await t, MonadSTM m) =>
t -> m (Maybe (Payload t))
forall (m :: * -> *). MonadSTM m => t -> m (Maybe (Payload t))
probe t
t
case maybePayload of
Just Payload t
a -> Payload t -> STM (Payload t)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Payload t
a
Maybe (Payload t)
Nothing -> STM (Payload t)
forall a. STM a
retry
default probe :: (MonadSTM m) => t -> m (Maybe (Payload t))
probe t
t = STM (Maybe (Payload t)) -> m (Maybe (Payload t))
forall a. STM a -> m a
forall (m :: * -> *) a. MonadSTM m => STM a -> m a
liftSTM (STM (Maybe (Payload t)) -> m (Maybe (Payload t)))
-> STM (Maybe (Payload t)) -> m (Maybe (Payload t))
forall a b. (a -> b) -> a -> b
$ (Payload t -> Maybe (Payload t)
forall a. a -> Maybe a
Just (Payload t -> Maybe (Payload t))
-> STM (Payload t) -> STM (Maybe (Payload t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> STM (Payload t)
forall t (m :: * -> *). (Await t, MonadSTM m) => t -> m (Payload t)
forall (m :: * -> *). MonadSTM m => t -> m (Payload t)
await t
t) STM (Maybe (Payload t))
-> STM (Maybe (Payload t)) -> STM (Maybe (Payload t))
forall a. STM a -> STM a -> STM a
`orElse` Maybe (Payload t) -> STM (Maybe (Payload t))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Payload t)
forall a. Maybe a
Nothing