{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}

-- |
-- Module: Capnp.Rpc.Promise
-- Description: Promises
--
-- This module defines a 'Promise' type, represents a value which is not yet
-- available, and related utilities.
module Capnp.Rpc.Promise
  ( Promise,
    Fulfiller,

    -- * Creating promises
    newPromise,
    newReadyPromise,
    newPromiseWithCallback,
    newCallback,

    -- * Fulfilling or breaking promises
    fulfill,
    breakPromise,
    breakOrFulfill,
    ErrAlreadyResolved (..),

    -- * Getting the value of a promise
    wait,
  )
where

import Capnp.Gen.Capnp.Rpc
-- For exception instance:
import Capnp.Rpc.Errors ()
import Control.Concurrent.STM
import qualified Control.Exception.Safe as HsExn
import Control.Monad.STM.Class

-- | An exception thrown if 'breakPromise' or 'fulfill' is called on an
-- already-resolved fulfiller.
data ErrAlreadyResolved = ErrAlreadyResolved deriving (Int -> ErrAlreadyResolved -> ShowS
[ErrAlreadyResolved] -> ShowS
ErrAlreadyResolved -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrAlreadyResolved] -> ShowS
$cshowList :: [ErrAlreadyResolved] -> ShowS
show :: ErrAlreadyResolved -> String
$cshow :: ErrAlreadyResolved -> String
showsPrec :: Int -> ErrAlreadyResolved -> ShowS
$cshowsPrec :: Int -> ErrAlreadyResolved -> ShowS
Show)

instance HsExn.Exception ErrAlreadyResolved

-- | A 'Fulfiller' is used to fulfill a promise.
newtype Fulfiller a = Fulfiller
  { forall a. Fulfiller a -> Either (Parsed Exception) a -> STM ()
callback :: Either (Parsed Exception) a -> STM ()
  }

-- | Fulfill a promise by supplying the specified value. It is an error to
-- call 'fulfill' if the promise has already been fulfilled (or broken).
fulfill :: MonadSTM m => Fulfiller a -> a -> m ()
fulfill :: forall (m :: * -> *) a. MonadSTM m => Fulfiller a -> a -> m ()
fulfill Fulfiller a
f a
val = forall (m :: * -> *) a.
MonadSTM m =>
Fulfiller a -> Either (Parsed Exception) a -> m ()
breakOrFulfill Fulfiller a
f (forall a b. b -> Either a b
Right a
val)

-- | Break a promise. When the user of the promise executes 'wait', the
-- specified exception will be raised. It is an error to call 'breakPromise'
-- if the promise has already been fulfilled (or broken).
breakPromise :: MonadSTM m => Fulfiller a -> Parsed Exception -> m ()
breakPromise :: forall (m :: * -> *) a.
MonadSTM m =>
Fulfiller a -> Parsed Exception -> m ()
breakPromise Fulfiller a
f Parsed Exception
exn = forall (m :: * -> *) a.
MonadSTM m =>
Fulfiller a -> Either (Parsed Exception) a -> m ()
breakOrFulfill Fulfiller a
f (forall a b. a -> Either a b
Left Parsed Exception
exn)

-- | 'breakOrFulfill' calls either 'breakPromise' or 'fulfill', depending
-- on the argument.
breakOrFulfill :: MonadSTM m => Fulfiller a -> Either (Parsed Exception) a -> m ()
breakOrFulfill :: forall (m :: * -> *) a.
MonadSTM m =>
Fulfiller a -> Either (Parsed Exception) a -> m ()
breakOrFulfill Fulfiller {Either (Parsed Exception) a -> STM ()
callback :: Either (Parsed Exception) a -> STM ()
$sel:callback:Fulfiller :: forall a. Fulfiller a -> Either (Parsed Exception) a -> STM ()
callback} Either (Parsed Exception) a
result = forall (m :: * -> *) a. MonadSTM m => STM a -> m a
liftSTM forall a b. (a -> b) -> a -> b
$ Either (Parsed Exception) a -> STM ()
callback Either (Parsed Exception) a
result

-- | Wait for a promise to resolve, and return the result. If the promise
-- is broken, this raises an exception instead (see 'breakPromise').
wait :: MonadSTM m => Promise a -> m a
wait :: forall (m :: * -> *) a. MonadSTM m => Promise a -> m a
wait Promise {TVar (Maybe (Either (Parsed Exception) a))
$sel:var:Promise :: forall a. Promise a -> TVar (Maybe (Either (Parsed Exception) a))
var :: TVar (Maybe (Either (Parsed Exception) a))
var} = forall (m :: * -> *) a. MonadSTM m => STM a -> m a
liftSTM forall a b. (a -> b) -> a -> b
$ do
  Maybe (Either (Parsed Exception) a)
val <- forall a. TVar a -> STM a
readTVar TVar (Maybe (Either (Parsed Exception) a))
var
  case Maybe (Either (Parsed Exception) a)
val of
    Maybe (Either (Parsed Exception) a)
Nothing ->
      forall a. STM a
retry
    Just (Right a
result) ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
    Just (Left Parsed Exception
exn) ->
      forall e a. Exception e => e -> STM a
throwSTM Parsed Exception
exn

-- | Create a promise that is already fulfilled, with the given value.
newReadyPromise :: MonadSTM m => a -> m (Promise a)
newReadyPromise :: forall (m :: * -> *) a. MonadSTM m => a -> m (Promise a)
newReadyPromise a
value = forall (m :: * -> *) a. MonadSTM m => STM a -> m a
liftSTM forall a b. (a -> b) -> a -> b
$ forall a. TVar (Maybe (Either (Parsed Exception) a)) -> Promise a
Promise forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> STM (TVar a)
newTVar (forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right a
value))

-- | Create a new promise and an associated fulfiller.
newPromise :: MonadSTM m => m (Promise a, Fulfiller a)
newPromise :: forall (m :: * -> *) a. MonadSTM m => m (Promise a, Fulfiller a)
newPromise = forall (m :: * -> *) a. MonadSTM m => STM a -> m a
liftSTM forall a b. (a -> b) -> a -> b
$ do
  TVar (Maybe (Either (Parsed Exception) a))
var <- forall a. a -> STM (TVar a)
newTVar forall a. Maybe a
Nothing
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( Promise {TVar (Maybe (Either (Parsed Exception) a))
var :: TVar (Maybe (Either (Parsed Exception) a))
$sel:var:Promise :: TVar (Maybe (Either (Parsed Exception) a))
var},
      Fulfiller
        { $sel:callback:Fulfiller :: Either (Parsed Exception) a -> STM ()
callback = \Either (Parsed Exception) a
result -> do
            Maybe (Either (Parsed Exception) a)
val <- forall a. TVar a -> STM a
readTVar TVar (Maybe (Either (Parsed Exception) a))
var
            case Maybe (Either (Parsed Exception) a)
val of
              Maybe (Either (Parsed Exception) a)
Nothing ->
                forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe (Either (Parsed Exception) a))
var (forall a. a -> Maybe a
Just Either (Parsed Exception) a
result)
              Just Either (Parsed Exception) a
_ ->
                forall e a. Exception e => e -> STM a
throwSTM ErrAlreadyResolved
ErrAlreadyResolved
        }
    )

-- | Create a new promise which also excecutes an STM action when it is resolved.
newPromiseWithCallback :: MonadSTM m => (Either (Parsed Exception) a -> STM ()) -> m (Promise a, Fulfiller a)
newPromiseWithCallback :: forall (m :: * -> *) a.
MonadSTM m =>
(Either (Parsed Exception) a -> STM ())
-> m (Promise a, Fulfiller a)
newPromiseWithCallback Either (Parsed Exception) a -> STM ()
callback = forall (m :: * -> *) a. MonadSTM m => STM a -> m a
liftSTM forall a b. (a -> b) -> a -> b
$ do
  (Promise a
promise, Fulfiller {$sel:callback:Fulfiller :: forall a. Fulfiller a -> Either (Parsed Exception) a -> STM ()
callback = Either (Parsed Exception) a -> STM ()
oldCallback}) <- forall (m :: * -> *) a. MonadSTM m => m (Promise a, Fulfiller a)
newPromise
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( Promise a
promise,
      Fulfiller
        { $sel:callback:Fulfiller :: Either (Parsed Exception) a -> STM ()
callback = \Either (Parsed Exception) a
result -> Either (Parsed Exception) a -> STM ()
oldCallback Either (Parsed Exception) a
result forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either (Parsed Exception) a -> STM ()
callback Either (Parsed Exception) a
result
        }
    )

-- | Like 'newPromiseWithCallback', but doesn't return the promise.
newCallback :: MonadSTM m => (Either (Parsed Exception) a -> STM ()) -> m (Fulfiller a)
newCallback :: forall (m :: * -> *) a.
MonadSTM m =>
(Either (Parsed Exception) a -> STM ()) -> m (Fulfiller a)
newCallback = forall (m :: * -> *) a. MonadSTM m => STM a -> m a
liftSTM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadSTM m =>
(Either (Parsed Exception) a -> STM ())
-> m (Promise a, Fulfiller a)
newPromiseWithCallback

-- | A promise is a value that may not be ready yet.
newtype Promise a = Promise
  { forall a. Promise a -> TVar (Maybe (Either (Parsed Exception) a))
var :: TVar (Maybe (Either (Parsed Exception) a))
  }
  deriving (Promise a -> Promise a -> Bool
forall a. Promise a -> Promise a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Promise a -> Promise a -> Bool
$c/= :: forall a. Promise a -> Promise a -> Bool
== :: Promise a -> Promise a -> Bool
$c== :: forall a. Promise a -> Promise a -> Bool
Eq)