-- Whole module is just orphans
{-# OPTIONS_GHC -Wno-orphans #-}

{- | A collection of QuickCheck instances. This doesn't export any identifiers,
 so should be imported with an empty import list.
-}
module Plutarch.Test.QuickCheck.Instances () where

import Data.ByteString (ByteString)
import Data.Char (chr, ord)
import Data.Kind (Type)
import Data.Word (Word64, Word8)
import GHC.Exts (coerce, fromList, fromListN, toList)
import Plutarch.Test.QuickCheck.Modifiers (GenValue (GenValue))
import PlutusLedgerApi.V1.Time (DiffMilliSeconds (DiffMilliSeconds))
import PlutusLedgerApi.V2 (
  Address (Address, addressCredential, addressStakingCredential),
  BuiltinByteString,
  BuiltinData,
  Credential (PubKeyCredential, ScriptCredential),
  Data (B, Constr, I, List, Map),
  Datum (Datum),
  DatumHash (DatumHash),
  LedgerBytes (LedgerBytes),
  OutputDatum (NoOutputDatum, OutputDatum, OutputDatumHash),
  POSIXTime (POSIXTime),
  PubKeyHash (PubKeyHash),
  ScriptHash (ScriptHash),
  StakingCredential (StakingHash, StakingPtr),
  TokenName (TokenName),
  TxId (TxId),
  TxOut (TxOut, txOutAddress, txOutDatum, txOutReferenceScript, txOutValue),
  TxOutRef (TxOutRef, txOutRefId, txOutRefIdx),
  builtinDataToData,
  dataToBuiltinData,
  fromBuiltin,
  toBuiltin,
 )
import Test.QuickCheck (
  ASCIIString (ASCIIString),
  Arbitrary (arbitrary, shrink),
  CoArbitrary (coarbitrary),
  Function (function),
  Gen,
  NonNegative (NonNegative),
  Positive (Positive),
  functionMap,
  getNonNegative,
 )
import Test.QuickCheck.Gen qualified as Gen

-- | @since 2.1.3
instance Arbitrary BuiltinByteString where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen BuiltinByteString
arbitrary = forall a arep. ToBuiltin a arep => a -> arep
toBuiltin @ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
  {-# INLINEABLE shrink #-}
  shrink :: BuiltinByteString -> [BuiltinByteString]
shrink =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a arep. ToBuiltin a arep => a -> arep
toBuiltin @ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arbitrary a => a -> [a]
shrink
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall arep a. FromBuiltin arep a => arep -> a
fromBuiltin

-- | @since 2.1.3
instance CoArbitrary BuiltinByteString where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. BuiltinByteString -> Gen b -> Gen b
coarbitrary = forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall arep a. FromBuiltin arep a => arep -> a
fromBuiltin

-- | @since 2.1.3
instance Function BuiltinByteString where
  {-# INLINEABLE function #-}
  function :: forall b. (BuiltinByteString -> b) -> BuiltinByteString :-> b
function =
    forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap
      (forall l. IsList l => l -> [Item l]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall arep a. FromBuiltin arep a => arep -> a
fromBuiltin)
      (forall a arep. ToBuiltin a arep => a -> arep
toBuiltin @ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList)

{- | This instance constructs /truly/ random 'Data'. In most cases, you probably
 want something more specific.

 = Note

 The shrinker shrinks \'within\' a 'Data' constructor: thus, 'B' will shrink
 to 'B', 'I' will shrink to 'I', etc. 'Constr' is treated specially: shrinks
 will proceed in two ways:

 - Shrinking to a \'smaller\' constructor tag; and
 - Shrinking the arg list.

 @since 2.1.3
-}
instance Arbitrary Data where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen Data
arbitrary = forall a. (Int -> Gen a) -> Gen a
Gen.sized Int -> Gen Data
go
    where
      go :: Int -> Gen Data
      go :: Int -> Gen Data
go Int
size
        | Int
size forall a. Ord a => a -> a -> Bool
<= Int
0 =
            forall a. [Gen a] -> Gen a
Gen.oneof
              [ ByteString -> Data
B forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
vectorOfUpTo Int
64 forall a. Arbitrary a => Gen a
arbitrary
              , Integer -> Data
I forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
              ]
        | Bool
otherwise =
            forall a. [Gen a] -> Gen a
Gen.oneof
              [ ByteString -> Data
B forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
vectorOfUpTo Int
64 forall a. Arbitrary a => Gen a
arbitrary
              , Integer -> Data
I forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
              , [Data] -> Data
List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
Gen.listOf (Int -> Gen Data
go forall a b. (a -> b) -> a -> b
$ Int
size forall a. Integral a => a -> a -> a
`quot` Int
2)
              , [(Data, Data)] -> Data
Map forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
Gen.listOf ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Data
go (Int
size forall a. Integral a => a -> a -> a
`quot` Int
2) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen Data
go (Int
size forall a. Integral a => a -> a -> a
`quot` Int
2))
              , Integer -> [Data] -> Data
Constr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. NonNegative a -> a
getNonNegative forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Gen a -> Gen [a]
Gen.listOf (Int -> Gen Data
go forall a b. (a -> b) -> a -> b
$ Int
size forall a. Integral a => a -> a -> a
`quot` Int
2)
              ]
  {-# INLINEABLE shrink #-}
  shrink :: Data -> [Data]
shrink = \case
    B ByteString
bs -> ByteString -> Data
B forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Arbitrary a => a -> [a]
shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList forall a b. (a -> b) -> a -> b
$ ByteString
bs)
    I Integer
i -> Integer -> Data
I forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink Integer
i
    List [Data]
xs -> [Data] -> Data
List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink [Data]
xs
    Map [(Data, Data)]
kvs -> [(Data, Data)] -> Data
Map forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink [(Data, Data)]
kvs
    Constr Integer
ix [Data]
args ->
      Integer -> [Data] -> Data
Constr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. NonNegative a -> a
getNonNegative forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Arbitrary a => a -> [a]
shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> NonNegative a
NonNegative forall a b. (a -> b) -> a -> b
$ Integer
ix)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => a -> [a]
shrink [Data]
args

-- | @since 2.1.3
instance CoArbitrary Data where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. Data -> Gen b -> Gen b
coarbitrary Data
dat = case Data
dat of
    I Integer
i -> forall n a. Integral n => n -> Gen a -> Gen a
Gen.variant (Int
0 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Integer
i
    B ByteString
bs -> forall n a. Integral n => n -> Gen a -> Gen a
Gen.variant (Int
1 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (forall l. IsList l => l -> [Item l]
toList ByteString
bs)
    List [Data]
xs -> forall n a. Integral n => n -> Gen a -> Gen a
Gen.variant (Int
2 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary [Data]
xs
    Map [(Data, Data)]
kvs -> forall n a. Integral n => n -> Gen a -> Gen a
Gen.variant (Int
3 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary [(Data, Data)]
kvs
    Constr Integer
ix [Data]
args -> forall n a. Integral n => n -> Gen a -> Gen a
Gen.variant (Int
4 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Integer
ix forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary [Data]
args

-- | @since 2.1.3
instance Function Data where
  {-# INLINEABLE function #-}
  function :: forall b. (Data -> b) -> Data :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Data
-> Either
     (Either Integer [Word8])
     (Either [Data] (Either [(Data, Data)] (Integer, [Data])))
into Either
  (Either Integer [Word8])
  (Either [Data] (Either [(Data, Data)] (Integer, [Data])))
-> Data
outOf
    where
      into ::
        Data ->
        Either
          (Either Integer [Word8])
          (Either [Data] (Either [(Data, Data)] (Integer, [Data])))
      into :: Data
-> Either
     (Either Integer [Word8])
     (Either [Data] (Either [(Data, Data)] (Integer, [Data])))
into = \case
        I Integer
i -> forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Integer
i
        B ByteString
bs -> forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList forall a b. (a -> b) -> a -> b
$ ByteString
bs
        List [Data]
xs -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Data]
xs
        Map [(Data, Data)]
kvs -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [(Data, Data)]
kvs
        Constr Integer
ix [Data]
args -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ (Integer
ix, [Data]
args)
      outOf ::
        Either
          (Either Integer [Word8])
          (Either [Data] (Either [(Data, Data)] (Integer, [Data]))) ->
        Data
      outOf :: Either
  (Either Integer [Word8])
  (Either [Data] (Either [(Data, Data)] (Integer, [Data])))
-> Data
outOf = \case
        Left (Left Integer
i) -> Integer -> Data
I Integer
i
        Left (Right [Word8]
w8s) -> ByteString -> Data
B forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList forall a b. (a -> b) -> a -> b
$ [Word8]
w8s
        Right (Left [Data]
xs) -> [Data] -> Data
List [Data]
xs
        Right (Right (Left [(Data, Data)]
kvs)) -> [(Data, Data)] -> Data
Map [(Data, Data)]
kvs
        Right (Right (Right (Integer
ix, [Data]
args))) -> Integer -> [Data] -> Data
Constr Integer
ix [Data]
args

-- | @since 2.1.3
deriving via Integer instance Arbitrary DiffMilliSeconds

-- | @since 2.1.3
deriving via Integer instance CoArbitrary DiffMilliSeconds

-- | @since 2.1.3
instance Function DiffMilliSeconds where
  -- We have to do it this way, because via-derivation fails due to the
  -- non-contravariance of :->.
  {-# INLINEABLE function #-}
  function :: forall b. (DiffMilliSeconds -> b) -> DiffMilliSeconds :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (coerce :: forall a b. Coercible a b => a -> b
coerce @_ @Integer) coerce :: forall a b. Coercible a b => a -> b
coerce

-- | @since 2.1.3
deriving via BuiltinByteString instance Arbitrary LedgerBytes

-- | @since 2.1.3
deriving via BuiltinByteString instance CoArbitrary LedgerBytes

-- | @since 2.1.3
instance Function LedgerBytes where
  {-# INLINEABLE function #-}
  function :: forall b. (LedgerBytes -> b) -> LedgerBytes :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (coerce :: forall a b. Coercible a b => a -> b
coerce @_ @BuiltinByteString) coerce :: forall a b. Coercible a b => a -> b
coerce

-- | @since 2.1.3
deriving via (NonNegative Integer) instance Arbitrary POSIXTime

-- | @since 2.1.3
deriving via Integer instance CoArbitrary POSIXTime

-- | @since 2.1.3
instance Function POSIXTime where
  {-# INLINEABLE function #-}
  function :: forall b. (POSIXTime -> b) -> POSIXTime :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (coerce :: forall a b. Coercible a b => a -> b
coerce @_ @Integer) coerce :: forall a b. Coercible a b => a -> b
coerce

-- Note from Koz: We write these instances 'by hand' as, while 'BuiltinData'
-- does expose its constructor, via-derivations are blocked. Not sure why this
-- is.

-- | @since 2.1.3
instance Arbitrary BuiltinData where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen BuiltinData
arbitrary = Data -> BuiltinData
dataToBuiltinData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
  {-# INLINEABLE shrink #-}
  shrink :: BuiltinData -> [BuiltinData]
shrink = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Data -> BuiltinData
dataToBuiltinData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arbitrary a => a -> [a]
shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Data
builtinDataToData

-- | @since 2.1.3
instance CoArbitrary BuiltinData where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. BuiltinData -> Gen b -> Gen b
coarbitrary BuiltinData
dat = forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (BuiltinData -> Data
builtinDataToData BuiltinData
dat)

-- | @since 2.1.3
instance Function BuiltinData where
  {-# INLINEABLE function #-}
  function :: forall b. (BuiltinData -> b) -> BuiltinData :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap BuiltinData -> Data
builtinDataToData Data -> BuiltinData
dataToBuiltinData

{- | This is based on 'DatumHash' being a Blake2b-256 hash, which is 32 bytes
 long. This type does not shrink, as it wouldn't really make much sense to.

 @since 2.1.3
-}
instance Arbitrary DatumHash where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen DatumHash
arbitrary = do
    ByteString
inner <- forall l. IsList l => Int -> [Item l] -> l
fromListN Int
32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
Gen.vectorOf Int
32 forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> DatumHash
DatumHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a arep. ToBuiltin a arep => a -> arep
toBuiltin @ByteString forall a b. (a -> b) -> a -> b
$ ByteString
inner

-- | @since 2.1.3
deriving via BuiltinByteString instance CoArbitrary DatumHash

-- | @since 2.1.3
instance Function DatumHash where
  {-# INLINEABLE function #-}
  function :: forall b. (DatumHash -> b) -> DatumHash :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (coerce :: forall a b. Coercible a b => a -> b
coerce @_ @BuiltinByteString) coerce :: forall a b. Coercible a b => a -> b
coerce

-- | @since 2.1.3
deriving via BuiltinData instance Arbitrary Datum

-- | @since 2.1.3
deriving via BuiltinData instance CoArbitrary Datum

-- | @since 2.1.3
instance Function Datum where
  {-# INLINEABLE function #-}
  function :: forall b. (Datum -> b) -> Datum :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (coerce :: forall a b. Coercible a b => a -> b
coerce @_ @BuiltinData) coerce :: forall a b. Coercible a b => a -> b
coerce

{- | This is based on 'PubKeyHash' being a Blake2b-224 hash, which is 28 bytes
 long. This type does not shrink, as it wouldn't really make much sense to.

 @since 2.1.3
-}
instance Arbitrary PubKeyHash where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen PubKeyHash
arbitrary = do
    ByteString
inner <- forall l. IsList l => Int -> [Item l] -> l
fromListN Int
28 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
Gen.vectorOf Int
28 forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> PubKeyHash
PubKeyHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a arep. ToBuiltin a arep => a -> arep
toBuiltin @ByteString forall a b. (a -> b) -> a -> b
$ ByteString
inner

-- | @since 2.1.3
deriving via BuiltinByteString instance CoArbitrary PubKeyHash

-- | @since 2.1.3
instance Function PubKeyHash where
  {-# INLINEABLE function #-}
  function :: forall b. (PubKeyHash -> b) -> PubKeyHash :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (coerce :: forall a b. Coercible a b => a -> b
coerce @_ @BuiltinByteString) coerce :: forall a b. Coercible a b => a -> b
coerce

{- | This will generate either a 'PubKeyCredential' or a 'ScriptCredential' with
 equal probability. As neither 'PubKeyHash' nor 'ValidatorHash' shrink, this
 type doesn't either.

 @since 2.1.3
-}
instance Arbitrary Credential where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen Credential
arbitrary =
    forall a. [Gen a] -> Gen a
Gen.oneof
      [ PubKeyHash -> Credential
PubKeyCredential forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      , ScriptHash -> Credential
ScriptCredential forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      ]

-- | @since 2.1.3
instance CoArbitrary Credential where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. Credential -> Gen b -> Gen b
coarbitrary Credential
cred = case Credential
cred of
    PubKeyCredential PubKeyHash
phk -> forall n a. Integral n => n -> Gen a -> Gen a
Gen.variant (Int
0 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary PubKeyHash
phk
    ScriptCredential ScriptHash
vh -> forall n a. Integral n => n -> Gen a -> Gen a
Gen.variant (Int
1 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary ScriptHash
vh

-- | @since 2.1.3
instance Function Credential where
  {-# INLINEABLE function #-}
  function :: forall b. (Credential -> b) -> Credential :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Credential -> Either PubKeyHash ScriptHash
into forall a b. (a -> b) -> a -> b
$ \case
    Left PubKeyHash
pkh -> PubKeyHash -> Credential
PubKeyCredential PubKeyHash
pkh
    Right ScriptHash
vh -> ScriptHash -> Credential
ScriptCredential ScriptHash
vh
    where
      into :: Credential -> Either PubKeyHash ScriptHash
      into :: Credential -> Either PubKeyHash ScriptHash
into = \case
        PubKeyCredential PubKeyHash
pkh -> forall a b. a -> Either a b
Left PubKeyHash
pkh
        ScriptCredential ScriptHash
vh -> forall a b. b -> Either a b
Right ScriptHash
vh

{- | This is based on 'TxId' being a Blake2b-256 hash, which is 32 bytes
 long. This type does not shrink, as it wouldn't really make much sense to.

 @since 2.1.3
-}
deriving via DatumHash instance Arbitrary TxId

-- | @since 2.1.3
deriving via DatumHash instance CoArbitrary TxId

-- | @since 2.1.3
instance Function TxId where
  {-# INLINEABLE function #-}
  function :: forall b. (TxId -> b) -> TxId :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (coerce :: forall a b. Coercible a b => a -> b
coerce @_ @BuiltinByteString) coerce :: forall a b. Coercible a b => a -> b
coerce

{- | This will generate a zero-based index for the 'txOutRefIdx` field.
 Furthermore, the shrinker will shrink /only/ in the 'txOutRefIdx' field
 toward zero, as 'TxId's do not shrink.

 @since 2.1.3
-}
instance Arbitrary TxOutRef where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen TxOutRef
arbitrary = do
    TxId
id' <- forall a. Arbitrary a => Gen a
arbitrary
    NonNegative Integer
idx <- forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ TxOutRef {txOutRefId :: TxId
txOutRefId = TxId
id', txOutRefIdx :: Integer
txOutRefIdx = Integer
idx}
  {-# INLINEABLE shrink #-}
  shrink :: TxOutRef -> [TxOutRef]
shrink TxOutRef
tor = do
    NonNegative Integer
idx' <- forall a. Arbitrary a => a -> [a]
shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> NonNegative a
NonNegative forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> Integer
txOutRefIdx forall a b. (a -> b) -> a -> b
$ TxOutRef
tor
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ TxOutRef
tor {txOutRefIdx :: Integer
txOutRefIdx = Integer
idx'}

-- | @since 2.1.3
instance CoArbitrary TxOutRef where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. TxOutRef -> Gen b -> Gen b
coarbitrary TxOutRef
tor = forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (TxOutRef -> TxId
txOutRefId TxOutRef
tor) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (TxOutRef -> Integer
txOutRefIdx TxOutRef
tor)

-- | @since 2.1.3
instance Function TxOutRef where
  {-# INLINEABLE function #-}
  function :: forall b. (TxOutRef -> b) -> TxOutRef :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap TxOutRef -> (TxId, Integer)
into forall a b. (a -> b) -> a -> b
$ \(TxId
id', Integer
idx) ->
    TxOutRef
      { txOutRefId :: TxId
txOutRefId = TxId
id'
      , txOutRefIdx :: Integer
txOutRefIdx = Integer
idx
      }
    where
      into :: TxOutRef -> (TxId, Integer)
      into :: TxOutRef -> (TxId, Integer)
into TxOutRef
tor = (TxOutRef -> TxId
txOutRefId TxOutRef
tor, TxOutRef -> Integer
txOutRefIdx TxOutRef
tor)

-- | @since 2.1.3
instance Arbitrary StakingCredential where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen StakingCredential
arbitrary =
    forall a. [Gen a] -> Gen a
Gen.oneof
      [ Credential -> StakingCredential
StakingHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      , Integer -> Integer -> Integer -> StakingCredential
StakingPtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
go forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Integer
go forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Integer
go
      ]
    where
      -- Based on documentation bounding it to Word64
      go :: Gen Integer
      go :: Gen Integer
go = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @Word64

-- | @since 2.1.3
instance CoArbitrary StakingCredential where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. StakingCredential -> Gen b -> Gen b
coarbitrary = \case
    StakingHash Credential
cred -> forall n a. Integral n => n -> Gen a -> Gen a
Gen.variant (Int
0 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Credential
cred
    StakingPtr Integer
i Integer
j Integer
k ->
      forall n a. Integral n => n -> Gen a -> Gen a
Gen.variant (Int
1 :: Int)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Integer
i
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Integer
j
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Integer
k

-- | @since 2.1.3
instance Function StakingCredential where
  {-# INLINEABLE function #-}
  function :: forall b. (StakingCredential -> b) -> StakingCredential :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap StakingCredential -> Either Credential (Integer, Integer, Integer)
into forall a b. (a -> b) -> a -> b
$ \case
    Left Credential
cred -> Credential -> StakingCredential
StakingHash Credential
cred
    Right (Integer
i, Integer
j, Integer
k) -> Integer -> Integer -> Integer -> StakingCredential
StakingPtr Integer
i Integer
j Integer
k
    where
      into :: StakingCredential -> Either Credential (Integer, Integer, Integer)
      into :: StakingCredential -> Either Credential (Integer, Integer, Integer)
into = \case
        StakingHash Credential
cred -> forall a b. a -> Either a b
Left Credential
cred
        StakingPtr Integer
i Integer
j Integer
k -> forall a b. b -> Either a b
Right (Integer
i, Integer
j, Integer
k)

{- | As neither 'Credential' nor 'StakingCredential' shrink, this type doesn't
 either.

 @since 2.1.3
-}
instance Arbitrary Address where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen Address
arbitrary = do
    Credential
cred <- forall a. Arbitrary a => Gen a
arbitrary
    Maybe StakingCredential
scred <- forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      Address
        { addressCredential :: Credential
addressCredential = Credential
cred
        , addressStakingCredential :: Maybe StakingCredential
addressStakingCredential = Maybe StakingCredential
scred
        }

-- | @since 2.1.3
instance CoArbitrary Address where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. Address -> Gen b -> Gen b
coarbitrary Address
addr =
    forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (Address -> Credential
addressCredential Address
addr)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (Address -> Maybe StakingCredential
addressStakingCredential Address
addr)

-- | @since 2.1.3
instance Function Address where
  {-# INLINEABLE function #-}
  function :: forall b. (Address -> b) -> Address :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Address -> (Credential, Maybe StakingCredential)
into forall a b. (a -> b) -> a -> b
$ \(Credential
cred, Maybe StakingCredential
scred) ->
    Address
      { addressCredential :: Credential
addressCredential = Credential
cred
      , addressStakingCredential :: Maybe StakingCredential
addressStakingCredential = Maybe StakingCredential
scred
      }
    where
      into :: Address -> (Credential, Maybe StakingCredential)
      into :: Address -> (Credential, Maybe StakingCredential)
into Address
addr = (Address -> Credential
addressCredential Address
addr, Address -> Maybe StakingCredential
addressStakingCredential Address
addr)

{- | This generates only those 'TokenName's corresponding to ASCII strings. This
 is somewhat limited, but otherwise would require UTF-8 encoding as part of
 the generator. It would also significantly complicate shrinks: we would have
 to re-encode, shrink, then decode again.

 @since 2.1.3
-}
instance Arbitrary TokenName where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen TokenName
arbitrary =
    BuiltinByteString -> TokenName
TokenName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      ASCIIString String
name <- forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a. Applicative f => a -> f a
pure
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a arep. ToBuiltin a arep => a -> arep
toBuiltin @ByteString
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)
        forall a b. (a -> b) -> a -> b
$ String
name
  {-# INLINEABLE shrink #-}
  shrink :: TokenName -> [TokenName]
shrink (TokenName BuiltinByteString
name) = do
    let name' :: ASCIIString
name' =
          String -> ASCIIString
ASCIIString
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall arep a. FromBuiltin arep a => arep -> a
fromBuiltin
            forall a b. (a -> b) -> a -> b
$ BuiltinByteString
name
    ASCIIString String
name'' <- forall a. Arbitrary a => a -> [a]
shrink ASCIIString
name'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> TokenName
TokenName
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a arep. ToBuiltin a arep => a -> arep
toBuiltin @ByteString
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)
      forall a b. (a -> b) -> a -> b
$ String
name''

-- | @since 2.1.3
deriving via BuiltinByteString instance CoArbitrary TokenName

-- | @since 2.3.1
instance Function TokenName where
  {-# INLINEABLE function #-}
  function :: forall b. (TokenName -> b) -> TokenName :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (coerce :: forall a b. Coercible a b => a -> b
coerce @_ @BuiltinByteString) coerce :: forall a b. Coercible a b => a -> b
coerce

{- | The shrinker for this type will not shrink \'out-of-arm\'. Effectively,
 this means 'NoOutputDatum' does not shrink, 'OutputDatumHash' also does not
 shrink (as 'DatumHash' doesn't), and 'OutputDatum' will shrink to other
 'OutputDatum's.

 @since 2.1.3
-}
instance Arbitrary OutputDatum where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen OutputDatum
arbitrary =
    forall a. [Gen a] -> Gen a
Gen.oneof
      [ forall (f :: * -> *) a. Applicative f => a -> f a
pure OutputDatum
NoOutputDatum
      , DatumHash -> OutputDatum
OutputDatumHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      , Datum -> OutputDatum
OutputDatum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      ]
  {-# INLINEABLE shrink #-}
  shrink :: OutputDatum -> [OutputDatum]
shrink = \case
    OutputDatum
NoOutputDatum -> []
    OutputDatumHash DatumHash
_ -> []
    OutputDatum Datum
dat -> Datum -> OutputDatum
OutputDatum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink Datum
dat

-- | @since 2.1.3
instance CoArbitrary OutputDatum where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. OutputDatum -> Gen b -> Gen b
coarbitrary OutputDatum
od = case OutputDatum
od of
    OutputDatum
NoOutputDatum -> forall n a. Integral n => n -> Gen a -> Gen a
Gen.variant (Int
0 :: Int)
    OutputDatumHash DatumHash
dh -> forall n a. Integral n => n -> Gen a -> Gen a
Gen.variant (Int
1 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary DatumHash
dh
    OutputDatum Datum
dat -> forall n a. Integral n => n -> Gen a -> Gen a
Gen.variant (Int
2 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Datum
dat

-- | @since 2.1.3
instance Function OutputDatum where
  {-# INLINEABLE function #-}
  function :: forall b. (OutputDatum -> b) -> OutputDatum :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap OutputDatum -> Maybe (Either DatumHash Datum)
into forall a b. (a -> b) -> a -> b
$ \case
    Maybe (Either DatumHash Datum)
Nothing -> OutputDatum
NoOutputDatum
    Just (Left DatumHash
dh) -> DatumHash -> OutputDatum
OutputDatumHash DatumHash
dh
    Just (Right Datum
dat) -> Datum -> OutputDatum
OutputDatum Datum
dat
    where
      into :: OutputDatum -> Maybe (Either DatumHash Datum)
      into :: OutputDatum -> Maybe (Either DatumHash Datum)
into = \case
        OutputDatum
NoOutputDatum -> forall a. Maybe a
Nothing
        OutputDatumHash DatumHash
dh -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ DatumHash
dh
        OutputDatum Datum
dat -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Datum
dat

{- | This is based on 'ScriptHash' being a Blake2b-224 hash, which is 28 bytes
 long. This type does not shrink, as it wouldn't really make much sense to.

 @since 2.1.3
-}
deriving via PubKeyHash instance Arbitrary ScriptHash

-- | @since 2.1.3
deriving via PubKeyHash instance CoArbitrary ScriptHash

-- | @since 2.1.3
instance Function ScriptHash where
  {-# INLINEABLE function #-}
  function :: forall b. (ScriptHash -> b) -> ScriptHash :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (coerce :: forall a b. Coercible a b => a -> b
coerce @_ @BuiltinByteString) coerce :: forall a b. Coercible a b => a -> b
coerce

-- | @since 2.1.3
instance Arbitrary TxOut where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen TxOut
arbitrary = do
    Address
addr <- forall a. Arbitrary a => Gen a
arbitrary
    GenValue Value
val <- forall a. Arbitrary a => Gen a
arbitrary @(GenValue NonNegative Positive)
    OutputDatum
outDatum <- forall a. Arbitrary a => Gen a
arbitrary
    Maybe ScriptHash
refScript <- forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      TxOut
        { txOutAddress :: Address
txOutAddress = Address
addr
        , txOutValue :: Value
txOutValue = Value
val
        , txOutDatum :: OutputDatum
txOutDatum = OutputDatum
outDatum
        , txOutReferenceScript :: Maybe ScriptHash
txOutReferenceScript = Maybe ScriptHash
refScript
        }
  {-# INLINEABLE shrink #-}
  shrink :: TxOut -> [TxOut]
shrink TxOut
txOut = do
    -- We skip Address, as it doesn't shrink anyway
    GenValue Value
val' :: GenValue NonNegative Positive <-
      forall a. Arbitrary a => a -> [a]
shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (adaMod :: * -> *) (otherMod :: * -> *).
Value -> GenValue adaMod otherMod
GenValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Value
txOutValue forall a b. (a -> b) -> a -> b
$ TxOut
txOut
    OutputDatum
outDatum' <- forall a. Arbitrary a => a -> [a]
shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> OutputDatum
txOutDatum forall a b. (a -> b) -> a -> b
$ TxOut
txOut
    Maybe ScriptHash
refScript' <- forall a. Arbitrary a => a -> [a]
shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Maybe ScriptHash
txOutReferenceScript forall a b. (a -> b) -> a -> b
$ TxOut
txOut
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      TxOut
txOut
        { txOutValue :: Value
txOutValue = Value
val'
        , txOutDatum :: OutputDatum
txOutDatum = OutputDatum
outDatum'
        , txOutReferenceScript :: Maybe ScriptHash
txOutReferenceScript = Maybe ScriptHash
refScript'
        }

-- | @since 2.1.3
instance CoArbitrary TxOut where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. TxOut -> Gen b -> Gen b
coarbitrary TxOut
txOut =
    forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (TxOut -> Address
txOutAddress TxOut
txOut)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary ((forall (adaMod :: * -> *) (otherMod :: * -> *).
Value -> GenValue adaMod otherMod
GenValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Value
txOutValue forall a b. (a -> b) -> a -> b
$ TxOut
txOut) :: GenValue NonNegative Positive)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (TxOut -> OutputDatum
txOutDatum TxOut
txOut)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (TxOut -> Maybe ScriptHash
txOutReferenceScript TxOut
txOut)

-- | @since 2.1.3
instance Function TxOut where
  {-# INLINEABLE function #-}
  function :: forall b. (TxOut -> b) -> TxOut :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap TxOut
-> (Address, GenValue NonNegative Positive, OutputDatum,
    Maybe ScriptHash)
into forall a b. (a -> b) -> a -> b
$ \(Address
addr, GenValue Value
val, OutputDatum
outDatum, Maybe ScriptHash
refScript) ->
    TxOut
      { txOutAddress :: Address
txOutAddress = Address
addr
      , txOutValue :: Value
txOutValue = Value
val
      , txOutDatum :: OutputDatum
txOutDatum = OutputDatum
outDatum
      , txOutReferenceScript :: Maybe ScriptHash
txOutReferenceScript = Maybe ScriptHash
refScript
      }
    where
      into ::
        TxOut ->
        (Address, GenValue NonNegative Positive, OutputDatum, Maybe ScriptHash)
      into :: TxOut
-> (Address, GenValue NonNegative Positive, OutputDatum,
    Maybe ScriptHash)
into TxOut
txOut =
        ( TxOut -> Address
txOutAddress TxOut
txOut
        , forall (adaMod :: * -> *) (otherMod :: * -> *).
Value -> GenValue adaMod otherMod
GenValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Value
txOutValue forall a b. (a -> b) -> a -> b
$ TxOut
txOut
        , TxOut -> OutputDatum
txOutDatum TxOut
txOut
        , TxOut -> Maybe ScriptHash
txOutReferenceScript TxOut
txOut
        )

-- Helpers

-- Similar to 'vectorOf', but instead generates a size-dependent length up to
-- the specified maximum (or the size, whichever is smaller).
vectorOfUpTo ::
  forall (a :: Type).
  Int ->
  Gen a ->
  Gen [a]
vectorOfUpTo :: forall a. Int -> Gen a -> Gen [a]
vectorOfUpTo Int
lim Gen a
gen = forall a. (Int -> Gen a) -> Gen a
Gen.sized forall a b. (a -> b) -> a -> b
$ \Int
size -> do
  Int
len <- (Int, Int) -> Gen Int
Gen.chooseInt (Int
0, forall a. Ord a => a -> a -> a
min Int
size Int
lim)
  forall a. Int -> Gen a -> Gen [a]
Gen.vectorOf Int
len Gen a
gen