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