{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RoleAnnotations #-}

module Plutarch.Test.QuickCheck.Modifiers (
  -- * Types
  AdaSymbolPresence (..),
  GenCurrencySymbol (..),
  GenValue (..),
  TimeDelta,

  -- * Functions
  timeDeltaProperty,
  withTimeDelta,
) where

import Control.Monad (guard)
import Data.Bifunctor (bimap, first)
import Data.ByteString (ByteString)
import Data.Char (ord)
import Data.Coerce (Coercible, coerce)
import Data.Kind (Type)
import Data.List (nub, sort)
import Data.Proxy (Proxy (Proxy))
import Data.Semigroup (Sum (Sum))
import Data.Word (Word8)
import GHC.Exts (fromList, fromListN, toList)
import GHC.TypeNats (KnownNat, Nat, natVal, type (<=))
import PlutusLedgerApi.V2 (
  CurrencySymbol (CurrencySymbol),
  POSIXTime (POSIXTime),
  TokenName (TokenName),
  Value (Value),
  fromBuiltin,
  toBuiltin,
 )
import PlutusTx.AssocMap qualified as AssocMap
import Test.QuickCheck (
  ASCIIString (ASCIIString),
  Arbitrary (arbitrary, shrink),
  CoArbitrary (coarbitrary),
  Function (function),
  Gen,
  Negative (Negative),
  NonNegative (NonNegative),
  NonPositive (NonPositive),
  NonZero (NonZero),
  Positive (Positive),
  Property,
  counterexample,
  property,
  shrinkList,
 )
import Test.QuickCheck.Function (functionMap)
import Test.QuickCheck.Gen qualified as Gen

{- | Type-level marker to indicate whether a 'GenCurrencySymbol' can have an ADA
 'CurrencySymbol' inside it or not.

 @since 2.1.3
-}
data AdaSymbolPresence
  = WithAdaSymbol
  | WithoutAdaSymbol
  deriving stock
    ( -- | @since 2.1.3
      AdaSymbolPresence -> AdaSymbolPresence -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AdaSymbolPresence -> AdaSymbolPresence -> Bool
$c/= :: AdaSymbolPresence -> AdaSymbolPresence -> Bool
== :: AdaSymbolPresence -> AdaSymbolPresence -> Bool
$c== :: AdaSymbolPresence -> AdaSymbolPresence -> Bool
Eq
    , -- | @since 2.1.3
      Int -> AdaSymbolPresence -> ShowS
[AdaSymbolPresence] -> ShowS
AdaSymbolPresence -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AdaSymbolPresence] -> ShowS
$cshowList :: [AdaSymbolPresence] -> ShowS
show :: AdaSymbolPresence -> String
$cshow :: AdaSymbolPresence -> String
showsPrec :: Int -> AdaSymbolPresence -> ShowS
$cshowsPrec :: Int -> AdaSymbolPresence -> ShowS
Show
    , -- | @since 2.1.3
      Eq AdaSymbolPresence
AdaSymbolPresence -> AdaSymbolPresence -> Bool
AdaSymbolPresence -> AdaSymbolPresence -> Ordering
AdaSymbolPresence -> AdaSymbolPresence -> AdaSymbolPresence
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
min :: AdaSymbolPresence -> AdaSymbolPresence -> AdaSymbolPresence
$cmin :: AdaSymbolPresence -> AdaSymbolPresence -> AdaSymbolPresence
max :: AdaSymbolPresence -> AdaSymbolPresence -> AdaSymbolPresence
$cmax :: AdaSymbolPresence -> AdaSymbolPresence -> AdaSymbolPresence
>= :: AdaSymbolPresence -> AdaSymbolPresence -> Bool
$c>= :: AdaSymbolPresence -> AdaSymbolPresence -> Bool
> :: AdaSymbolPresence -> AdaSymbolPresence -> Bool
$c> :: AdaSymbolPresence -> AdaSymbolPresence -> Bool
<= :: AdaSymbolPresence -> AdaSymbolPresence -> Bool
$c<= :: AdaSymbolPresence -> AdaSymbolPresence -> Bool
< :: AdaSymbolPresence -> AdaSymbolPresence -> Bool
$c< :: AdaSymbolPresence -> AdaSymbolPresence -> Bool
compare :: AdaSymbolPresence -> AdaSymbolPresence -> Ordering
$ccompare :: AdaSymbolPresence -> AdaSymbolPresence -> Ordering
Ord
    )

{- | A helper (opaque) newtype for QuickCheck use with 'CurrencySymbol's. Has a
 type-level tag to indicate whether or not it could potentially contain a
 'CurrencySymbol'. We provide instances of 'Arbitrary', 'CoArbitrary' and
 'Function' around this newtype, intended to act on the 'CurrencySymbol' inside
 it.

 The easiest way to use this newtype is by pattern matching:

 > forAll arbitrary $ \(GenCurrencySymbol @WithAdaSymbol sym) -> ...

 You can also \'re-wrap\' for shrinking:

 > shrink $ GenCurrencySymbol @WithAdaSymbol sym

However, as 'GenCurrencySymbol' instances do not shrink, there's not much point.

 @since 2.1.3
-}
newtype GenCurrencySymbol (p :: AdaSymbolPresence)
  = GenCurrencySymbol CurrencySymbol
  deriving
    ( -- | @since 2.1.3
      GenCurrencySymbol p -> GenCurrencySymbol p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (p :: AdaSymbolPresence).
GenCurrencySymbol p -> GenCurrencySymbol p -> Bool
/= :: GenCurrencySymbol p -> GenCurrencySymbol p -> Bool
$c/= :: forall (p :: AdaSymbolPresence).
GenCurrencySymbol p -> GenCurrencySymbol p -> Bool
== :: GenCurrencySymbol p -> GenCurrencySymbol p -> Bool
$c== :: forall (p :: AdaSymbolPresence).
GenCurrencySymbol p -> GenCurrencySymbol p -> Bool
Eq
    )
    via CurrencySymbol
  deriving stock
    ( -- | @since 2.1.3
      Int -> GenCurrencySymbol p -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (p :: AdaSymbolPresence).
Int -> GenCurrencySymbol p -> ShowS
forall (p :: AdaSymbolPresence). [GenCurrencySymbol p] -> ShowS
forall (p :: AdaSymbolPresence). GenCurrencySymbol p -> String
showList :: [GenCurrencySymbol p] -> ShowS
$cshowList :: forall (p :: AdaSymbolPresence). [GenCurrencySymbol p] -> ShowS
show :: GenCurrencySymbol p -> String
$cshow :: forall (p :: AdaSymbolPresence). GenCurrencySymbol p -> String
showsPrec :: Int -> GenCurrencySymbol p -> ShowS
$cshowsPrec :: forall (p :: AdaSymbolPresence).
Int -> GenCurrencySymbol p -> ShowS
Show
    )

-- Ensures we can't accidentally mess around with 'coerce'
type role GenCurrencySymbol nominal

{- | This instance occasionally has the ability to produce the ADA symbol (that
 is, the empty 'CurrencySymbol'). However, this is weighted quite heavily in
 favour of the ADA symbol: in theory, assuming every byte is equally probable
 (a safe assumption, since 'CurrencySymbol's are in general hashes), the odds
 of getting the ADA symbol should be

 \[
 frac{1}{2^{8 \cdot 28 = 224} + 1}
 \]

 However, in this case, the odds are actually

 \[
 \frac{1}{2^{62} + 1}
 \]

 This is a limitation of probability distributions as implemented by
 QuickCheck, which uses 'Int' for this purpose. Keep this in mind when using
 this generator: if you're unsure, it's better to \'seed\' the
 'WithoutAdaSymbol' instance to a probability you're happy with using
 'Gen.frequency'.

 This instance does not shrink, as it makes very little sense to.

 @since 2.1.3
-}
instance Arbitrary (GenCurrencySymbol 'WithAdaSymbol) where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen (GenCurrencySymbol 'WithAdaSymbol)
arbitrary =
    forall a. [(Int, Gen a)] -> Gen a
Gen.frequency
      [ (Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: AdaSymbolPresence).
CurrencySymbol -> GenCurrencySymbol p
GenCurrencySymbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> CurrencySymbol
CurrencySymbol 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
"")
      , (Int
big, coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @(GenCurrencySymbol 'WithoutAdaSymbol))
      ]
    where
      -- 2^62
      big :: Int
      big :: Int
big = Int
4_611_686_018_427_387_904

{- | This instance never produces the ADA symbol. Like the corresponding
 'WithAdaSymbol' instance, this instance does not shrink.

 @since 2.1.3
-}
instance Arbitrary (GenCurrencySymbol 'WithoutAdaSymbol) where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen (GenCurrencySymbol 'WithoutAdaSymbol)
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
. forall (p :: AdaSymbolPresence).
CurrencySymbol -> GenCurrencySymbol p
GenCurrencySymbol
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> CurrencySymbol
CurrencySymbol
      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
instance CoArbitrary (GenCurrencySymbol p) where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. GenCurrencySymbol p -> Gen b -> Gen b
coarbitrary (GenCurrencySymbol (CurrencySymbol BuiltinByteString
inner)) =
    forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (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
inner)

-- | @since 2.1.3
instance Function (GenCurrencySymbol p) where
  {-# INLINEABLE function #-}
  function :: forall b. (GenCurrencySymbol p -> b) -> GenCurrencySymbol p :-> b
function =
    forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap
      (\(GenCurrencySymbol (CurrencySymbol BuiltinByteString
inner)) -> 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
inner)
      (forall (p :: AdaSymbolPresence).
CurrencySymbol -> GenCurrencySymbol p
GenCurrencySymbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> CurrencySymbol
CurrencySymbol 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)

{- | A helper (opaque) newtype for QuickCheck use with 'Value's. Has two type
 arguments, to indicate, in order, what kind of amounts ADA and non-ADA
 entries are allowed to have.

 The 'Value's wrapped inside this type are phase-1 valid; the only validity we
 can't guarantee is to do with amounts, as these depend on choice of
 modifiers.

 The easiest way to use this newtype is by pattern matching:

 > forAll arbitrary $ \(GenValue @NonNegative @Positive val) -> ...

 In this case, the ADA entry in @val@ would contain a non-negative amount, but
 any other entry would contain a strictly positive one.

 You can also \'re-wrap\' for shrinking:

 > shrink $ GenValue @NonNegative @Positive val

 = Note

 As 'GenValue' relies heavily on 'Coercible' to work, the newtype constructors
 of your modifiers need to be in scope, or you will get strange errors. For
 example, if you want to do

 > GenValue @NonNegative @Positive val <- arbitrary

 you must have both the 'NonNegative' and 'Positive' types, as well as their
 newtype constructors, imported.

 @since 2.1.3
-}
newtype GenValue (adaMod :: Type -> Type) (otherMod :: Type -> Type)
  = GenValue Value
  deriving
    ( -- | @since 2.1.3
      GenValue adaMod otherMod -> GenValue adaMod otherMod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (adaMod :: * -> *) (otherMod :: * -> *).
GenValue adaMod otherMod -> GenValue adaMod otherMod -> Bool
/= :: GenValue adaMod otherMod -> GenValue adaMod otherMod -> Bool
$c/= :: forall (adaMod :: * -> *) (otherMod :: * -> *).
GenValue adaMod otherMod -> GenValue adaMod otherMod -> Bool
== :: GenValue adaMod otherMod -> GenValue adaMod otherMod -> Bool
$c== :: forall (adaMod :: * -> *) (otherMod :: * -> *).
GenValue adaMod otherMod -> GenValue adaMod otherMod -> Bool
Eq
    )
    via Value
  deriving stock
    ( -- | @since 2.1.3
      Int -> GenValue adaMod otherMod -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (adaMod :: * -> *) (otherMod :: * -> *).
Int -> GenValue adaMod otherMod -> ShowS
forall (adaMod :: * -> *) (otherMod :: * -> *).
[GenValue adaMod otherMod] -> ShowS
forall (adaMod :: * -> *) (otherMod :: * -> *).
GenValue adaMod otherMod -> String
showList :: [GenValue adaMod otherMod] -> ShowS
$cshowList :: forall (adaMod :: * -> *) (otherMod :: * -> *).
[GenValue adaMod otherMod] -> ShowS
show :: GenValue adaMod otherMod -> String
$cshow :: forall (adaMod :: * -> *) (otherMod :: * -> *).
GenValue adaMod otherMod -> String
showsPrec :: Int -> GenValue adaMod otherMod -> ShowS
$cshowsPrec :: forall (adaMod :: * -> *) (otherMod :: * -> *).
Int -> GenValue adaMod otherMod -> ShowS
Show
    )

-- similar coerce shenanigan prevention
type role GenValue nominal nominal

{- | This instance ensures phase-1 validity up to amounts. Specifically, the
 following are guaranteed to hold irrespective of \'tag choices\':

 - Entries whose 'CurrencySymbol' and 'TokenName' match are unique.
 - \'Outer\' map entries are sorted by 'CurrencySymbol'.
 - \'Inner\' map entries are sorted by 'TokenName'.
 - An ADA entry always exists: this corresponds to a mapping from the
 'CurrencySymbol' @""@ to the 'TokenName' @""@ and an amount.
 - ADA entries have singleton \'inner maps\'.
 - Non-ADA entries have non-empty \'inner maps\'.

 The kind of amount generated for ADA and non-ADA entries is controlled by the
 two tags: the first determines how the ADA amount will get generated, while
 the second determines how any non-ADA amounts get generated. Thus,
 @GenValue 'NonNegative 'Positive@ will mean the ADA entry has a zero or
 positive amount, but any other entry will be strictly positive.

 In order to ensure all invariants hold, the shrinker for 'GenValue' can only
 perform the following on the underlying 'Value':

 - Remove non-ADA \'outer map\' entries;
 - Remove \'inner map\' entries; and
 - Shrink the amounts associated with an entry according to the tags.

 More specifically, neither 'CurrencySymbol' or 'TokenMap' keys will be
 shrunk.

 @since 2.1.3
-}
instance
  ( Arbitrary (adaMod Integer)
  , Arbitrary (otherMod Integer)
  , forall (a :: Type). Coercible (adaMod a) a
  , forall (a :: Type). Coercible (otherMod a) a
  ) =>
  Arbitrary (GenValue adaMod otherMod)
  where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen (GenValue adaMod otherMod)
arbitrary =
    forall (adaMod :: * -> *) (otherMod :: * -> *).
Value -> GenValue adaMod otherMod
GenValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CurrencySymbol (Map TokenName Integer) -> Value
Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. [(k, v)] -> Map k v
AssocMap.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      -- First, make an ADA entry
      (CurrencySymbol, Map TokenName Integer)
adaEntry <- forall (adaMod :: * -> *).
(forall a. Coercible (adaMod a) a, Arbitrary (adaMod Integer)) =>
Gen (CurrencySymbol, Map TokenName Integer)
mkAdaEntry @adaMod
      -- Then, generate the rest, making sure not to use the ADA CurrencySymbol
      [CurrencySymbol]
syms <- Gen [CurrencySymbol]
mkOtherEntrySymbols
      ((CurrencySymbol, Map TokenName Integer)
adaEntry forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse CurrencySymbol -> Gen (CurrencySymbol, Map TokenName Integer)
go [CurrencySymbol]
syms
    where
      go ::
        CurrencySymbol ->
        Gen (CurrencySymbol, AssocMap.Map TokenName Integer)
      go :: CurrencySymbol -> Gen (CurrencySymbol, Map TokenName Integer)
go CurrencySymbol
sym =
        (CurrencySymbol
sym,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. [(k, v)] -> Map k v
AssocMap.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
          [TokenName]
tokNames <- Gen [TokenName]
mkTokenNames
          forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (otherMod :: * -> *).
(Arbitrary (otherMod Integer),
 forall a. Coercible (otherMod a) a) =>
TokenName -> Gen (TokenName, Integer)
pairWith @otherMod) [TokenName]
tokNames
  {-# INLINEABLE shrink #-}
  shrink :: GenValue adaMod otherMod -> [GenValue adaMod otherMod]
shrink (GenValue (Value Map CurrencySymbol (Map TokenName Integer)
inner)) = case forall k v. Map k v -> [(k, v)]
AssocMap.toList Map CurrencySymbol (Map TokenName Integer)
inner of
    -- This case is technically impossible, as we never 'shrink away' the ADA
    -- entry.
    [] -> forall a. HasCallStack => String -> a
error String
"Shrinker for GenValue: Empty 'outer map'."
    ((CurrencySymbol, Map TokenName Integer)
adaEntry : [(CurrencySymbol, Map TokenName Integer)]
otherEntries) ->
      forall (adaMod :: * -> *) (otherMod :: * -> *).
Value -> GenValue adaMod otherMod
GenValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CurrencySymbol (Map TokenName Integer) -> Value
Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. [(k, v)] -> Map k v
AssocMap.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        -- Handle ADA entry shrinks by only shrinking the sole amount it has in
        -- it.
        case (CurrencySymbol, Map TokenName Integer)
adaEntry of
          (CurrencySymbol
"", Map TokenName Integer
adaInner) -> case forall k v. Map k v -> [(k, v)]
AssocMap.toList Map TokenName Integer
adaInner of
            [(TokenName
"", Integer
adaMod)] -> do
              Integer
adaMod' <- forall (mod :: * -> *).
(Coercible (mod Integer) Integer, Arbitrary (mod Integer)) =>
Integer -> [Integer]
coerciveShrink @adaMod Integer
adaMod
              let adaEntry' :: (CurrencySymbol, Map TokenName Integer)
adaEntry' = (CurrencySymbol
"", forall k v. [(k, v)] -> Map k v
AssocMap.fromList [(TokenName
"", Integer
adaMod')])
              -- Shrink whatever remains according to the rules.
              [(CurrencySymbol, Map TokenName Integer)]
otherEntries' <-
                forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([(TokenName, Integer)] -> [Map TokenName Integer]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Map k v -> [(k, v)]
AssocMap.toList)) [(CurrencySymbol, Map TokenName Integer)]
otherEntries
              -- Mash everything together.
              forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (CurrencySymbol, Map TokenName Integer)
adaEntry' forall a. a -> [a] -> [a]
: [(CurrencySymbol, Map TokenName Integer)]
otherEntries'
            [(TokenName, Integer)]
_ -> forall a. HasCallStack => String -> a
error String
"Shrinker for GenValue: Malformed 'inner map' for ADA entry."
          (CurrencySymbol, Map TokenName Integer)
_ -> forall a. HasCallStack => String -> a
error String
"Shrinker for GenValue: Bad CurrencySymbol for ADA entry."
    where
      go :: [(TokenName, Integer)] -> [AssocMap.Map TokenName Integer]
      go :: [(TokenName, Integer)] -> [Map TokenName Integer]
go [(TokenName, Integer)]
kvs = do
        [(TokenName, Integer)]
kvs' <- forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (mod :: * -> *).
(Coercible (mod Integer) Integer, Arbitrary (mod Integer)) =>
Integer -> [Integer]
coerciveShrink @otherMod)) [(TokenName, Integer)]
kvs
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ [(TokenName, Integer)]
kvs')
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. [(k, v)] -> Map k v
AssocMap.fromList forall a b. (a -> b) -> a -> b
$ [(TokenName, Integer)]
kvs'

-- | @since 2.1.3
instance CoArbitrary (GenValue adaMod otherMod) where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. GenValue adaMod otherMod -> Gen b -> Gen b
coarbitrary GenValue adaMod otherMod
x = forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (forall (adaMod :: * -> *) (otherMod :: * -> *).
GenValue adaMod otherMod -> [([Word8], [([Word8], Integer)])]
unwrap GenValue adaMod otherMod
x)

-- | @since 2.1.3
instance Function (GenValue adaMod otherMod) where
  {-# INLINEABLE function #-}
  function :: forall b.
(GenValue adaMod otherMod -> b) -> GenValue adaMod otherMod :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall (adaMod :: * -> *) (otherMod :: * -> *).
GenValue adaMod otherMod -> [([Word8], [([Word8], Integer)])]
unwrap forall (adaMod :: * -> *) (otherMod :: * -> *).
[([Word8], [([Word8], Integer)])] -> GenValue adaMod otherMod
rewrap

{- | Represents a change in 'POSIXTime'. The @mod@ argument gives the kind of
 change, represented by a QuickCheck modifier, while the @n@ argument is a
 closed (inclusive) upper bound on the magnitude of the change.

 For example, @'TimeDelta' 'Positive' 100@ represents a change in 'POSIXTime'
 from @1@ to @100@ units, while @'TimeDelta' 'NonPositive' 250@ represents a
 change in 'POSIXTime' from @0@ to @-250@. Modifiers intended to work with
 this type are:

 - 'Positive'
 - 'Negative'
 - 'NonPositive'
 - 'NonNegative'
 - 'NonZero'

 The instances for 'TimeDelta' reflect this decision: while other modifiers
 could potentially be useful, this ensures that we have safe behaviour and
 efficient instances.

 'NonZero' is treated a bit specially in that the magnitude indicated by @n@
 is in both the negative /and/ positive direction. Thus,
 @'TimeDelta' 'NonZero' 50@ spans the union of @[-50, -1]@ and @[1, 50]@.

 Shrinking a 'TimeDelta' will shrink towards zero: more specifically, it will
 reduce the magnitude of the change.

 To control what 'TimeDelta' you get, the easiest method is a type signature:

 > forAll arbitrary $ \(delta :: TimeDelta NonNegative 100) -> ...

 @since 2.1.4
-}
newtype TimeDelta (mod :: Type -> Type) (n :: Nat)
  = TimeDelta (mod POSIXTime)

-- | @since 2.1.4
deriving via
  (mod POSIXTime)
  instance
    (forall (a :: Type). (Eq a) => Eq (mod a)) =>
    Eq (TimeDelta mod n)

-- | @since 2.1.4
deriving stock instance
  (forall (a :: Type). (Show a) => Show (mod a)) =>
  Show (TimeDelta mod n)

{- | Strictly positive deltas are semigroups under addition.

 @since 2.1.4
-}
deriving via (Sum Integer) instance Semigroup (TimeDelta Positive n)

{- | Strictly negative deltas are semigroups under addition.

 @since 2.1.4
-}
deriving via (Sum Integer) instance Semigroup (TimeDelta Negative n)

{- | Non-negative deltas are semigroups under addition.

 @since 2.1.4
-}
deriving via (Sum Integer) instance Semigroup (TimeDelta NonNegative n)

{- | Non-positive deltas are semigroups under addition.

 @since 2.1.4
-}
deriving via (Sum Integer) instance Semigroup (TimeDelta NonPositive n)

{- | Non-negative deltas are monoids with the zero delta as the identity.

 @since 2.1.4
-}
deriving via (Sum Integer) instance Monoid (TimeDelta NonNegative n)

{- | Non-positive deltas are monoids with the zero delta as the identity.

 @since 2.1.4
-}
deriving via (Sum Integer) instance Monoid (TimeDelta NonPositive n)

-- | @since 2.1.4
instance (KnownNat n, 1 <= n) => Arbitrary (TimeDelta NonZero n) where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen (TimeDelta NonZero n)
arbitrary =
    let v :: Integer
v = forall (n :: Nat). KnownNat n => Integer
integerVal @n
     in coerce :: forall a b. Coercible a b => a -> b
coerce
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [Gen a] -> Gen a
Gen.oneof
            [ (Integer, Integer) -> Gen Integer
Gen.chooseInteger (forall a. Num a => a -> a
negate Integer
v, -Integer
1)
            , (Integer, Integer) -> Gen Integer
Gen.chooseInteger (Integer
1, Integer
v)
            ]
  {-# INLINEABLE shrink #-}
  shrink :: TimeDelta NonZero n -> [TimeDelta NonZero n]
shrink = coerce :: forall a b. Coercible a b => a -> b
coerce @(NonZero Integer -> [NonZero Integer]) forall a. Arbitrary a => a -> [a]
shrink

-- | @since 2.1.4
instance (KnownNat n, 1 <= n) => Arbitrary (TimeDelta Positive n) where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen (TimeDelta Positive n)
arbitrary = coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
Gen.chooseInteger (Integer
1, forall (n :: Nat). KnownNat n => Integer
integerVal @n)
  {-# INLINEABLE shrink #-}
  shrink :: TimeDelta Positive n -> [TimeDelta Positive n]
shrink = coerce :: forall a b. Coercible a b => a -> b
coerce @(Positive Integer -> [Positive Integer]) forall a. Arbitrary a => a -> [a]
shrink

-- | @since 2.1.4
instance (KnownNat n, 1 <= n) => Arbitrary (TimeDelta Negative n) where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen (TimeDelta Negative n)
arbitrary = coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
Gen.chooseInteger (forall a. Num a => a -> a
negate (forall (n :: Nat). KnownNat n => Integer
integerVal @n), forall a. Num a => a -> a
negate Integer
1)
  {-# INLINEABLE shrink #-}
  shrink :: TimeDelta Negative n -> [TimeDelta Negative n]
shrink = coerce :: forall a b. Coercible a b => a -> b
coerce @(Negative Integer -> [Negative Integer]) forall a. Arbitrary a => a -> [a]
shrink

-- | @since 2.1.4
instance (KnownNat n) => Arbitrary (TimeDelta NonPositive n) where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen (TimeDelta NonPositive n)
arbitrary = coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
Gen.chooseInteger (forall a. Num a => a -> a
negate (forall (n :: Nat). KnownNat n => Integer
integerVal @n), Integer
0)
  {-# INLINEABLE shrink #-}
  shrink :: TimeDelta NonPositive n -> [TimeDelta NonPositive n]
shrink = coerce :: forall a b. Coercible a b => a -> b
coerce @(NonPositive Integer -> [NonPositive Integer]) forall a. Arbitrary a => a -> [a]
shrink

-- | @since 2.1.4
instance (KnownNat n) => Arbitrary (TimeDelta NonNegative n) where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen (TimeDelta NonNegative n)
arbitrary = coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
Gen.chooseInteger (Integer
0, forall (n :: Nat). KnownNat n => Integer
integerVal @n)
  {-# INLINEABLE shrink #-}
  shrink :: TimeDelta NonNegative n -> [TimeDelta NonNegative n]
shrink = coerce :: forall a b. Coercible a b => a -> b
coerce @(NonNegative Integer -> [NonNegative Integer]) forall a. Arbitrary a => a -> [a]
shrink

-- | @since 2.1.4
deriving via
  (mod Integer)
  instance
    ( forall (a :: Type) (b :: Type).
      ( Coercible a b => Coercible (mod a) (mod b)
      )
    , CoArbitrary (mod Integer)
    ) =>
    CoArbitrary (TimeDelta mod n)

-- | @since 2.1.4
instance
  (forall (a :: Type) (b :: Type). Coercible a b => Coercible (mod a) b) =>
  Function (TimeDelta mod n)
  where
  {-# INLINEABLE function #-}
  function :: forall b. (TimeDelta mod n -> b) -> TimeDelta mod n :-> 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 @(TimeDelta mod n) @Integer) coerce :: forall a b. Coercible a b => a -> b
coerce

{- | A CPS-style 'Property' handler for applying a 'TimeDelta' to a 'POSIXTime'.
 If the application of the delta to the time would produce an impossible
 result (that is, the resulting time is negative), this will automatically
 fail the property test with an informative message; otherwise, it will apply
 the delta, and produce a new 'POSIXTime', which it will pass to the function
 argument to determine the outcome.

 The arguments are ordered to conveniently use with `forAll` and similar.

 @since 2.1.4
-}
timeDeltaProperty ::
  forall (n :: Nat) (mod :: Type -> Type).
  (Coercible (mod POSIXTime) Integer) =>
  (POSIXTime -> Property) ->
  POSIXTime ->
  TimeDelta mod n ->
  Property
timeDeltaProperty :: forall (n :: Nat) (mod :: * -> *).
Coercible (mod POSIXTime) Integer =>
(POSIXTime -> Property) -> POSIXTime -> TimeDelta mod n -> Property
timeDeltaProperty POSIXTime -> Property
f POSIXTime
time (TimeDelta mod POSIXTime
d) =
  let modified :: POSIXTime
modified = POSIXTime
time forall a. Num a => a -> a -> a
+ coerce :: forall a b. Coercible a b => a -> b
coerce mod POSIXTime
d
   in case forall a. Num a => a -> a
signum POSIXTime
modified of
        (-1) -> forall prop. Testable prop => String -> prop -> Property
counterexample String
badConversion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ Bool
False
        POSIXTime
_ -> POSIXTime -> Property
f POSIXTime
modified
  where
    badConversion :: String
    badConversion :: String
badConversion =
      String
"Applying a TimeDelta would yield a negative time.\n"
        forall a. Semigroup a => a -> a -> a
<> String
"Delta: "
        forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce @_ @Integer forall a b. (a -> b) -> a -> b
$ mod POSIXTime
d)
        forall a. Semigroup a => a -> a -> a
<> String
"\n"
        forall a. Semigroup a => a -> a -> a
<> String
"Time: "
        forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show POSIXTime
time

{- | A generic CPS-style handler for the application of a 'TimeDelta'. The
 handler function argument will be passed 'Nothing' if applying the
 'TimeDelta' would produce an impossible (that is, negative) 'POSIXTime', and
 a 'Just' with the new 'POSIXTime' otherwise.

 @since 2.1.4
-}
withTimeDelta ::
  forall (n :: Nat) (mod :: Type -> Type) (r :: Type).
  (Coercible (mod POSIXTime) Integer) =>
  (Maybe POSIXTime -> r) ->
  POSIXTime ->
  TimeDelta mod n ->
  r
withTimeDelta :: forall (n :: Nat) (mod :: * -> *) r.
Coercible (mod POSIXTime) Integer =>
(Maybe POSIXTime -> r) -> POSIXTime -> TimeDelta mod n -> r
withTimeDelta Maybe POSIXTime -> r
f POSIXTime
time (TimeDelta mod POSIXTime
d) =
  let modified :: POSIXTime
modified = POSIXTime
time forall a. Num a => a -> a -> a
+ coerce :: forall a b. Coercible a b => a -> b
coerce mod POSIXTime
d
   in case forall a. Num a => a -> a
signum POSIXTime
modified of
        (-1) -> Maybe POSIXTime -> r
f forall a. Maybe a
Nothing
        POSIXTime
_ -> Maybe POSIXTime -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ POSIXTime
modified

-- Helpers

unwrap ::
  forall (adaMod :: Type -> Type) (otherMod :: Type -> Type).
  GenValue adaMod otherMod ->
  [([Word8], [([Word8], Integer)])]
unwrap :: forall (adaMod :: * -> *) (otherMod :: * -> *).
GenValue adaMod otherMod -> [([Word8], [([Word8], Integer)])]
unwrap (GenValue (Value Map CurrencySymbol (Map TokenName Integer)
inner)) =
  forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap CurrencySymbol -> [Word8]
unwrapCS Map TokenName Integer -> [([Word8], Integer)]
unwrapInner forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. Map k v -> [(k, v)]
AssocMap.toList Map CurrencySymbol (Map TokenName Integer)
inner
  where
    unwrapCS :: CurrencySymbol -> [Word8]
    unwrapCS :: CurrencySymbol -> [Word8]
unwrapCS (CurrencySymbol BuiltinByteString
bbs) = 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
bbs
    unwrapInner ::
      AssocMap.Map TokenName Integer ->
      [([Word8], Integer)]
    unwrapInner :: Map TokenName Integer -> [([Word8], Integer)]
unwrapInner Map TokenName Integer
innerMap =
      forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\(TokenName BuiltinByteString
tn) -> 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
tn) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. Map k v -> [(k, v)]
AssocMap.toList Map TokenName Integer
innerMap

rewrap ::
  forall (adaMod :: Type -> Type) (otherMod :: Type -> Type).
  [([Word8], [([Word8], Integer)])] ->
  GenValue adaMod otherMod
rewrap :: forall (adaMod :: * -> *) (otherMod :: * -> *).
[([Word8], [([Word8], Integer)])] -> GenValue adaMod otherMod
rewrap =
  forall (adaMod :: * -> *) (otherMod :: * -> *).
Value -> GenValue adaMod otherMod
GenValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CurrencySymbol (Map TokenName Integer) -> Value
Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. [(k, v)] -> Map k v
AssocMap.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 (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Word8] -> CurrencySymbol
rewrapCS [([Word8], Integer)] -> Map TokenName Integer
rewrapInner)
  where
    rewrapCS :: [Word8] -> CurrencySymbol
    rewrapCS :: [Word8] -> CurrencySymbol
rewrapCS = BuiltinByteString -> CurrencySymbol
CurrencySymbol 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
    rewrapInner :: [([Word8], Integer)] -> AssocMap.Map TokenName Integer
    rewrapInner :: [([Word8], Integer)] -> Map TokenName Integer
rewrapInner =
      forall k v. [(k, v)] -> Map k v
AssocMap.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 (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (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))

mkAdaEntry ::
  forall (adaMod :: Type -> Type).
  ( forall (a :: Type). Coercible (adaMod a) a
  , Arbitrary (adaMod Integer)
  ) =>
  Gen (CurrencySymbol, AssocMap.Map TokenName Integer)
mkAdaEntry :: forall (adaMod :: * -> *).
(forall a. Coercible (adaMod a) a, Arbitrary (adaMod Integer)) =>
Gen (CurrencySymbol, Map TokenName Integer)
mkAdaEntry = do
  Integer
amount <- coerce :: forall a b. Coercible a b => a -> b
coerce @(adaMod Integer) @Integer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (CurrencySymbol
"", forall k v. [(k, v)] -> Map k v
AssocMap.fromList [(TokenName
"", Integer
amount)])

mkOtherEntrySymbols :: Gen [CurrencySymbol]
mkOtherEntrySymbols :: Gen [CurrencySymbol]
mkOtherEntrySymbols =
  forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
Gen.listOf (forall a. Arbitrary a => Gen a
arbitrary @(GenCurrencySymbol 'WithoutAdaSymbol))

mkTokenNames :: Gen [TokenName]
mkTokenNames :: Gen [TokenName]
mkTokenNames = do
  TokenName
x <- Gen TokenName
gen
  [TokenName]
xs <- forall a. Gen a -> Gen [a]
Gen.listOf Gen TokenName
gen
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ TokenName
x forall a. a -> [a] -> [a]
: [TokenName]
xs
  where
    gen :: Gen TokenName
    gen :: Gen TokenName
gen =
      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

pairWith ::
  forall (otherMod :: Type -> Type).
  ( Arbitrary (otherMod Integer)
  , forall (a :: Type). Coercible (otherMod a) a
  ) =>
  TokenName ->
  Gen (TokenName, Integer)
pairWith :: forall (otherMod :: * -> *).
(Arbitrary (otherMod Integer),
 forall a. Coercible (otherMod a) a) =>
TokenName -> Gen (TokenName, Integer)
pairWith TokenName
tn = (TokenName
tn,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (mod :: * -> *).
(Coercible (mod Integer) Integer, Arbitrary (mod Integer)) =>
Gen Integer
coerciveArbitrary @otherMod

coerciveArbitrary ::
  forall (mod :: Type -> Type).
  ( Coercible (mod Integer) Integer
  , Arbitrary (mod Integer)
  ) =>
  Gen Integer
coerciveArbitrary :: forall (mod :: * -> *).
(Coercible (mod Integer) Integer, Arbitrary (mod Integer)) =>
Gen Integer
coerciveArbitrary = coerce :: forall a b. Coercible a b => a -> b
coerce @(mod Integer) @Integer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

coerciveShrink ::
  forall (mod :: Type -> Type).
  ( Coercible (mod Integer) Integer
  , Arbitrary (mod Integer)
  ) =>
  Integer ->
  [Integer]
coerciveShrink :: forall (mod :: * -> *).
(Coercible (mod Integer) Integer, Arbitrary (mod Integer)) =>
Integer -> [Integer]
coerciveShrink =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (coerce :: forall a b. Coercible a b => a -> b
coerce @(mod Integer) @Integer)
    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
. coerce :: forall a b. Coercible a b => a -> b
coerce @Integer @(mod Integer)

integerVal :: forall (n :: Nat). (KnownNat n) => Integer
integerVal :: forall (n :: Nat). KnownNat n => Integer
integerVal = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @n