{-# OPTIONS_HADDOCK hide #-}

module Polysemy.Test.Hedgehog where

import qualified Hedgehog as Native
import Hedgehog (TestT, (===))

import qualified Polysemy.Test.Data.Hedgehog as Hedgehog
import Polysemy.Test.Data.Hedgehog (Hedgehog)

-- |Interpret 'Hedgehog' into @'TestT' IO@ by simple embedding of the native combinators.
interpretHedgehog ::
  Member (Embed (TestT IO)) r =>
  InterpreterFor Hedgehog r
interpretHedgehog :: InterpreterFor Hedgehog r
interpretHedgehog =
  (forall x (rInitial :: EffectRow).
 Hedgehog (Sem rInitial) x -> Sem r x)
-> Sem (Hedgehog : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Hedgehog.LiftH t ->
      TestT IO x -> Sem r x
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed TestT IO x
t
    Hedgehog.Assert v ->
      TestT IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (Bool -> TestT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
Native.assert Bool
v)
    Hedgehog.AssertEqual a1 a2 ->
      TestT IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (a
a1 a -> a -> TestT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== a
a2)
    Hedgehog.EvalEither e ->
      TestT IO x -> Sem r x
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (Either e x -> TestT IO x
forall (m :: * -> *) x a.
(MonadTest m, Show x, HasCallStack) =>
Either x a -> m a
Native.evalEither Either e x
e)
    Hedgehog.AssertRight a e ->
      TestT IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed ((a
a a -> a -> TestT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
===) (a -> TestT IO ()) -> TestT IO a -> TestT IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either e a -> TestT IO a
forall (m :: * -> *) x a.
(MonadTest m, Show x, HasCallStack) =>
Either x a -> m a
Native.evalEither Either e a
e)