mirror of
https://github.com/HuwCampbell/grenade.git
synced 2024-11-29 22:43:49 +03:00
8767e836a1
This allows us to more easily get a handle to the parameters of the shape, while still being pretty easy to cast to a KnownNat. We can now more easily add to the gradients test, and properly check the sizes of the head without silly hacks.
41 lines
1.1 KiB
Haskell
41 lines
1.1 KiB
Haskell
{-# LANGUAGE RankNTypes #-}
|
|
module Test.Hedgehog.Compat (
|
|
(...)
|
|
, choose
|
|
, blindForAll
|
|
, semiBlindForAll
|
|
, forAllRender
|
|
)where
|
|
|
|
import Control.Monad.Trans.Class (MonadTrans(..))
|
|
|
|
import Data.Typeable ( typeOf )
|
|
|
|
import qualified Hedgehog.Gen as Gen
|
|
import qualified Hedgehog.Range as Range
|
|
import Hedgehog.Internal.Property
|
|
import Hedgehog.Internal.Source
|
|
import Hedgehog.Internal.Show
|
|
|
|
(...) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
|
|
(...) = (.) . (.)
|
|
{-# INLINE (...) #-}
|
|
|
|
choose :: ( Monad m, Integral a ) => a -> a -> Gen.Gen m a
|
|
choose = Gen.integral ... Range.constant
|
|
|
|
blindForAll :: Monad m => Gen.Gen m a -> Test m a
|
|
blindForAll = Test . lift . lift
|
|
|
|
semiBlindForAll :: (Monad m, Show a, HasCallStack) => Gen.Gen m a -> Test m a
|
|
semiBlindForAll gen = do
|
|
x <- Test . lift $ lift gen
|
|
writeLog $ Input (getCaller callStack) (typeOf ()) (showPretty x)
|
|
return x
|
|
|
|
forAllRender :: (Monad m, HasCallStack) => ( a -> String ) -> Gen.Gen m a -> Test m a
|
|
forAllRender render gen = do
|
|
x <- Test . lift $ lift gen
|
|
writeLog $ Input (getCaller callStack) (typeOf ()) (render x)
|
|
return x
|