module Michelson.Test.Util
( leftToShowPanic
, leftToPrettyPanic
, failedTest
, succeededTest
, eitherIsLeft
, eitherIsRight
, total
, meanTimeUpperBoundProp
, meanTimeUpperBoundPropNF
, genEither
, genTuple2
, runGen
, roundtripTree
, mcs, ms, sec, minute
, failedProp
, succeededProp
, qcIsLeft
, qcIsRight
, roundtripTest
) where
import Criterion (Benchmarkable, benchmarkWith', nf, whnf)
import Criterion.Main (defaultConfig)
import Criterion.Types (SampleAnalysis(anMean), Verbosity(Quiet), reportAnalysis, verbosity)
import Data.Typeable (typeRep)
import Fmt (Buildable, pretty)
import Hedgehog
(Gen, MonadGen, MonadTest, Property, annotate, eval, evalIO, failure, forAll, property, success,
tripping, withTests)
import qualified Hedgehog.Gen as Gen
import Hedgehog.Internal.Gen (runGenT)
import qualified Hedgehog.Internal.Seed as Seed
import Hedgehog.Internal.Tree (TreeT(runTreeT), nodeValue)
import qualified Hedgehog.Range as Range
import Statistics.Types (Estimate(estPoint))
import Test.QuickCheck (Arbitrary)
import qualified Test.QuickCheck.Property as QC
import Test.Tasty (TestTree)
import Test.Tasty.Hedgehog (testProperty)
import qualified Test.Tasty.QuickCheck as TQC
import Text.Printf (printf)
import Time
(KnownDivRat, KnownUnitName, Microsecond, Millisecond, Minute, Nanosecond, Picosecond, RatioNat,
Second, Time, mcs, minute, ms, ns, sec, timeout, toUnit, unTime, unitNameVal)
leftToShowPanic :: (Show e, HasCallStack) => Either e a -> a
leftToShowPanic :: Either e a -> a
leftToShowPanic = (e -> a) -> (a -> a) -> Either e a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> a
forall a. HasCallStack => Text -> a
error (Text -> a) -> (e -> Text) -> e -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Text
forall b a. (Show a, IsString b) => a -> b
show) a -> a
forall a. a -> a
id
leftToPrettyPanic :: (Buildable e, HasCallStack) => Either e a -> a
leftToPrettyPanic :: Either e a -> a
leftToPrettyPanic = (e -> a) -> (a -> a) -> Either e a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> a
forall a. HasCallStack => Text -> a
error (Text -> a) -> (e -> Text) -> e -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) a -> a
forall a. a -> a
id
failedProp :: Text -> QC.Property
failedProp :: Text -> Property
failedProp r :: Text
r = Result -> Property
forall prop. Testable prop => prop -> Property
QC.property (Result -> Property) -> Result -> Property
forall a b. (a -> b) -> a -> b
$ Result
QC.failed { reason :: String
QC.reason = Text -> String
forall a. ToString a => a -> String
toString Text
r }
{-# DEPRECATED failedProp "Use 'failedtest' instead." #-}
succeededProp :: QC.Property
succeededProp :: Property
succeededProp = Bool -> Property
forall prop. Testable prop => prop -> Property
QC.property Bool
True
{-# DEPRECATED succeededProp "Use 'succeededTest' instead." #-}
qcIsLeft :: Show b => Either a b -> QC.Property
qcIsLeft :: Either a b -> Property
qcIsLeft = \case
Left _ -> Property
succeededProp
Right x :: b
x -> Text -> Property
failedProp (Text -> Property) -> Text -> Property
forall a b. (a -> b) -> a -> b
$ "expected Left, got Right (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> b -> Text
forall b a. (Show a, IsString b) => a -> b
show b
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
{-# DEPRECATED qcIsLeft "Use 'eitherIsLeft' instead." #-}
qcIsRight :: Show a => Either a b -> QC.Property
qcIsRight :: Either a b -> Property
qcIsRight = \case
Right _ -> Property
succeededProp
Left x :: a
x -> Text -> Property
failedProp (Text -> Property) -> Text -> Property
forall a b. (a -> b) -> a -> b
$ "expected Right, got Left (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall b a. (Show a, IsString b) => a -> b
show a
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
{-# DEPRECATED qcIsRight "Use 'eitherIsRight' instead." #-}
failedTest :: (HasCallStack, MonadTest m) => Text -> m ()
failedTest :: Text -> m ()
failedTest r :: Text
r = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
annotate (Text -> String
forall a. ToString a => a -> String
toString Text
r) m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
failure
succeededTest :: MonadTest m => m ()
succeededTest :: m ()
succeededTest = m ()
forall (m :: * -> *). MonadTest m => m ()
success
eitherIsLeft :: (Show b, MonadTest m, HasCallStack) => Either a b -> m ()
eitherIsLeft :: Either a b -> m ()
eitherIsLeft = \case
Left _ -> m ()
forall (m :: * -> *). MonadTest m => m ()
succeededTest
Right x :: b
x -> (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadTest m) => Text -> m ()
failedTest (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "expected Left, got Right (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> b -> Text
forall b a. (Show a, IsString b) => a -> b
show b
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
eitherIsRight :: (Show a, MonadTest m, HasCallStack) => Either a b -> m ()
eitherIsRight :: Either a b -> m ()
eitherIsRight = \case
Right _ -> m ()
forall (m :: * -> *). MonadTest m => m ()
succeededTest
Left x :: a
x -> (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadTest m) => Text -> m ()
failedTest (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "expected Right, got Left (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall b a. (Show a, IsString b) => a -> b
show a
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
total :: (MonadTest m, NFData a, HasCallStack) => a -> m a
total :: a -> m a
total a :: a
a = ((HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
eval (() -> m ()) -> () -> m ()
forall a b. (a -> b) -> a -> b
$ a -> ()
forall a. NFData a => a -> ()
rnf a
a) m () -> a -> m a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
a
meanTimeUpperBoundProp
:: (KnownDivRat unit Second, KnownUnitName unit, HasCallStack)
=> Time unit -> (a -> b) -> a -> Property
meanTimeUpperBoundProp :: Time unit -> (a -> b) -> a -> Property
meanTimeUpperBoundProp upperBound :: Time unit
upperBound run :: a -> b
run arg :: a
arg =
(HasCallStack => Property) -> Property
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Property) -> Property)
-> (HasCallStack => Property) -> Property
forall a b. (a -> b) -> a -> b
$
Time unit -> Benchmarkable -> Property
forall (unit :: Rat).
(KnownDivRat unit Second, KnownUnitName unit, HasCallStack) =>
Time unit -> Benchmarkable -> Property
checkReport Time unit
upperBound (Benchmarkable -> Property) -> Benchmarkable -> Property
forall a b. (a -> b) -> a -> b
$ (a -> b) -> a -> Benchmarkable
forall a b. (a -> b) -> a -> Benchmarkable
whnf a -> b
run a
arg
meanTimeUpperBoundPropNF
:: (KnownDivRat unit Second, KnownUnitName unit, HasCallStack, NFData b)
=> Time unit -> (a -> b) -> a -> Property
meanTimeUpperBoundPropNF :: Time unit -> (a -> b) -> a -> Property
meanTimeUpperBoundPropNF upperBound :: Time unit
upperBound run :: a -> b
run arg :: a
arg =
(HasCallStack => Property) -> Property
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Property) -> Property)
-> (HasCallStack => Property) -> Property
forall a b. (a -> b) -> a -> b
$
Time unit -> Benchmarkable -> Property
forall (unit :: Rat).
(KnownDivRat unit Second, KnownUnitName unit, HasCallStack) =>
Time unit -> Benchmarkable -> Property
checkReport Time unit
upperBound (Benchmarkable -> Property) -> Benchmarkable -> Property
forall a b. (a -> b) -> a -> b
$ (a -> b) -> a -> Benchmarkable
forall b a. NFData b => (a -> b) -> a -> Benchmarkable
nf a -> b
run a
arg
checkReport
:: (KnownDivRat unit Second, KnownUnitName unit)
=> HasCallStack => Time unit -> Benchmarkable -> Property
checkReport :: Time unit -> Benchmarkable -> Property
checkReport upperBound :: Time unit
upperBound benchmarkable :: Benchmarkable
benchmarkable =
TestLimit -> Property -> Property
withTests 1 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$
IO (Maybe Report) -> PropertyT IO (Maybe Report)
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
evalIO IO (Maybe Report)
runBench PropertyT IO (Maybe Report)
-> (Maybe Report -> PropertyT IO ()) -> PropertyT IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Nothing -> Text -> PropertyT IO ()
forall (m :: * -> *). (HasCallStack, MonadTest m) => Text -> m ()
failedTest "Expected benchmark to complete within 120 seconds."
Just report :: Report
report ->
let mean :: Time (1 :% 1)
mean = RatioNat -> Time (1 :% 1)
RatioNat -> Time Second
sec (RatioNat -> Time (1 :% 1))
-> (SampleAnalysis -> RatioNat) -> SampleAnalysis -> Time (1 :% 1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Real Double, Fractional RatioNat) => Double -> RatioNat
forall a b. (Real a, Fractional b) => a -> b
realToFrac @Double @RatioNat (Double -> RatioNat)
-> (SampleAnalysis -> Double) -> SampleAnalysis -> RatioNat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate ConfInt Double -> Double
forall (e :: * -> *) a. Estimate e a -> a
estPoint (Estimate ConfInt Double -> Double)
-> (SampleAnalysis -> Estimate ConfInt Double)
-> SampleAnalysis
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SampleAnalysis -> Estimate ConfInt Double
anMean (SampleAnalysis -> Time (1 :% 1))
-> SampleAnalysis -> Time (1 :% 1)
forall a b. (a -> b) -> a -> b
$ Report -> SampleAnalysis
reportAnalysis Report
report
in if Time (1 :% 1)
mean Time (1 :% 1) -> Time (1 :% 1) -> Bool
forall a. Ord a => a -> a -> Bool
< Time unit -> Time Second
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Second Time unit
upperBound
then PropertyT IO ()
forall (m :: * -> *). MonadTest m => m ()
succeededTest
else Text -> PropertyT IO ()
forall (m :: * -> *). (HasCallStack, MonadTest m) => Text -> m ()
failedTest (Text -> PropertyT IO ()) -> Text -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$
"Expected mean estimate to be under "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Time unit -> Text
forall b a. (Show a, IsString b) => a -> b
show Time unit
upperBound
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", but was "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Time Second -> Text
display Time (1 :% 1)
Time Second
mean
where
runBench :: IO (Maybe Report)
runBench = Time (60 :% 1) -> IO Report -> IO (Maybe Report)
forall (unit :: Rat) (m :: * -> *) a.
(MonadIO m, KnownDivRat unit Microsecond) =>
Time unit -> IO a -> m (Maybe a)
timeout (RatioNat -> Time Minute
minute 2) (IO Report -> IO (Maybe Report)) -> IO Report -> IO (Maybe Report)
forall a b. (a -> b) -> a -> b
$
Config -> Benchmarkable -> IO Report
benchmarkWith' (Config
defaultConfig { verbosity :: Verbosity
verbosity = Verbosity
Quiet }) Benchmarkable
benchmarkable
display :: Time Second -> Text
display :: Time Second -> Text
display n :: Time Second
n = case Time Second
n of
(forall (unitFrom :: Rat).
KnownDivRat unitFrom Minute =>
Time unitFrom -> Time Minute
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Minute -> Time Minute
x) | Time (60 :% 1)
Time Minute
x Time (60 :% 1) -> Time (60 :% 1) -> Bool
forall a. Ord a => a -> a -> Bool
> RatioNat -> Time Minute
minute 1 -> Time (60 :% 1) -> Text
forall (unit :: Rat). KnownUnitName unit => Time unit -> Text
format Time (60 :% 1)
Time Minute
x
(forall (unitFrom :: Rat).
KnownDivRat unitFrom Second =>
Time unitFrom -> Time Second
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Second -> Time Second
x) | Time (1 :% 1)
Time Second
x Time (1 :% 1) -> Time (1 :% 1) -> Bool
forall a. Ord a => a -> a -> Bool
> RatioNat -> Time Second
sec 1 -> Time (1 :% 1) -> Text
forall (unit :: Rat). KnownUnitName unit => Time unit -> Text
format Time (1 :% 1)
Time Second
x
(forall (unitFrom :: Rat).
KnownDivRat unitFrom Millisecond =>
Time unitFrom -> Time Millisecond
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Millisecond -> Time Millisecond
x) | Time (1 :% 1000)
Time Millisecond
x Time (1 :% 1000) -> Time (1 :% 1000) -> Bool
forall a. Ord a => a -> a -> Bool
> RatioNat -> Time Millisecond
ms 1 -> Time (1 :% 1000) -> Text
forall (unit :: Rat). KnownUnitName unit => Time unit -> Text
format Time (1 :% 1000)
Time Millisecond
x
(forall (unitFrom :: Rat).
KnownDivRat unitFrom Microsecond =>
Time unitFrom -> Time Microsecond
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Microsecond -> Time Microsecond
x) | Time (1 :% 1000000)
Time Microsecond
x Time (1 :% 1000000) -> Time (1 :% 1000000) -> Bool
forall a. Ord a => a -> a -> Bool
> RatioNat -> Time Microsecond
mcs 1 -> Time (1 :% 1000000) -> Text
forall (unit :: Rat). KnownUnitName unit => Time unit -> Text
format Time (1 :% 1000000)
Time Microsecond
x
(forall (unitFrom :: Rat).
KnownDivRat unitFrom Nanosecond =>
Time unitFrom -> Time Nanosecond
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Nanosecond -> Time Nanosecond
x) | Time (1 :% 1000000000)
Time Nanosecond
x Time (1 :% 1000000000) -> Time (1 :% 1000000000) -> Bool
forall a. Ord a => a -> a -> Bool
> RatioNat -> Time Nanosecond
ns 1 -> Time (1 :% 1000000000) -> Text
forall (unit :: Rat). KnownUnitName unit => Time unit -> Text
format Time (1 :% 1000000000)
Time Nanosecond
x
_ -> Time (1 :% 1000000000000) -> Text
forall (unit :: Rat). KnownUnitName unit => Time unit -> Text
format (Time (1 :% 1) -> Time Picosecond
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Picosecond Time (1 :% 1)
Time Second
n)
format :: forall unit. KnownUnitName unit => Time unit -> Text
format :: Time unit -> Text
format n :: Time unit
n =
ToText String => String -> Text
forall a. ToText a => a -> Text
toText @String (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Double -> String -> String
forall r. PrintfType r => String -> r
printf "%.4f%s"
((Real RatioNat, Fractional Double) => RatioNat -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac @RatioNat @Double (RatioNat -> Double) -> RatioNat -> Double
forall a b. (a -> b) -> a -> b
$ Time unit -> RatioNat
forall (rat :: Rat). Time rat -> RatioNat
unTime Time unit
n)
(KnownUnitName unit => String
forall (unit :: Rat). KnownUnitName unit => String
unitNameVal @unit)
genEither :: MonadGen m => m a -> m b -> m (Either a b)
genEither :: m a -> m b -> m (Either a b)
genEither genA :: m a
genA genB :: m b
genB = [m (Either a b)] -> m (Either a b)
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice [ a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> m a -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
genA, b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> m b -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
genB ]
genTuple2 :: MonadGen m => m a -> m b -> m (a, b)
genTuple2 :: m a -> m b -> m (a, b)
genTuple2 = (a -> b -> (a, b)) -> m a -> m b -> m (a, b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)
runGen :: HasCallStack => Range.Size -> Word64 -> Gen a -> a
runGen :: Size -> Word64 -> Gen a -> a
runGen size :: Size
size seed :: Word64
seed genT :: Gen a
genT =
let tree :: TreeT (MaybeT Identity) a
tree = Size -> Seed -> Gen a -> TreeT (MaybeT Identity) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size (Word64 -> Seed
Seed.from Word64
seed) Gen a
genT
node :: NodeT (MaybeT Identity) a
node = NodeT (MaybeT Identity) a
-> Maybe (NodeT (MaybeT Identity) a) -> NodeT (MaybeT Identity) a
forall a. a -> Maybe a -> a
fromMaybe NodeT (MaybeT Identity) a
discardedErr (Maybe (NodeT (MaybeT Identity) a) -> NodeT (MaybeT Identity) a)
-> Maybe (NodeT (MaybeT Identity) a) -> NodeT (MaybeT Identity) a
forall a b. (a -> b) -> a -> b
$ Identity (Maybe (NodeT (MaybeT Identity) a))
-> Maybe (NodeT (MaybeT Identity) a)
forall a. Identity a -> a
runIdentity (Identity (Maybe (NodeT (MaybeT Identity) a))
-> Maybe (NodeT (MaybeT Identity) a))
-> Identity (Maybe (NodeT (MaybeT Identity) a))
-> Maybe (NodeT (MaybeT Identity) a)
forall a b. (a -> b) -> a -> b
$ MaybeT Identity (NodeT (MaybeT Identity) a)
-> Identity (Maybe (NodeT (MaybeT Identity) a))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Identity (NodeT (MaybeT Identity) a)
-> Identity (Maybe (NodeT (MaybeT Identity) a)))
-> MaybeT Identity (NodeT (MaybeT Identity) a)
-> Identity (Maybe (NodeT (MaybeT Identity) a))
forall a b. (a -> b) -> a -> b
$ TreeT (MaybeT Identity) a
-> MaybeT Identity (NodeT (MaybeT Identity) a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT (MaybeT Identity) a
tree
discardedErr :: NodeT (MaybeT Identity) a
discardedErr = Text -> NodeT (MaybeT Identity) a
forall a. HasCallStack => Text -> a
error (Text -> NodeT (MaybeT Identity) a)
-> Text -> NodeT (MaybeT Identity) a
forall a b. (a -> b) -> a -> b
$
"Generator could not produce a value for size "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Size -> Text
forall b a. (Show a, IsString b) => a -> b
show Size
size Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " and seed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall b a. (Show a, IsString b) => a -> b
show Word64
seed
in NodeT (MaybeT Identity) a -> a
forall (m :: * -> *) a. NodeT m a -> a
nodeValue NodeT (MaybeT Identity) a
node
roundtripTest
:: forall x y err.
( Show x
, Show err
, Typeable x
, Arbitrary x
, Eq x
, Eq err
)
=> (x -> y)
-> (y -> Either err x)
-> TestTree
roundtripTest :: (x -> y) -> (y -> Either err x) -> TestTree
roundtripTest xToY :: x -> y
xToY yToX :: y -> Either err x
yToX = String -> (x -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
TQC.testProperty String
typeName x -> Property
check
where
typeName :: String
typeName = TypeRep -> String
forall b a. (Show a, IsString b) => a -> b
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy x -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy x
forall k (t :: k). Proxy t
Proxy @x)
check :: x -> QC.Property
check :: x -> Property
check x :: x
x = y -> Either err x
yToX (x -> y
xToY x
x) Either err x -> Either err x -> Property
forall a. (Eq a, Show a) => a -> a -> Property
QC.=== x -> Either err x
forall a b. b -> Either a b
Right x
x
{-# DEPRECATED roundtripTest "Use 'roundtripTree' instead." #-}
roundtripTree
:: forall x y err.
( Show x
, Show y
, Show err
, Typeable x
, Eq x
, Eq err
)
=> Gen x
-> (x -> y)
-> (y -> Either err x)
-> TestTree
roundtripTree :: Gen x -> (x -> y) -> (y -> Either err x) -> TestTree
roundtripTree genX :: Gen x
genX xToY :: x -> y
xToY yToX :: y -> Either err x
yToX = String -> Property -> TestTree
testProperty String
typeNameX Property
prop
where
typeNameX :: String
typeNameX = TypeRep -> String
forall b a. (Show a, IsString b) => a -> b
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy x -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy x
forall k (t :: k). Proxy t
Proxy @x)
prop :: Property
prop :: Property
prop = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
x
x <- Gen x -> PropertyT IO x
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen x
genX
x -> (x -> y) -> (y -> Either err x) -> PropertyT IO ()
forall (m :: * -> *) (f :: * -> *) b a.
(MonadTest m, Applicative f, Show b, Show (f a), Eq (f a),
HasCallStack) =>
a -> (a -> b) -> (b -> f a) -> m ()
tripping x
x x -> y
xToY y -> Either err x
yToX