module TheatreDev.StmBased.Wait where

import TheatreDev.Prelude

type Wait = STM (Maybe SomeException)

both :: Wait -> Wait -> Wait
both :: Wait -> Wait -> Wait
both Wait
left Wait
right =
  do
    Either (Maybe SomeException) (Maybe SomeException)
firstResult <- forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wait
left forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wait
right
    case Either (Maybe SomeException) (Maybe SomeException)
firstResult of
      Left Maybe SomeException
Nothing -> Wait
right
      Left (Just SomeException
exception) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just SomeException
exception)
      Right Maybe SomeException
Nothing -> Wait
left
      Right (Just SomeException
exception) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just SomeException
exception)

all :: [Wait] -> Wait
all :: [Wait] -> Wait
all [Wait]
waits =
  Wait
getException forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Wait
getNothing
  where
    getException :: Wait
getException =
      [Wait]
waits
        forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Applicative f => a -> f a
pure)
        forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just
    getNothing :: Wait
getNothing =
      forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Wait]
waits