{-# LANGUAGE GADTs           #-}
{-# LANGUAGE TemplateHaskell #-}

module HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog
  ( Hedgehog

  , assertEquals
  , eval
  , evalM
  , evalIO
  , writeLog
  , failWith
  , failWithCustom

  , hedgehogToIntegrationFinal

  ) where

import qualified GHC.Stack                                               as GHC
import           HaskellWorks.Polysemy.Prelude

import qualified Hedgehog                                                as H
import qualified Hedgehog.Internal.Property                              as H

import qualified HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog.Internal as I
import           Polysemy
import           Polysemy.Final

data Hedgehog m rv where
  AssertEquals :: (GHC.HasCallStack, Eq a, Show a)
    => a
    -> a
    -> Hedgehog m ()

  Eval :: GHC.HasCallStack
    => a
    -> Hedgehog m a

  EvalM :: GHC.HasCallStack
    => m a
    -> Hedgehog m a

  EvalIO :: GHC.HasCallStack
    => IO a
    -> Hedgehog m a

  WriteLog :: ()
    => H.Log
    -> Hedgehog m ()

  FailWith :: GHC.HasCallStack
    => Maybe H.Diff
    -> String
    -> Hedgehog m a

  FailWithCustom :: ()
    => GHC.CallStack
    -> Maybe H.Diff
    -> String
    -> Hedgehog m a

makeSem ''Hedgehog

hedgehogToIntegrationFinal :: ()
  => Member (Final (H.PropertyT IO)) r
  => Sem (Hedgehog ': r) a
  -> Sem r a
hedgehogToIntegrationFinal :: forall (r :: EffectRow) a.
Member (Final (PropertyT IO)) r =>
Sem (Hedgehog : r) a -> Sem r a
hedgehogToIntegrationFinal = (forall x (rInitial :: EffectRow).
 Hedgehog (Sem rInitial) x
 -> Strategic (PropertyT IO) (Sem rInitial) x)
-> Sem (Hedgehog : r) a -> Sem r a
forall (m :: * -> *) (e :: Effect) (r :: EffectRow) a.
Member (Final m) r =>
(forall x (rInitial :: EffectRow).
 e (Sem rInitial) x -> Strategic m (Sem rInitial) x)
-> Sem (e : r) a -> Sem r a
interpretFinal \case
  AssertEquals a
a a
b ->
    PropertyT IO x
-> forall {f :: * -> *}.
   Functor f =>
   Sem
     (WithStrategy (PropertyT IO) f (Sem rInitial)) (PropertyT IO (f x))
forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
liftS (PropertyT IO x
 -> forall {f :: * -> *}.
    Functor f =>
    Sem
      (WithStrategy (PropertyT IO) f (Sem rInitial))
      (PropertyT IO (f x)))
-> PropertyT IO x
-> forall {f :: * -> *}.
   Functor f =>
   Sem
     (WithStrategy (PropertyT IO) f (Sem rInitial)) (PropertyT IO (f x))
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
H.=== a
b
  Eval x
a ->
    PropertyT IO x
-> forall {f :: * -> *}.
   Functor f =>
   Sem
     (WithStrategy (PropertyT IO) f (Sem rInitial)) (PropertyT IO (f x))
forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
liftS (PropertyT IO x
 -> forall {f :: * -> *}.
    Functor f =>
    Sem
      (WithStrategy (PropertyT IO) f (Sem rInitial))
      (PropertyT IO (f x)))
-> PropertyT IO x
-> forall {f :: * -> *}.
   Functor f =>
   Sem
     (WithStrategy (PropertyT IO) f (Sem rInitial)) (PropertyT IO (f x))
forall a b. (a -> b) -> a -> b
$ x -> PropertyT IO x
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
H.eval x
a
  EvalIO IO x
f ->
    PropertyT IO x
-> forall {f :: * -> *}.
   Functor f =>
   Sem
     (WithStrategy (PropertyT IO) f (Sem rInitial)) (PropertyT IO (f x))
forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
liftS (PropertyT IO x
 -> forall {f :: * -> *}.
    Functor f =>
    Sem
      (WithStrategy (PropertyT IO) f (Sem rInitial))
      (PropertyT IO (f x)))
-> PropertyT IO x
-> forall {f :: * -> *}.
   Functor f =>
   Sem
     (WithStrategy (PropertyT IO) f (Sem rInitial)) (PropertyT IO (f x))
forall a b. (a -> b) -> a -> b
$ IO x -> PropertyT IO x
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO IO x
f
  EvalM Sem rInitial x
f -> do
    PropertyT IO (f x)
g <- Sem rInitial x
-> Sem
     (WithStrategy (PropertyT IO) f (Sem rInitial)) (PropertyT IO (f x))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS Sem rInitial x
f
    PropertyT IO (f x)
-> Sem
     (WithStrategy (PropertyT IO) f (Sem rInitial)) (PropertyT IO (f x))
forall a. a -> Sem (WithStrategy (PropertyT IO) f (Sem rInitial)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PropertyT IO (f x)
 -> Sem
      (WithStrategy (PropertyT IO) f (Sem rInitial))
      (PropertyT IO (f x)))
-> PropertyT IO (f x)
-> Sem
     (WithStrategy (PropertyT IO) f (Sem rInitial)) (PropertyT IO (f x))
forall a b. (a -> b) -> a -> b
$ PropertyT IO (f x) -> PropertyT IO (f x)
forall (m :: * -> *) a.
(MonadTest m, MonadCatch m, HasCallStack) =>
m a -> m a
H.evalM PropertyT IO (f x)
g
  FailWith Maybe Diff
mdiff String
msg ->
    PropertyT IO x
-> forall {f :: * -> *}.
   Functor f =>
   Sem
     (WithStrategy (PropertyT IO) f (Sem rInitial)) (PropertyT IO (f x))
forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
liftS (PropertyT IO x
 -> forall {f :: * -> *}.
    Functor f =>
    Sem
      (WithStrategy (PropertyT IO) f (Sem rInitial))
      (PropertyT IO (f x)))
-> PropertyT IO x
-> forall {f :: * -> *}.
   Functor f =>
   Sem
     (WithStrategy (PropertyT IO) f (Sem rInitial)) (PropertyT IO (f x))
forall a b. (a -> b) -> a -> b
$ Maybe Diff -> String -> PropertyT IO x
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
Maybe Diff -> String -> m a
H.failWith Maybe Diff
mdiff String
msg
  FailWithCustom CallStack
cs Maybe Diff
mdiff String
msg ->
    PropertyT IO x
-> forall {f :: * -> *}.
   Functor f =>
   Sem
     (WithStrategy (PropertyT IO) f (Sem rInitial)) (PropertyT IO (f x))
forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
liftS (PropertyT IO x
 -> forall {f :: * -> *}.
    Functor f =>
    Sem
      (WithStrategy (PropertyT IO) f (Sem rInitial))
      (PropertyT IO (f x)))
-> PropertyT IO x
-> forall {f :: * -> *}.
   Functor f =>
   Sem
     (WithStrategy (PropertyT IO) f (Sem rInitial)) (PropertyT IO (f x))
forall a b. (a -> b) -> a -> b
$ CallStack -> Maybe Diff -> String -> PropertyT IO x
forall (m :: * -> *) a.
MonadTest m =>
CallStack -> Maybe Diff -> String -> m a
I.failWithCustom CallStack
cs Maybe Diff
mdiff String
msg
  WriteLog Log
logValue ->
    PropertyT IO x
-> forall {f :: * -> *}.
   Functor f =>
   Sem
     (WithStrategy (PropertyT IO) f (Sem rInitial)) (PropertyT IO (f x))
forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
liftS (PropertyT IO x
 -> forall {f :: * -> *}.
    Functor f =>
    Sem
      (WithStrategy (PropertyT IO) f (Sem rInitial))
      (PropertyT IO (f x)))
-> PropertyT IO x
-> forall {f :: * -> *}.
   Functor f =>
   Sem
     (WithStrategy (PropertyT IO) f (Sem rInitial)) (PropertyT IO (f x))
forall a b. (a -> b) -> a -> b
$ Log -> PropertyT IO ()
forall (m :: * -> *). MonadTest m => Log -> m ()
H.writeLog Log
logValue