module HaskellWorks.Polysemy.Hedgehog.Property
  ( Property,
    property,
    propertyOnce,
  ) 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           HaskellWorks.Polysemy.Log
import           Polysemy
import           Polysemy.Embed
import           Polysemy.Log
import           Polysemy.Resource
import           Polysemy.Time.Interpreter.Ghc

property :: ()
  => Sem
        [ Log
        , DataLog (LogEntry LogMessage)
        , DataLog Text
        , GhcTime
        , Hedgehog
        , Embed IO
        , Embed (H.PropertyT IO)
        , Resource
        , Final (H.PropertyT IO)
        ] ()
  -> H.Property
property :: Sem
  '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
    Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
    Final (PropertyT IO)]
  ()
-> Property
property Sem
  '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
    Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
    Final (PropertyT IO)]
  ()
f =
    Sem
  '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
    Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
    Final (PropertyT IO)]
  ()
f Sem
  '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
    Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
    Final (PropertyT IO)]
  ()
-> (Sem
      '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
        Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
        Final (PropertyT IO)]
      ()
    -> Sem
         '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
           Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
         ())
-> Sem
     '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
       Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
     ()
forall a b. a -> (a -> b) -> b
& Sem
  '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
    Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
    Final (PropertyT IO)]
  ()
-> Sem
     '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
       Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT 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 (PropertyT IO), Resource, Final (PropertyT IO)]
interpretLogDataLog
      Sem
  '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
    Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
  ()
-> (Sem
      '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
        Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
      ()
    -> Sem
         '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
           Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
         ())
-> Sem
     '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
       Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
     ()
forall a b. a -> (a -> b) -> b
& String
-> Severity
-> Sem
     '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
       Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
     ()
-> Sem
     '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
       Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
     ()
forall (r :: EffectRow) a.
(HasCallStack, Member (DataLog (LogEntry LogMessage)) r,
 Member (Embed IO) r) =>
String -> Severity -> Sem r a -> Sem r a
setLogLevelFromEnv String
"LOG_LEVEL" Severity
Info
      Sem
  '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
    Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
  ()
-> (Sem
      '[DataLog (LogEntry LogMessage), DataLog Text, GhcTime, Hedgehog,
        Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
      ()
    -> Sem
         '[DataLog Text, GhcTime, Hedgehog, Embed IO, Embed (PropertyT IO),
           Resource, Final (PropertyT IO)]
         ())
-> Sem
     '[DataLog Text, GhcTime, Hedgehog, Embed IO, Embed (PropertyT IO),
       Resource, Final (PropertyT 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 (PropertyT IO),
       Resource, Final (PropertyT 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 (PropertyT IO),
    Resource, Final (PropertyT IO)]
  ()
-> (Sem
      '[DataLog Text, GhcTime, Hedgehog, Embed IO, Embed (PropertyT IO),
        Resource, Final (PropertyT IO)]
      ()
    -> Sem
         '[GhcTime, Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
           Final (PropertyT IO)]
         ())
-> Sem
     '[GhcTime, Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
       Final (PropertyT IO)]
     ()
forall a b. a -> (a -> b) -> b
& (Text -> Text)
-> (Text -> CallStack)
-> InterpreterFor
     (DataLog Text)
     '[GhcTime, Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
       Final (PropertyT 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 (PropertyT IO), Resource,
    Final (PropertyT IO)]
  ()
-> (Sem
      '[GhcTime, Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
        Final (PropertyT IO)]
      ()
    -> Sem
         '[Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
           Final (PropertyT IO)]
         ())
-> Sem
     '[Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
       Final (PropertyT IO)]
     ()
forall a b. a -> (a -> b) -> b
& Sem
  '[GhcTime, Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
    Final (PropertyT IO)]
  ()
-> Sem
     '[Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
       Final (PropertyT IO)]
     ()
forall (r :: EffectRow).
Member (Embed IO) r =>
InterpreterFor GhcTime r
InterpreterFor
  GhcTime
  '[Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
    Final (PropertyT IO)]
interpretTimeGhc
      Sem
  '[Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
    Final (PropertyT IO)]
  ()
-> (Sem
      '[Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
        Final (PropertyT IO)]
      ()
    -> Sem
         '[Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
         ())
-> Sem
     '[Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
     ()
forall a b. a -> (a -> b) -> b
& Sem
  '[Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
    Final (PropertyT IO)]
  ()
-> Sem
     '[Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
     ()
forall a (r :: EffectRow).
Member (Final (PropertyT IO)) r =>
Sem (Hedgehog : r) a -> Sem r a
hedgehogToPropertyFinal
      Sem
  '[Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
  ()
-> (Sem
      '[Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
      ()
    -> Sem '[Embed (PropertyT IO), Resource, Final (PropertyT IO)] ())
-> Sem '[Embed (PropertyT IO), Resource, Final (PropertyT IO)] ()
forall a b. a -> (a -> b) -> b
& (forall x. IO x -> PropertyT IO x)
-> Sem
     '[Embed IO, Embed (PropertyT IO), Resource, Final (PropertyT IO)]
     ()
-> Sem '[Embed (PropertyT IO), Resource, Final (PropertyT 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 -> PropertyT IO x
forall x. IO x -> PropertyT IO x
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
      Sem '[Embed (PropertyT IO), Resource, Final (PropertyT IO)] ()
-> (Sem '[Embed (PropertyT IO), Resource, Final (PropertyT IO)] ()
    -> Sem '[Resource, Final (PropertyT IO)] ())
-> Sem '[Resource, Final (PropertyT 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.PropertyT IO)
      Sem '[Resource, Final (PropertyT IO)] ()
-> (Sem '[Resource, Final (PropertyT IO)] ()
    -> Sem '[Final (PropertyT IO)] ())
-> Sem '[Final (PropertyT IO)] ()
forall a b. a -> (a -> b) -> b
& Sem '[Resource, Final (PropertyT IO)] ()
-> Sem '[Final (PropertyT IO)] ()
forall (r :: EffectRow) a. Sem (Resource : r) a -> Sem r a
runResource
      Sem '[Final (PropertyT IO)] ()
-> (Sem '[Final (PropertyT IO)] () -> PropertyT IO ())
-> PropertyT IO ()
forall a b. a -> (a -> b) -> b
& Sem '[Final (PropertyT IO)] () -> PropertyT IO ()
forall (m :: * -> *) a. Monad m => Sem '[Final m] a -> m a
runFinal
      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

propertyOnce :: ()
  => Sem
        [ Log
        , DataLog (LogEntry LogMessage)
        , DataLog Text
        , GhcTime
        , Hedgehog
        , Embed IO
        , Embed (H.PropertyT IO)
        , Resource
        , Final (H.PropertyT IO)
        ] ()
  -> H.Property
propertyOnce :: Sem
  '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
    Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
    Final (PropertyT IO)]
  ()
-> Property
propertyOnce Sem
  '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
    Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
    Final (PropertyT IO)]
  ()
f =
    Sem
  '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
    Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
    Final (PropertyT IO)]
  ()
f Sem
  '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
    Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
    Final (PropertyT IO)]
  ()
-> (Sem
      '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
        Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
        Final (PropertyT IO)]
      ()
    -> Property)
-> Property
forall a b. a -> (a -> b) -> b
& Sem
  '[Log, DataLog (LogEntry LogMessage), DataLog Text, GhcTime,
    Hedgehog, Embed IO, Embed (PropertyT IO), Resource,
    Final (PropertyT IO)]
  ()
-> Property
property
      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& TestLimit -> Property -> Property
H.withTests TestLimit
1