-- | Utilities used in modules from the @TestSupport@ folder.

{-# LANGUAGE GADTs      #-}
{-# LANGUAGE RankNTypes #-}

module PlutusCore.Generators.Hedgehog.Utils
    ( liftT
    , generalizeT
    , hoistSupply
    , choiceDef
    , forAllNoShow
    , forAllNoShowT
    , forAllPretty
    , forAllPrettyT
    , forAllPrettyPlc
    , forAllPrettyPlcT
    , prettyPlcErrorString
    ) where

import PlutusCore.Pretty

import Control.Monad.Morph
import Control.Monad.Reader
import Data.Functor.Identity
import Hedgehog hiding (Size, Var)
import Hedgehog.Gen qualified as Gen
import Hedgehog.Internal.Property (forAllWithT)

-- | @hoist lift@
liftT :: (MFunctor t, MonadTrans s, Monad m) => t m a -> t (s m) a
liftT :: forall (t :: (* -> *) -> * -> *) (s :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MFunctor t, MonadTrans s, Monad m) =>
t m a -> t (s m) a
liftT = (forall a. m a -> s m a) -> t m a -> t (s m) a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> t m b -> t n b
hoist m a -> s m a
forall a. m a -> s m a
forall (m :: * -> *) a. Monad m => m a -> s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | @hoist generalize@
generalizeT :: (MFunctor t, Monad m) => t Identity a -> t m a
generalizeT :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MFunctor t, Monad m) =>
t Identity a -> t m a
generalizeT = (forall a. Identity a -> m a) -> t Identity a -> t m a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> t m b -> t n b
hoist Identity a -> m a
forall a. Identity a -> m a
forall (m :: * -> *) a. Monad m => Identity a -> m a
generalize

-- | Supply an environment to an inner 'ReaderT'.
hoistSupply :: (MFunctor t, Monad m) => r -> t (ReaderT r m) a -> t m a
hoistSupply :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) r a.
(MFunctor t, Monad m) =>
r -> t (ReaderT r m) a -> t m a
hoistSupply r
r = (forall a. ReaderT r m a -> m a) -> t (ReaderT r m) a -> t m a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((forall a. ReaderT r m a -> m a) -> t (ReaderT r m) a -> t m a)
-> (forall a. ReaderT r m a -> m a) -> t (ReaderT r m) a -> t m a
forall a b. (a -> b) -> a -> b
$ (ReaderT r m a -> r -> m a) -> r -> ReaderT r m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT r
r

-- | Same as 'Gen.choice', but with a default generator to be used
-- when the supplied list of generators is empty.
choiceDef :: Monad m => GenT m a -> [GenT m a] -> GenT m a
choiceDef :: forall (m :: * -> *) a.
Monad m =>
GenT m a -> [GenT m a] -> GenT m a
choiceDef GenT m a
a [] = GenT m a
a
choiceDef GenT m a
_ [GenT m a]
as = [GenT m a] -> GenT m a
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice [GenT m a]
as

-- | Generate a value, but do not show it in case an error occurs.
forAllNoShow :: Monad m => Gen a -> PropertyT m a
forAllNoShow :: forall (m :: * -> *) a. Monad m => Gen a -> PropertyT m a
forAllNoShow = (a -> String) -> Gen a -> PropertyT m a
forall (m :: * -> *) a.
(Monad m, HasCallStack) =>
(a -> String) -> Gen a -> PropertyT m a
forAllWith a -> String
forall a. Monoid a => a
mempty

-- | Generate a value, but do not show it in case an error occurs.
-- A supplied generator has access to the 'Monad' the whole property has access to.
forAllNoShowT :: Monad m => GenT m a -> PropertyT m a
forAllNoShowT :: forall (m :: * -> *) a. Monad m => GenT m a -> PropertyT m a
forAllNoShowT = (a -> String) -> GenT m a -> PropertyT m a
forall (m :: * -> *) a.
(Monad m, HasCallStack) =>
(a -> String) -> GenT m a -> PropertyT m a
forAllWithT a -> String
forall a. Monoid a => a
mempty

-- | Generate a value using the 'Pretty' class for getting its 'String' representation.
forAllPretty :: (Monad m, Pretty a) => Gen a -> PropertyT m a
forAllPretty :: forall (m :: * -> *) a.
(Monad m, Pretty a) =>
Gen a -> PropertyT m a
forAllPretty = (a -> String) -> Gen a -> PropertyT m a
forall (m :: * -> *) a.
(Monad m, HasCallStack) =>
(a -> String) -> Gen a -> PropertyT m a
forAllWith a -> String
forall str a. (Pretty a, Render str) => a -> str
display

-- | Generate a value using the 'Pretty' class for getting its 'String' representation.
-- A supplied generator has access to the 'Monad' the whole property has access to.
forAllPrettyT :: (Monad m, Pretty a) => GenT m a -> PropertyT m a
forAllPrettyT :: forall (m :: * -> *) a.
(Monad m, Pretty a) =>
GenT m a -> PropertyT m a
forAllPrettyT = (a -> String) -> GenT m a -> PropertyT m a
forall (m :: * -> *) a.
(Monad m, HasCallStack) =>
(a -> String) -> GenT m a -> PropertyT m a
forAllWithT a -> String
forall str a. (Pretty a, Render str) => a -> str
display

-- | Generate a value using the 'PrettyPlc' constraint for getting its 'String' representation.
forAllPrettyPlc :: (Monad m, PrettyPlc a) => Gen a -> PropertyT m a
forAllPrettyPlc :: forall (m :: * -> *) a.
(Monad m, PrettyPlc a) =>
Gen a -> PropertyT m a
forAllPrettyPlc = (a -> String) -> Gen a -> PropertyT m a
forall (m :: * -> *) a.
(Monad m, HasCallStack) =>
(a -> String) -> Gen a -> PropertyT m a
forAllWith a -> String
forall a str. (PrettyPlc a, Render str) => a -> str
displayPlc

-- | Generate a value using the 'PrettyPlc' constraint for getting its 'String' representation.
-- A supplied generator has access to the 'Monad' the whole property has access to.
forAllPrettyPlcT :: (Monad m, PrettyPlc a) => GenT m a -> PropertyT m a
forAllPrettyPlcT :: forall (m :: * -> *) a.
(Monad m, PrettyPlc a) =>
GenT m a -> PropertyT m a
forAllPrettyPlcT = (a -> String) -> GenT m a -> PropertyT m a
forall (m :: * -> *) a.
(Monad m, HasCallStack) =>
(a -> String) -> GenT m a -> PropertyT m a
forAllWithT a -> String
forall a str. (PrettyPlc a, Render str) => a -> str
displayPlc

-- | Pretty-print a PLC error.
prettyPlcErrorString :: PrettyPlc err => err -> String
prettyPlcErrorString :: forall err. PrettyPlc err => err -> String
prettyPlcErrorString = Doc Any -> String
forall ann. Doc ann -> String
forall str ann. Render str => Doc ann -> str
render (Doc Any -> String) -> (err -> Doc Any) -> err -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrettyConfigPlcOptions -> PrettyConfigPlc) -> err -> Doc Any
forall a ann.
PrettyPlc a =>
(PrettyConfigPlcOptions -> PrettyConfigPlc) -> a -> Doc ann
prettyPlcCondensedErrorBy PrettyConfigPlcOptions -> PrettyConfigPlc
prettyConfigPlcClassicSimple