module Effectful.Zoo.Hedgehog.Api.Run
  ( UnitTest,

    hedgehog,
    unitTest,
  ) where

import Control.Monad.Trans.Writer.Lazy qualified as MTL
import Effectful
import Effectful.Error.Static
import Effectful.Writer.Static.Local
import Effectful.Zoo.Hedgehog.Api.Journal
import Effectful.Zoo.Hedgehog.Dynamic
import Effectful.Zoo.Log.Dynamic
import HaskellWorks.Prelude
import Hedgehog (TestT)
import Hedgehog qualified as H
import Hedgehog.Internal.Property (Failure, Journal)
import Hedgehog.Internal.Property qualified as H
import Test.Tasty (TestName, TestTree)
import Test.Tasty.Hedgehog (testProperty)

type UnitTest = TestT IO ()

hedgehog :: forall a. ()
  => Eff
      [ Log Text
      , Hedgehog
      , Error Failure
      , Writer Journal
      , IOE
      ] a
  -> H.TestT IO a
hedgehog :: forall a.
Eff '[Log Text, Hedgehog, Error Failure, Writer Journal, IOE] a
-> TestT IO a
hedgehog Eff '[Log Text, Hedgehog, Error Failure, Writer Journal, IOE] a
f =
  Eff '[Log Text, Hedgehog, Error Failure, Writer Journal, IOE] a
f
    Eff '[Log Text, Hedgehog, Error Failure, Writer Journal, IOE] a
-> (Eff '[Log Text, Hedgehog, Error Failure, Writer Journal, IOE] a
    -> Eff '[Hedgehog, Error Failure, Writer Journal, IOE] a)
-> Eff '[Hedgehog, Error Failure, Writer Journal, IOE] a
forall a b. a -> (a -> b) -> b
& UnliftStrategy
-> (CallStack
    -> Severity
    -> Text
    -> Eff '[Hedgehog, Error Failure, Writer Journal, IOE] ())
-> Eff '[Log Text, Hedgehog, Error Failure, Writer Journal, IOE] a
-> Eff '[Hedgehog, Error Failure, Writer Journal, IOE] a
forall (r :: [(* -> *) -> * -> *]) i a.
(r <: IOE) =>
UnliftStrategy
-> (CallStack -> Severity -> i -> Eff r ())
-> Eff (Log i : r) a
-> Eff r a
runLog (Persistence -> Limit -> UnliftStrategy
ConcUnlift Persistence
Persistent Limit
Unlimited) CallStack
-> Severity
-> Text
-> Eff '[Hedgehog, Error Failure, Writer Journal, IOE] ()
forall (r :: [(* -> *) -> * -> *]).
(r <: Hedgehog) =>
CallStack -> Severity -> Text -> Eff r ()
jotLogTextWithCallStack
    Eff '[Hedgehog, Error Failure, Writer Journal, IOE] a
-> (Eff '[Hedgehog, Error Failure, Writer Journal, IOE] a
    -> IO (Either Failure a, Journal))
-> IO (Either Failure a, Journal)
forall a b. a -> (a -> b) -> b
& Eff '[Hedgehog, Error Failure, Writer Journal, IOE] a
-> IO (Either Failure a, Journal)
forall a.
Eff '[Hedgehog, Error Failure, Writer Journal, IOE] a
-> IO (Either Failure a, Journal)
runHedgehogIO
    IO (Either Failure a, Journal)
-> (IO (Either Failure a, Journal)
    -> WriterT Journal IO (Either Failure a))
-> WriterT Journal IO (Either Failure a)
forall a b. a -> (a -> b) -> b
& IO (Either Failure a, Journal)
-> WriterT Journal IO (Either Failure a)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
MTL.WriterT
    WriterT Journal IO (Either Failure a)
-> (WriterT Journal IO (Either Failure a)
    -> ExceptT Failure (WriterT Journal IO) a)
-> ExceptT Failure (WriterT Journal IO) a
forall a b. a -> (a -> b) -> b
& WriterT Journal IO (Either Failure a)
-> ExceptT Failure (WriterT Journal IO) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT
    ExceptT Failure (WriterT Journal IO) a
-> (ExceptT Failure (WriterT Journal IO) a -> TestT IO a)
-> TestT IO a
forall a b. a -> (a -> b) -> b
& ExceptT Failure (WriterT Journal IO) a -> TestT IO a
forall (m :: * -> *) a.
ExceptT Failure (WriterT Journal m) a -> TestT m a
H.TestT

unitTest :: ()
  => TestName 
  -> UnitTest 
  -> TestTree
unitTest :: TestName -> UnitTest -> TestTree
unitTest TestName
desc =
  TestName -> Property -> TestTree
testProperty TestName
desc (Property -> TestTree)
-> (UnitTest -> Property) -> UnitTest -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> Property -> Property
H.withTests TestLimit
1 (Property -> Property)
-> (UnitTest -> Property) -> UnitTest -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
H.property (PropertyT IO () -> Property)
-> (UnitTest -> PropertyT IO ()) -> UnitTest -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitTest -> PropertyT IO ()
forall (m :: * -> *) a. Monad m => TestT m a -> PropertyT m a
H.test