{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Test.Cardano.Ledger.Imp.Common (
module X,
io,
assertBool,
assertFailure,
assertColorFailure,
expectationFailure,
shouldBe,
shouldSatisfy,
shouldSatisfyExpr,
shouldStartWith,
shouldEndWith,
shouldContain,
shouldMatchList,
shouldReturn,
shouldNotBe,
shouldNotSatisfy,
shouldNotContain,
shouldNotReturn,
shouldThrow,
shouldBeExpr,
shouldBeRight,
shouldBeLeft,
shouldBeRightExpr,
shouldBeLeftExpr,
shouldContainExpr,
expectRight,
expectRightDeep_,
expectRightDeep,
expectRightExpr,
expectRightDeepExpr,
expectLeft,
expectLeftDeep_,
expectLeftExpr,
expectLeftDeep,
expectLeftDeepExpr,
expectJust,
expectNothingExpr,
module QuickCheckT,
arbitrary,
HasStatefulGen (..),
HasGenEnv (..),
HasSubState (..),
subStateM,
setSubStateM,
R.StatefulGen,
StateGen (..),
StateGenM (..),
uniformM,
uniformRM,
uniformListM,
uniformListRM,
uniformByteStringM,
uniformShortByteStringM,
)
where
import Control.Monad.IO.Class
import Data.Functor.Const (Const (..))
import Data.Functor.Identity (Identity (..))
import Test.Cardano.Ledger.Binary.TreeDiff (expectExprEqualWithMessage)
import Test.Cardano.Ledger.Common as X hiding (
arbitrary,
assertBool,
assertColorFailure,
assertFailure,
choose,
elements,
expectLeft,
expectLeftDeep,
expectLeftDeepExpr,
expectLeftDeep_,
expectLeftExpr,
expectRight,
expectRightDeep,
expectRightDeepExpr,
expectRightDeep_,
expectRightExpr,
expectationFailure,
frequency,
growingElements,
listOf,
listOf1,
oneof,
resize,
shouldBe,
shouldBeExpr,
shouldBeLeft,
shouldBeLeftExpr,
shouldBeRight,
shouldBeRightExpr,
shouldContain,
shouldEndWith,
shouldMatchList,
shouldNotBe,
shouldNotContain,
shouldNotReturn,
shouldNotSatisfy,
shouldReturn,
shouldSatisfy,
shouldStartWith,
shouldThrow,
sized,
suchThat,
suchThatMaybe,
variant,
vectorOf,
)
import qualified Test.Cardano.Ledger.Common as H
import Test.QuickCheck.GenT as QuickCheckT
import UnliftIO (MonadUnliftIO (..))
import UnliftIO.Exception (Exception, evaluateDeep)
import Control.Monad.Reader
import Control.Monad.State
import Data.ByteString (ByteString)
import Data.ByteString.Short (ShortByteString)
import Data.Kind
import Data.List (isInfixOf)
import Foreign.Storable
import qualified System.Random.Stateful as R
instance MonadUnliftIO m => MonadUnliftIO (GenT m) where
withRunInIO :: forall b. ((forall a. GenT m a -> IO a) -> IO b) -> GenT m b
withRunInIO (forall a. GenT m a -> IO a) -> IO b
inner = forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT forall a b. (a -> b) -> a -> b
$ \QCGen
qc Int
sz ->
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> (forall a. GenT m a -> IO a) -> IO b
inner forall a b. (a -> b) -> a -> b
$ \(GenT QCGen -> Int -> m a
f) -> forall a. m a -> IO a
run (QCGen -> Int -> m a
f QCGen
qc Int
sz)
infix 1 `shouldBe`
, `shouldBeExpr`
, `shouldSatisfy`
, `shouldStartWith`
, `shouldEndWith`
, `shouldContain`
, `shouldMatchList`
, `shouldReturn`
, `shouldThrow`
, `shouldNotBe`
, `shouldNotSatisfy`
, `shouldNotContain`
, `shouldNotReturn`
, `shouldBeRight`
, `shouldBeRightExpr`
, `shouldBeLeft`
, `shouldBeLeftExpr`
io :: IO a -> IO a
io :: forall a. IO a -> IO a
io = forall a. a -> a
id
assertFailure :: (HasCallStack, MonadIO m) => String -> m a
assertFailure :: forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => String -> IO a
H.assertFailure
assertColorFailure :: (HasCallStack, MonadIO m) => String -> m a
assertColorFailure :: forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertColorFailure = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => String -> IO a
H.assertColorFailure
assertBool :: (HasCallStack, MonadIO m) => String -> Bool -> m ()
assertBool :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> Bool -> m ()
assertBool String
msg = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
H.assertBool String
msg
expectationFailure :: (HasCallStack, MonadIO m) => String -> m ()
expectationFailure :: forall (m :: * -> *). (HasCallStack, MonadIO m) => String -> m ()
expectationFailure = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Assertion
H.expectationFailure
shouldBe :: (HasCallStack, Show a, Eq a, MonadIO m) => a -> a -> m ()
shouldBe :: forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
shouldBe a
x a
y = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (HasCallStack, Show a, Eq a) => a -> a -> Assertion
H.shouldBe a
x a
y
shouldBeExpr :: (HasCallStack, ToExpr a, Eq a, MonadIO m) => a -> a -> m ()
shouldBeExpr :: forall a (m :: * -> *).
(HasCallStack, ToExpr a, Eq a, MonadIO m) =>
a -> a -> m ()
shouldBeExpr a
expected a
actual = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
(ToExpr a, Eq a, HasCallStack) =>
String -> a -> a -> Assertion
expectExprEqualWithMessage String
"" a
expected a
actual
shouldSatisfy :: (HasCallStack, Show a, MonadIO m) => a -> (a -> Bool) -> m ()
shouldSatisfy :: forall a (m :: * -> *).
(HasCallStack, Show a, MonadIO m) =>
a -> (a -> Bool) -> m ()
shouldSatisfy a
x a -> Bool
f = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Assertion
H.shouldSatisfy a
x a -> Bool
f
shouldSatisfyExpr :: (HasCallStack, MonadIO m, ToExpr a) => a -> (a -> Bool) -> m ()
shouldSatisfyExpr :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, ToExpr a) =>
a -> (a -> Bool) -> m ()
shouldSatisfyExpr a
x a -> Bool
f
| a -> Bool
f a
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure forall a b. (a -> b) -> a -> b
$ String
"predicate failed on:\n" forall a. Semigroup a => a -> a -> a
<> forall a. ToExpr a => a -> String
showExpr a
x
shouldStartWith :: (HasCallStack, Show a, Eq a, MonadIO m) => [a] -> [a] -> m ()
shouldStartWith :: forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
[a] -> [a] -> m ()
shouldStartWith [a]
x [a]
y = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> Assertion
H.shouldStartWith [a]
x [a]
y
shouldEndWith :: (HasCallStack, Show a, Eq a, MonadIO m) => [a] -> [a] -> m ()
shouldEndWith :: forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
[a] -> [a] -> m ()
shouldEndWith [a]
x [a]
y = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> Assertion
H.shouldEndWith [a]
x [a]
y
shouldContain :: (HasCallStack, Show a, Eq a, MonadIO m) => [a] -> [a] -> m ()
shouldContain :: forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
[a] -> [a] -> m ()
shouldContain [a]
x [a]
y = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> Assertion
H.shouldContain [a]
x [a]
y
shouldContainExpr :: (HasCallStack, ToExpr a, Eq a, MonadIO m) => [a] -> [a] -> m ()
shouldContainExpr :: forall a (m :: * -> *).
(HasCallStack, ToExpr a, Eq a, MonadIO m) =>
[a] -> [a] -> m ()
shouldContainExpr [a]
x [a]
y
| [a]
y forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [a]
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise =
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure forall a b. (a -> b) -> a -> b
$
String
"First list does not contain the second list:\n"
forall a. Semigroup a => a -> a -> a
<> forall a. ToExpr a => a -> String
showExpr [a]
x
forall a. Semigroup a => a -> a -> a
<> String
"\ndoes not contain\n"
forall a. Semigroup a => a -> a -> a
<> forall a. ToExpr a => a -> String
showExpr [a]
y
shouldMatchList :: (HasCallStack, Show a, Eq a, MonadIO m) => [a] -> [a] -> m ()
shouldMatchList :: forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
[a] -> [a] -> m ()
shouldMatchList [a]
x [a]
y = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> Assertion
H.shouldMatchList [a]
x [a]
y
shouldReturn :: (HasCallStack, Show a, Eq a, MonadUnliftIO m) => m a -> a -> m ()
shouldReturn :: forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
shouldReturn m a
f a
a = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Assertion
H.shouldReturn (forall a. m a -> IO a
run m a
f) a
a
shouldNotBe :: (HasCallStack, Show a, Eq a, MonadIO m) => a -> a -> m ()
shouldNotBe :: forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
shouldNotBe a
x a
y = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (HasCallStack, Show a, Eq a) => a -> a -> Assertion
H.shouldNotBe a
x a
y
shouldNotSatisfy :: (HasCallStack, Show a, MonadIO m) => a -> (a -> Bool) -> m ()
shouldNotSatisfy :: forall a (m :: * -> *).
(HasCallStack, Show a, MonadIO m) =>
a -> (a -> Bool) -> m ()
shouldNotSatisfy a
a a -> Bool
f = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Assertion
H.shouldNotSatisfy a
a a -> Bool
f
shouldNotContain :: (HasCallStack, Show a, Eq a, MonadIO m) => [a] -> [a] -> m ()
shouldNotContain :: forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
[a] -> [a] -> m ()
shouldNotContain [a]
x [a]
y = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> Assertion
H.shouldNotContain [a]
x [a]
y
shouldNotReturn :: (HasCallStack, Show a, Eq a, MonadUnliftIO m) => m a -> a -> m ()
shouldNotReturn :: forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
shouldNotReturn m a
f a
a = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Assertion
H.shouldNotReturn (forall a. m a -> IO a
run m a
f) a
a
shouldThrow :: (HasCallStack, Exception e, MonadUnliftIO m) => m a -> Selector e -> m ()
shouldThrow :: forall e (m :: * -> *) a.
(HasCallStack, Exception e, MonadUnliftIO m) =>
m a -> Selector e -> m ()
shouldThrow m a
f Selector e
s = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> Assertion
H.shouldThrow (forall a. m a -> IO a
run m a
f) Selector e
s
expectRight :: (HasCallStack, Show a, MonadIO m) => Either a b -> m b
expectRight :: forall a (m :: * -> *) b.
(HasCallStack, Show a, MonadIO m) =>
Either a b -> m b
expectRight (Right b
r) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! b
r
expectRight (Left a
l) = forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure forall a b. (a -> b) -> a -> b
$ String
"Expected Right, got Left:\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
l
expectRightDeep_ :: (HasCallStack, Show a, NFData b, MonadIO m) => Either a b -> m ()
expectRightDeep_ :: forall a b (m :: * -> *).
(HasCallStack, Show a, NFData b, MonadIO m) =>
Either a b -> m ()
expectRightDeep_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b (m :: * -> *).
(HasCallStack, Show a, NFData b, MonadIO m) =>
Either a b -> m b
expectRightDeep
expectRightDeep :: (HasCallStack, Show a, NFData b, MonadIO m) => Either a b -> m b
expectRightDeep :: forall a b (m :: * -> *).
(HasCallStack, Show a, NFData b, MonadIO m) =>
Either a b -> m b
expectRightDeep = forall a (m :: * -> *) b.
(HasCallStack, Show a, MonadIO m) =>
Either a b -> m b
expectRight forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m a
evaluateDeep
expectRightExpr :: (HasCallStack, ToExpr a, MonadIO m) => Either a b -> m b
expectRightExpr :: forall a (m :: * -> *) b.
(HasCallStack, ToExpr a, MonadIO m) =>
Either a b -> m b
expectRightExpr (Right b
r) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! b
r
expectRightExpr (Left a
l) = forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure forall a b. (a -> b) -> a -> b
$ String
"Expected Right, got Left:\n" forall a. Semigroup a => a -> a -> a
<> forall a. ToExpr a => a -> String
showExpr a
l
expectRightDeepExpr :: (HasCallStack, ToExpr a, NFData b, MonadIO m) => Either a b -> m b
expectRightDeepExpr :: forall a b (m :: * -> *).
(HasCallStack, ToExpr a, NFData b, MonadIO m) =>
Either a b -> m b
expectRightDeepExpr = forall a (m :: * -> *) b.
(HasCallStack, ToExpr a, MonadIO m) =>
Either a b -> m b
expectRightExpr forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m a
evaluateDeep
shouldBeRight :: (HasCallStack, Show a, Show b, Eq b, MonadIO m) => Either a b -> b -> m ()
shouldBeRight :: forall a b (m :: * -> *).
(HasCallStack, Show a, Show b, Eq b, MonadIO m) =>
Either a b -> b -> m ()
shouldBeRight Either a b
e b
x = forall a (m :: * -> *) b.
(HasCallStack, Show a, MonadIO m) =>
Either a b -> m b
expectRight Either a b
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` b
x)
shouldBeRightExpr :: (HasCallStack, ToExpr a, Eq b, ToExpr b, MonadIO m) => Either a b -> b -> m ()
shouldBeRightExpr :: forall a b (m :: * -> *).
(HasCallStack, ToExpr a, Eq b, ToExpr b, MonadIO m) =>
Either a b -> b -> m ()
shouldBeRightExpr Either a b
e b
x = forall a (m :: * -> *) b.
(HasCallStack, ToExpr a, MonadIO m) =>
Either a b -> m b
expectRightExpr Either a b
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a (m :: * -> *).
(HasCallStack, ToExpr a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBeExpr` b
x)
expectLeft :: (HasCallStack, Show b, MonadIO m) => Either a b -> m a
expectLeft :: forall b (m :: * -> *) a.
(HasCallStack, Show b, MonadIO m) =>
Either a b -> m a
expectLeft (Left a
l) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! a
l
expectLeft (Right b
r) = forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure forall a b. (a -> b) -> a -> b
$ String
"Expected Left, got Right:\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show b
r
expectLeftDeep_ :: (HasCallStack, MonadIO m, Show b, NFData a) => Either a b -> m ()
expectLeftDeep_ :: forall (m :: * -> *) b a.
(HasCallStack, MonadIO m, Show b, NFData a) =>
Either a b -> m ()
expectLeftDeep_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b (m :: * -> *).
(HasCallStack, NFData a, Show b, MonadIO m) =>
Either a b -> m a
expectLeftDeep
expectLeftDeep :: (HasCallStack, NFData a, Show b, MonadIO m) => Either a b -> m a
expectLeftDeep :: forall a b (m :: * -> *).
(HasCallStack, NFData a, Show b, MonadIO m) =>
Either a b -> m a
expectLeftDeep = forall b (m :: * -> *) a.
(HasCallStack, Show b, MonadIO m) =>
Either a b -> m a
expectLeft forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m a
evaluateDeep
expectLeftExpr :: (HasCallStack, ToExpr b, MonadIO m) => Either a b -> m a
expectLeftExpr :: forall b (m :: * -> *) a.
(HasCallStack, ToExpr b, MonadIO m) =>
Either a b -> m a
expectLeftExpr (Left a
l) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! a
l
expectLeftExpr (Right b
r) = forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure forall a b. (a -> b) -> a -> b
$ String
"Expected Left, got Right:\n" forall a. Semigroup a => a -> a -> a
<> forall a. ToExpr a => a -> String
showExpr b
r
expectLeftDeepExpr :: (HasCallStack, ToExpr b, NFData a, MonadIO m) => Either a b -> m a
expectLeftDeepExpr :: forall b a (m :: * -> *).
(HasCallStack, ToExpr b, NFData a, MonadIO m) =>
Either a b -> m a
expectLeftDeepExpr = forall b (m :: * -> *) a.
(HasCallStack, ToExpr b, MonadIO m) =>
Either a b -> m a
expectLeftExpr forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m a
evaluateDeep
shouldBeLeft :: (HasCallStack, Show a, Eq a, Show b, MonadIO m) => Either a b -> a -> m ()
shouldBeLeft :: forall a b (m :: * -> *).
(HasCallStack, Show a, Eq a, Show b, MonadIO m) =>
Either a b -> a -> m ()
shouldBeLeft Either a b
e a
x = forall b (m :: * -> *) a.
(HasCallStack, Show b, MonadIO m) =>
Either a b -> m a
expectLeft Either a b
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` a
x)
shouldBeLeftExpr :: (HasCallStack, ToExpr a, ToExpr b, Eq a, MonadIO m) => Either a b -> a -> m ()
shouldBeLeftExpr :: forall a b (m :: * -> *).
(HasCallStack, ToExpr a, ToExpr b, Eq a, MonadIO m) =>
Either a b -> a -> m ()
shouldBeLeftExpr Either a b
e a
x = forall b (m :: * -> *) a.
(HasCallStack, ToExpr b, MonadIO m) =>
Either a b -> m a
expectLeftExpr Either a b
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a (m :: * -> *).
(HasCallStack, ToExpr a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBeExpr` a
x)
expectJust :: (HasCallStack, MonadIO m) => Maybe a -> m a
expectJust :: forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Maybe a -> m a
expectJust (Just a
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
expectJust Maybe a
Nothing = forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure String
"Expected Just, got Nothing"
expectNothingExpr :: (HasCallStack, MonadIO m, ToExpr a) => Maybe a -> m ()
expectNothingExpr :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, ToExpr a) =>
Maybe a -> m ()
expectNothingExpr (Just a
x) =
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure forall a b. (a -> b) -> a -> b
$
String
"Expected Nothing, got Just:\n" forall a. Semigroup a => a -> a -> a
<> forall a. ToExpr a => a -> String
showExpr a
x
expectNothingExpr Maybe a
Nothing = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
arbitrary :: (Arbitrary a, MonadGen m) => m a
arbitrary :: forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary = forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen forall a. Arbitrary a => Gen a
H.arbitrary
class R.StatefulGen g m => HasStatefulGen g m | m -> g where
askStatefulGen :: m g
class HasGenEnv env g | env -> g where
getGenEnv :: env -> g
instance
(HasGenEnv env g, R.StatefulGen g (ReaderT env m), Monad m) =>
HasStatefulGen g (ReaderT env m)
where
askStatefulGen :: ReaderT env m g
askStatefulGen = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall env g. HasGenEnv env g => env -> g
getGenEnv
class HasSubState s where
type SubState s :: Type
getSubState :: s -> SubState s
getSubState = forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (f :: * -> *).
(HasSubState s, Functor f) =>
(SubState s -> f (SubState s)) -> s -> f s
subStateL forall {k} a (b :: k). a -> Const a b
Const
setSubState :: s -> SubState s -> s
setSubState s
s SubState s
a = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall s (f :: * -> *).
(HasSubState s, Functor f) =>
(SubState s -> f (SubState s)) -> s -> f s
subStateL (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. a -> Identity a
Identity SubState s
a) s
s
subStateL :: Functor f => (SubState s -> f (SubState s)) -> (s -> f s)
subStateL SubState s -> f (SubState s)
k s
s = forall s. HasSubState s => s -> SubState s -> s
setSubState s
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SubState s -> f (SubState s)
k (forall s. HasSubState s => s -> SubState s
getSubState s
s)
{-# MINIMAL subStateL | getSubState, setSubState #-}
setSubStateM :: (HasSubState s, MonadState s m) => SubState s -> m ()
setSubStateM :: forall s (m :: * -> *).
(HasSubState s, MonadState s m) =>
SubState s -> m ()
setSubStateM SubState s
s = forall s (m :: * -> *) a.
(HasSubState s, MonadState s m) =>
(SubState s -> (a, SubState s)) -> m a
subStateM forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const ((), SubState s
s)
{-# INLINE setSubStateM #-}
subStateM :: (HasSubState s, MonadState s m) => (SubState s -> (a, SubState s)) -> m a
subStateM :: forall s (m :: * -> *) a.
(HasSubState s, MonadState s m) =>
(SubState s -> (a, SubState s)) -> m a
subStateM = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (f :: * -> *).
(HasSubState s, Functor f) =>
(SubState s -> f (SubState s)) -> s -> f s
subStateL
{-# INLINE subStateM #-}
uniformM ::
( HasStatefulGen g m
, R.Uniform a
) =>
m a
uniformM :: forall g (m :: * -> *) a. (HasStatefulGen g m, Uniform a) => m a
uniformM = forall g (m :: * -> *). HasStatefulGen g m => m g
askStatefulGen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
R.uniformM
{-# INLINE uniformM #-}
uniformRM ::
( HasStatefulGen g m
, R.UniformRange a
) =>
(a, a) ->
m a
uniformRM :: forall g (m :: * -> *) a.
(HasStatefulGen g m, UniformRange a) =>
(a, a) -> m a
uniformRM (a, a)
r = forall g (m :: * -> *). HasStatefulGen g m => m g
askStatefulGen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
R.uniformRM (a, a)
r
{-# INLINE uniformRM #-}
uniformListM ::
( HasStatefulGen g m
, R.Uniform a
) =>
Int ->
m [a]
uniformListM :: forall g (m :: * -> *) a.
(HasStatefulGen g m, Uniform a) =>
Int -> m [a]
uniformListM Int
n = forall g (m :: * -> *). HasStatefulGen g m => m g
askStatefulGen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall g (m :: * -> *) a.
(StatefulGen g m, Uniform a) =>
Int -> g -> m [a]
R.uniformListM Int
n
{-# INLINE uniformListM #-}
uniformListRM ::
( HasStatefulGen g m
, R.UniformRange a
) =>
(a, a) ->
Int ->
m [a]
uniformListRM :: forall g (m :: * -> *) a.
(HasStatefulGen g m, UniformRange a) =>
(a, a) -> Int -> m [a]
uniformListRM (a, a)
r Int
n = forall g (m :: * -> *). HasStatefulGen g m => m g
askStatefulGen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
R.uniformRM (a, a)
r
{-# INLINE uniformListRM #-}
uniformByteStringM :: HasStatefulGen a m => Int -> m ByteString
uniformByteStringM :: forall a (m :: * -> *). HasStatefulGen a m => Int -> m ByteString
uniformByteStringM Int
n = forall g (m :: * -> *). HasStatefulGen g m => m g
askStatefulGen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall g (m :: * -> *). StatefulGen g m => Int -> g -> m ByteString
R.uniformByteStringM Int
n
{-# INLINE uniformByteStringM #-}
uniformShortByteStringM :: HasStatefulGen a m => Int -> m ShortByteString
uniformShortByteStringM :: forall a (m :: * -> *).
HasStatefulGen a m =>
Int -> m ShortByteString
uniformShortByteStringM Int
n = forall g (m :: * -> *). HasStatefulGen g m => m g
askStatefulGen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall g (m :: * -> *).
StatefulGen g m =>
Int -> g -> m ShortByteString
R.uniformShortByteString Int
n
{-# INLINE uniformShortByteStringM #-}
data StateGenM s = StateGenM
newtype StateGen s = StateGen {forall s. StateGen s -> s
unStateGen :: s}
deriving (StateGen s -> StateGen s -> Bool
forall s. Eq s => StateGen s -> StateGen s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateGen s -> StateGen s -> Bool
$c/= :: forall s. Eq s => StateGen s -> StateGen s -> Bool
== :: StateGen s -> StateGen s -> Bool
$c== :: forall s. Eq s => StateGen s -> StateGen s -> Bool
Eq, StateGen s -> StateGen s -> Bool
StateGen s -> StateGen s -> Ordering
StateGen s -> StateGen s -> StateGen s
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {s}. Ord s => Eq (StateGen s)
forall s. Ord s => StateGen s -> StateGen s -> Bool
forall s. Ord s => StateGen s -> StateGen s -> Ordering
forall s. Ord s => StateGen s -> StateGen s -> StateGen s
min :: StateGen s -> StateGen s -> StateGen s
$cmin :: forall s. Ord s => StateGen s -> StateGen s -> StateGen s
max :: StateGen s -> StateGen s -> StateGen s
$cmax :: forall s. Ord s => StateGen s -> StateGen s -> StateGen s
>= :: StateGen s -> StateGen s -> Bool
$c>= :: forall s. Ord s => StateGen s -> StateGen s -> Bool
> :: StateGen s -> StateGen s -> Bool
$c> :: forall s. Ord s => StateGen s -> StateGen s -> Bool
<= :: StateGen s -> StateGen s -> Bool
$c<= :: forall s. Ord s => StateGen s -> StateGen s -> Bool
< :: StateGen s -> StateGen s -> Bool
$c< :: forall s. Ord s => StateGen s -> StateGen s -> Bool
compare :: StateGen s -> StateGen s -> Ordering
$ccompare :: forall s. Ord s => StateGen s -> StateGen s -> Ordering
Ord, Int -> StateGen s -> ShowS
forall s. Show s => Int -> StateGen s -> ShowS
forall s. Show s => [StateGen s] -> ShowS
forall s. Show s => StateGen s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StateGen s] -> ShowS
$cshowList :: forall s. Show s => [StateGen s] -> ShowS
show :: StateGen s -> String
$cshow :: forall s. Show s => StateGen s -> String
showsPrec :: Int -> StateGen s -> ShowS
$cshowsPrec :: forall s. Show s => Int -> StateGen s -> ShowS
Show, Int -> StateGen s -> (ShortByteString, StateGen s)
Word32 -> StateGen s -> (Word32, StateGen s)
Word64 -> StateGen s -> (Word64, StateGen s)
StateGen s -> (Int, Int)
StateGen s -> (Int, StateGen s)
StateGen s -> (Word8, StateGen s)
StateGen s -> (Word16, StateGen s)
StateGen s -> (Word32, StateGen s)
StateGen s -> (Word64, StateGen s)
StateGen s -> (StateGen s, StateGen s)
forall s.
RandomGen s =>
Int -> StateGen s -> (ShortByteString, StateGen s)
forall s.
RandomGen s =>
Word32 -> StateGen s -> (Word32, StateGen s)
forall s.
RandomGen s =>
Word64 -> StateGen s -> (Word64, StateGen s)
forall s. RandomGen s => StateGen s -> (Int, Int)
forall s. RandomGen s => StateGen s -> (Int, StateGen s)
forall s. RandomGen s => StateGen s -> (Word8, StateGen s)
forall s. RandomGen s => StateGen s -> (Word16, StateGen s)
forall s. RandomGen s => StateGen s -> (Word32, StateGen s)
forall s. RandomGen s => StateGen s -> (Word64, StateGen s)
forall s. RandomGen s => StateGen s -> (StateGen s, StateGen s)
forall g.
(g -> (Int, g))
-> (g -> (Word8, g))
-> (g -> (Word16, g))
-> (g -> (Word32, g))
-> (g -> (Word64, g))
-> (Word32 -> g -> (Word32, g))
-> (Word64 -> g -> (Word64, g))
-> (Int -> g -> (ShortByteString, g))
-> (g -> (Int, Int))
-> (g -> (g, g))
-> RandomGen g
split :: StateGen s -> (StateGen s, StateGen s)
$csplit :: forall s. RandomGen s => StateGen s -> (StateGen s, StateGen s)
genRange :: StateGen s -> (Int, Int)
$cgenRange :: forall s. RandomGen s => StateGen s -> (Int, Int)
genShortByteString :: Int -> StateGen s -> (ShortByteString, StateGen s)
$cgenShortByteString :: forall s.
RandomGen s =>
Int -> StateGen s -> (ShortByteString, StateGen s)
genWord64R :: Word64 -> StateGen s -> (Word64, StateGen s)
$cgenWord64R :: forall s.
RandomGen s =>
Word64 -> StateGen s -> (Word64, StateGen s)
genWord32R :: Word32 -> StateGen s -> (Word32, StateGen s)
$cgenWord32R :: forall s.
RandomGen s =>
Word32 -> StateGen s -> (Word32, StateGen s)
genWord64 :: StateGen s -> (Word64, StateGen s)
$cgenWord64 :: forall s. RandomGen s => StateGen s -> (Word64, StateGen s)
genWord32 :: StateGen s -> (Word32, StateGen s)
$cgenWord32 :: forall s. RandomGen s => StateGen s -> (Word32, StateGen s)
genWord16 :: StateGen s -> (Word16, StateGen s)
$cgenWord16 :: forall s. RandomGen s => StateGen s -> (Word16, StateGen s)
genWord8 :: StateGen s -> (Word8, StateGen s)
$cgenWord8 :: forall s. RandomGen s => StateGen s -> (Word8, StateGen s)
next :: StateGen s -> (Int, StateGen s)
$cnext :: forall s. RandomGen s => StateGen s -> (Int, StateGen s)
R.RandomGen, Ptr (StateGen s) -> IO (StateGen s)
Ptr (StateGen s) -> Int -> IO (StateGen s)
Ptr (StateGen s) -> Int -> StateGen s -> Assertion
Ptr (StateGen s) -> StateGen s -> Assertion
StateGen s -> Int
forall b. Ptr b -> Int -> IO (StateGen s)
forall b. Ptr b -> Int -> StateGen s -> Assertion
forall s. Storable s => Ptr (StateGen s) -> IO (StateGen s)
forall s. Storable s => Ptr (StateGen s) -> Int -> IO (StateGen s)
forall s.
Storable s =>
Ptr (StateGen s) -> Int -> StateGen s -> Assertion
forall s. Storable s => Ptr (StateGen s) -> StateGen s -> Assertion
forall s. Storable s => StateGen s -> Int
forall s b. Storable s => Ptr b -> Int -> IO (StateGen s)
forall s b. Storable s => Ptr b -> Int -> StateGen s -> Assertion
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> Assertion)
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> Assertion)
-> (Ptr a -> IO a)
-> (Ptr a -> a -> Assertion)
-> Storable a
poke :: Ptr (StateGen s) -> StateGen s -> Assertion
$cpoke :: forall s. Storable s => Ptr (StateGen s) -> StateGen s -> Assertion
peek :: Ptr (StateGen s) -> IO (StateGen s)
$cpeek :: forall s. Storable s => Ptr (StateGen s) -> IO (StateGen s)
pokeByteOff :: forall b. Ptr b -> Int -> StateGen s -> Assertion
$cpokeByteOff :: forall s b. Storable s => Ptr b -> Int -> StateGen s -> Assertion
peekByteOff :: forall b. Ptr b -> Int -> IO (StateGen s)
$cpeekByteOff :: forall s b. Storable s => Ptr b -> Int -> IO (StateGen s)
pokeElemOff :: Ptr (StateGen s) -> Int -> StateGen s -> Assertion
$cpokeElemOff :: forall s.
Storable s =>
Ptr (StateGen s) -> Int -> StateGen s -> Assertion
peekElemOff :: Ptr (StateGen s) -> Int -> IO (StateGen s)
$cpeekElemOff :: forall s. Storable s => Ptr (StateGen s) -> Int -> IO (StateGen s)
alignment :: StateGen s -> Int
$calignment :: forall s. Storable s => StateGen s -> Int
sizeOf :: StateGen s -> Int
$csizeOf :: forall s. Storable s => StateGen s -> Int
Storable, StateGen s -> ()
forall s. NFData s => StateGen s -> ()
forall a. (a -> ()) -> NFData a
rnf :: StateGen s -> ()
$crnf :: forall s. NFData s => StateGen s -> ()
NFData)
instance HasSubState (StateGen g) where
type SubState (StateGen g) = g
getSubState :: StateGen g -> SubState (StateGen g)
getSubState (StateGen g
g) = g
g
{-# INLINE getSubState #-}
setSubState :: StateGen g -> SubState (StateGen g) -> StateGen g
setSubState StateGen g
_ = forall s. s -> StateGen s
StateGen
{-# INLINE setSubState #-}
instance
(HasSubState s, R.RandomGen (SubState s), MonadState s m) =>
R.StatefulGen (StateGenM s) m
where
uniformWord32R :: Word32 -> StateGenM s -> m Word32
uniformWord32R Word32
r StateGenM s
_ = forall s (m :: * -> *) a.
(HasSubState s, MonadState s m) =>
(SubState s -> (a, SubState s)) -> m a
subStateM (forall g. RandomGen g => Word32 -> g -> (Word32, g)
R.genWord32R Word32
r)
{-# INLINE uniformWord32R #-}
uniformWord64R :: Word64 -> StateGenM s -> m Word64
uniformWord64R Word64
r StateGenM s
_ = forall s (m :: * -> *) a.
(HasSubState s, MonadState s m) =>
(SubState s -> (a, SubState s)) -> m a
subStateM (forall g. RandomGen g => Word64 -> g -> (Word64, g)
R.genWord64R Word64
r)
{-# INLINE uniformWord64R #-}
uniformWord8 :: StateGenM s -> m Word8
uniformWord8 StateGenM s
_ = forall s (m :: * -> *) a.
(HasSubState s, MonadState s m) =>
(SubState s -> (a, SubState s)) -> m a
subStateM forall g. RandomGen g => g -> (Word8, g)
R.genWord8
{-# INLINE uniformWord8 #-}
uniformWord16 :: StateGenM s -> m Word16
uniformWord16 StateGenM s
_ = forall s (m :: * -> *) a.
(HasSubState s, MonadState s m) =>
(SubState s -> (a, SubState s)) -> m a
subStateM forall g. RandomGen g => g -> (Word16, g)
R.genWord16
{-# INLINE uniformWord16 #-}
uniformWord32 :: StateGenM s -> m Word32
uniformWord32 StateGenM s
_ = forall s (m :: * -> *) a.
(HasSubState s, MonadState s m) =>
(SubState s -> (a, SubState s)) -> m a
subStateM forall g. RandomGen g => g -> (Word32, g)
R.genWord32
{-# INLINE uniformWord32 #-}
uniformWord64 :: StateGenM s -> m Word64
uniformWord64 StateGenM s
_ = forall s (m :: * -> *) a.
(HasSubState s, MonadState s m) =>
(SubState s -> (a, SubState s)) -> m a
subStateM forall g. RandomGen g => g -> (Word64, g)
R.genWord64
{-# INLINE uniformWord64 #-}
uniformShortByteString :: Int -> StateGenM s -> m ShortByteString
uniformShortByteString Int
n StateGenM s
_ = forall s (m :: * -> *) a.
(HasSubState s, MonadState s m) =>
(SubState s -> (a, SubState s)) -> m a
subStateM (forall g. RandomGen g => Int -> g -> (ShortByteString, g)
R.genShortByteString Int
n)
{-# INLINE uniformShortByteString #-}