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