module Ribosome.Test.Await where

import Hedgehog (TestT)
import Control.Exception (throw)
import Control.Monad.Error.Class (MonadError (throwError), catchError)
import Hedgehog.Internal.Property (mkTestT, runTestT, Failure, Journal)

import Ribosome.Control.Concurrent.Wait (WaitError(Thrown, ConditionUnmet, NotStarted), waitIODef)

await ::
  ∀ e a b m .
  MonadError e m =>
  MonadIO m =>
  MonadBaseControl IO m =>
  (a -> TestT m b) ->
  m a ->
  TestT m b
await :: (a -> TestT m b) -> m a -> TestT m b
await a -> TestT m b
assertion m a
acquire = do
  m (Either (WaitError (Either (Failure, Journal) e)) b)
-> TestT m (Either (WaitError (Either (Failure, Journal) e)) b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either e a)
-> (Either e a -> m (Either (Either (Failure, Journal) e) b))
-> m (Either (WaitError (Either (Failure, Journal) e)) b)
forall (m :: * -> *) a e b.
(MonadIO m, MonadBaseControl IO m) =>
m a -> (a -> m (Either e b)) -> m (Either (WaitError e) b)
waitIODef m (Either e a)
acquire' Either e a -> m (Either (Either (Failure, Journal) e) b)
check') TestT m (Either (WaitError (Either (Failure, Journal) e)) b)
-> (Either (WaitError (Either (Failure, Journal) e)) b
    -> TestT m b)
-> TestT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right b
a -> b -> TestT m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
    Left (ConditionUnmet (Left (Failure
err, Journal
journal))) ->
      m (Either Failure b, Journal) -> TestT m b
forall (m :: * -> *) a. m (Either Failure a, Journal) -> TestT m a
mkTestT ((Either Failure b, Journal) -> m (Either Failure b, Journal)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Failure -> Either Failure b
forall a b. a -> Either a b
Left Failure
err, Journal
journal))
    Left (ConditionUnmet (Right e
e)) ->
      e -> TestT m b
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
e
    Left (Thrown excp
e) ->
      excp -> TestT m b
forall a e. Exception e => e -> a
throw excp
e
    Left WaitError (Either (Failure, Journal) e)
NotStarted -> String -> TestT m b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"await was not started"
  where
    acquire' :: m (Either e a)
    acquire' :: m (Either e a)
acquire' =
      m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a) -> m a -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
acquire) (Either e a -> m (Either e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a))
-> (e -> Either e a) -> e -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left)
    check' :: Either e a -> m (Either (Either (Failure, Journal) e) b)
    check' :: Either e a -> m (Either (Either (Failure, Journal) e) b)
check' (Right a
a) = do
      (Either Failure b
result, Journal
journal) <- TestT m b -> m (Either Failure b, Journal)
forall (m :: * -> *) a. TestT m a -> m (Either Failure a, Journal)
runTestT (a -> TestT m b
assertion a
a)
      Either (Either (Failure, Journal) e) b
-> m (Either (Either (Failure, Journal) e) b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Failure -> Either (Failure, Journal) e)
-> Either Failure b -> Either (Either (Failure, Journal) e) b
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft ((Failure, Journal) -> Either (Failure, Journal) e
forall a b. a -> Either a b
Left ((Failure, Journal) -> Either (Failure, Journal) e)
-> (Failure -> (Failure, Journal))
-> Failure
-> Either (Failure, Journal) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Journal
journal)) Either Failure b
result)
    check' (Left e
e) = do
      Either (Either (Failure, Journal) e) b
-> m (Either (Either (Failure, Journal) e) b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure, Journal) e
-> Either (Either (Failure, Journal) e) b
forall a b. a -> Either a b
Left (e -> Either (Failure, Journal) e
forall a b. b -> Either a b
Right e
e))