module HaskellWorks.Polysemy.Hedgehog.Test
  ( Property,
    test,

  ) where

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

import           Hedgehog                                       (Property)
import qualified Hedgehog                                       as H

import           Control.Monad.IO.Class                         (liftIO)
import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog
import           HaskellWorks.Polysemy.Hedgehog.Effect.Log
import           Polysemy
import           Polysemy.Embed
import           Polysemy.Log
import           Polysemy.Resource
import           Polysemy.Time.Interpreter.Ghc

test :: ()
  => Sem
        [ Log
        , DataLog (LogEntry LogMessage)
        , DataLog Text
        , GhcTime
        , Hedgehog
        , Embed IO
        , Embed (H.TestT IO)
        , Resource
        , Final (H.TestT IO)
        ] ()
  -> H.Property
test :: Sem
  '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
    Hedgehog, Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
  ()
-> Property
test Sem
  '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
    Hedgehog, Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
  ()
f = Sem
  '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
    Hedgehog, Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
  ()
f
  Sem
  '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
    Hedgehog, Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
  ()
-> (Sem
      '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
        Hedgehog, Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
      ()
    -> Sem
         '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
           Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
         ())
-> Sem
     '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
       Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
     ()
forall a b. a -> (a -> b) -> b
& Sem
  '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
    Hedgehog, Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
  ()
-> Sem
     '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
       Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
     ()
forall (r :: EffectRow).
Members '[DataLog (LogEntry LogMessage), GhcTime] r =>
InterpreterFor Log r
InterpreterFor
  Log
  '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
    Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
interpretLogDataLog
  Sem
  '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
    Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
  ()
-> (Sem
      '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
        Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
      ()
    -> Sem
         '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
           Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
         ())
-> Sem
     '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
       Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
     ()
forall a b. a -> (a -> b) -> b
& Maybe Severity
-> Sem
     '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
       Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
     ()
-> Sem
     '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
       Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
     ()
forall (r :: EffectRow) a.
Member (DataLog (LogEntry LogMessage)) r =>
Maybe Severity -> Sem r a -> Sem r a
setLogLevel (Severity -> Maybe Severity
forall a. a -> Maybe a
Just Severity
Info)
  Sem
  '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
    Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
  ()
-> (Sem
      '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
        Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
      ()
    -> Sem
         '[DataLog Text, GhcTime, Hedgehog, Embed IO, Embed (TestT IO),
           Resource, Final (TestT IO)]
         ())
-> Sem
     '[DataLog Text, GhcTime, Hedgehog, Embed IO, Embed (TestT IO),
       Resource, Final (TestT IO)]
     ()
forall a b. a -> (a -> b) -> b
& (LogEntry LogMessage -> Text)
-> (LogEntry LogMessage -> CallStack)
-> InterpreterFor
     (DataLog (LogEntry LogMessage))
     '[DataLog Text, GhcTime, Hedgehog, Embed IO, Embed (TestT IO),
       Resource, Final (TestT IO)]
forall (r :: EffectRow) a.
Member Hedgehog r =>
(a -> Text) -> (a -> CallStack) -> InterpreterFor (DataLog a) r
interpretDataLogHedgehog LogEntry LogMessage -> Text
formatLogEntry LogEntry LogMessage -> CallStack
getLogEntryCallStack
  Sem
  '[DataLog Text, GhcTime, Hedgehog, Embed IO, Embed (TestT IO),
    Resource, Final (TestT IO)]
  ()
-> (Sem
      '[DataLog Text, GhcTime, Hedgehog, Embed IO, Embed (TestT IO),
        Resource, Final (TestT IO)]
      ()
    -> Sem
         '[GhcTime, Hedgehog, Embed IO, Embed (TestT IO), Resource,
           Final (TestT IO)]
         ())
-> Sem
     '[GhcTime, Hedgehog, Embed IO, Embed (TestT IO), Resource,
       Final (TestT IO)]
     ()
forall a b. a -> (a -> b) -> b
& (Text -> Text)
-> (Text -> CallStack)
-> InterpreterFor
     (DataLog Text)
     '[GhcTime, Hedgehog, Embed IO, Embed (TestT IO), Resource,
       Final (TestT IO)]
forall (r :: EffectRow) a.
Member Hedgehog r =>
(a -> Text) -> (a -> CallStack) -> InterpreterFor (DataLog a) r
interpretDataLogHedgehog Text -> Text
forall a. a -> a
id (CallStack -> Text -> CallStack
forall a b. a -> b -> a
const CallStack
HasCallStack => CallStack
GHC.callStack)
  Sem
  '[GhcTime, Hedgehog, Embed IO, Embed (TestT IO), Resource,
    Final (TestT IO)]
  ()
-> (Sem
      '[GhcTime, Hedgehog, Embed IO, Embed (TestT IO), Resource,
        Final (TestT IO)]
      ()
    -> Sem
         '[Hedgehog, Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
         ())
-> Sem
     '[Hedgehog, Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
     ()
forall a b. a -> (a -> b) -> b
& Sem
  '[GhcTime, Hedgehog, Embed IO, Embed (TestT IO), Resource,
    Final (TestT IO)]
  ()
-> Sem
     '[Hedgehog, Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
     ()
forall (r :: EffectRow).
Member (Embed IO) r =>
InterpreterFor GhcTime r
InterpreterFor
  GhcTime
  '[Hedgehog, Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
interpretTimeGhc
  Sem
  '[Hedgehog, Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
  ()
-> (Sem
      '[Hedgehog, Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
      ()
    -> Sem
         '[Embed IO, Embed (TestT IO), Resource, Final (TestT IO)] ())
-> Sem '[Embed IO, Embed (TestT IO), Resource, Final (TestT IO)] ()
forall a b. a -> (a -> b) -> b
& Sem
  '[Hedgehog, Embed IO, Embed (TestT IO), Resource, Final (TestT IO)]
  ()
-> Sem '[Embed IO, Embed (TestT IO), Resource, Final (TestT IO)] ()
forall a (r :: EffectRow).
Member (Final (TestT IO)) r =>
Sem (Hedgehog : r) a -> Sem r a
hedgehogToTestFinal
  Sem '[Embed IO, Embed (TestT IO), Resource, Final (TestT IO)] ()
-> (Sem
      '[Embed IO, Embed (TestT IO), Resource, Final (TestT IO)] ()
    -> Sem '[Embed (TestT IO), Resource, Final (TestT IO)] ())
-> Sem '[Embed (TestT IO), Resource, Final (TestT IO)] ()
forall a b. a -> (a -> b) -> b
& (forall x. IO x -> TestT IO x)
-> Sem '[Embed IO, Embed (TestT IO), Resource, Final (TestT IO)] ()
-> Sem '[Embed (TestT IO), Resource, Final (TestT IO)] ()
forall (m1 :: * -> *) (m2 :: * -> *) (r :: EffectRow) a.
Member (Embed m2) r =>
(forall x. m1 x -> m2 x) -> Sem (Embed m1 : r) a -> Sem r a
runEmbedded IO x -> TestT IO x
forall x. IO x -> TestT IO x
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
  Sem '[Embed (TestT IO), Resource, Final (TestT IO)] ()
-> (Sem '[Embed (TestT IO), Resource, Final (TestT IO)] ()
    -> Sem '[Resource, Final (TestT IO)] ())
-> Sem '[Resource, Final (TestT IO)] ()
forall a b. a -> (a -> b) -> b
& forall (m :: * -> *) (r :: EffectRow) a.
(Member (Final m) r, Functor m) =>
Sem (Embed m : r) a -> Sem r a
embedToFinal @(H.TestT IO)
  Sem '[Resource, Final (TestT IO)] ()
-> (Sem '[Resource, Final (TestT IO)] ()
    -> Sem '[Final (TestT IO)] ())
-> Sem '[Final (TestT IO)] ()
forall a b. a -> (a -> b) -> b
& Sem '[Resource, Final (TestT IO)] () -> Sem '[Final (TestT IO)] ()
forall (r :: EffectRow) a. Sem (Resource : r) a -> Sem r a
runResource
  Sem '[Final (TestT IO)] ()
-> (Sem '[Final (TestT IO)] () -> TestT IO ()) -> TestT IO ()
forall a b. a -> (a -> b) -> b
& Sem '[Final (TestT IO)] () -> TestT IO ()
forall (m :: * -> *) a. Monad m => Sem '[Final m] a -> m a
runFinal
  TestT IO () -> (TestT IO () -> PropertyT IO ()) -> PropertyT IO ()
forall a b. a -> (a -> b) -> b
& TestT IO () -> PropertyT IO ()
forall (m :: * -> *) a. Monad m => TestT m a -> PropertyT m a
H.test
  PropertyT IO () -> (PropertyT IO () -> Property) -> Property
forall a b. a -> (a -> b) -> b
& HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
H.property
  Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& TestLimit -> Property -> Property
H.withTests TestLimit
1