{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module PlutusLedgerApi.Test.V1.Data.Value where
import PlutusLedgerApi.V1.Data.Value
import PlutusTx.Builtins hiding (error)
import PlutusTx.Data.AssocMap qualified as AssocMap
import PlutusTx.List qualified as ListTx
import PlutusCore.Generators.QuickCheck.Utils (multiSplit0, uniqueVectorOf)
import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Char8 qualified as BS8
import Data.Coerce
import Test.QuickCheck
listsToValue :: [(CurrencySymbol, [(TokenName, Integer)])] -> Value
listsToValue :: [(CurrencySymbol, [(TokenName, Integer)])] -> Value
listsToValue = Map CurrencySymbol (Map TokenName Integer) -> Value
Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> ([(CurrencySymbol, [(TokenName, Integer)])]
-> Map CurrencySymbol (Map TokenName Integer))
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CurrencySymbol, Map TokenName Integer)]
-> Map CurrencySymbol (Map TokenName Integer)
forall k a. (ToData k, ToData a) => [(k, a)] -> Map k a
AssocMap.unsafeFromList ([(CurrencySymbol, Map TokenName Integer)]
-> Map CurrencySymbol (Map TokenName Integer))
-> ([(CurrencySymbol, [(TokenName, Integer)])]
-> [(CurrencySymbol, Map TokenName Integer)])
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> Map CurrencySymbol (Map TokenName Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CurrencySymbol, [(TokenName, Integer)])
-> (CurrencySymbol, Map TokenName Integer))
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> [(CurrencySymbol, Map TokenName Integer)]
forall a b. (a -> b) -> [a] -> [b]
ListTx.map (([(TokenName, Integer)] -> Map TokenName Integer)
-> (CurrencySymbol, [(TokenName, Integer)])
-> (CurrencySymbol, Map TokenName Integer)
forall a b. (a -> b) -> (CurrencySymbol, a) -> (CurrencySymbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(TokenName, Integer)] -> Map TokenName Integer
forall k a. (ToData k, ToData a) => [(k, a)] -> Map k a
AssocMap.unsafeFromList)
valueToLists :: Value -> [(CurrencySymbol, [(TokenName, Integer)])]
valueToLists :: Value -> [(CurrencySymbol, [(TokenName, Integer)])]
valueToLists = ((CurrencySymbol, Map TokenName Integer)
-> (CurrencySymbol, [(TokenName, Integer)]))
-> [(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, [(TokenName, Integer)])]
forall a b. (a -> b) -> [a] -> [b]
ListTx.map ((Map TokenName Integer -> [(TokenName, Integer)])
-> (CurrencySymbol, Map TokenName Integer)
-> (CurrencySymbol, [(TokenName, Integer)])
forall a b. (a -> b) -> (CurrencySymbol, a) -> (CurrencySymbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map TokenName Integer -> [(TokenName, Integer)]
forall k a.
(UnsafeFromData k, UnsafeFromData a) =>
Map k a -> [(k, a)]
AssocMap.toList) ([(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, [(TokenName, Integer)])])
-> (Value -> [(CurrencySymbol, Map TokenName Integer)])
-> Value
-> [(CurrencySymbol, [(TokenName, Integer)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CurrencySymbol (Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)]
forall k a.
(UnsafeFromData k, UnsafeFromData a) =>
Map k a -> [(k, a)]
AssocMap.toList (Map CurrencySymbol (Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)])
-> (Value -> Map CurrencySymbol (Map TokenName Integer))
-> Value
-> [(CurrencySymbol, Map TokenName Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Map CurrencySymbol (Map TokenName Integer)
getValue
toCellCandidatesNumber :: Int -> Int
toCellCandidatesNumber :: Int -> Int
toCellCandidatesNumber Int
i = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
6 (Int -> Int) -> (Double -> Int) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor @Double (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
1.5
genShortHex :: Int -> Gen BuiltinByteString
genShortHex :: Int -> Gen BuiltinByteString
genShortHex Int
i =
ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> BuiltinByteString)
-> (Int -> ByteString) -> Int -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> ByteString)
-> (Int -> ByteString) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString) -> (Int -> String) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> BuiltinByteString) -> Gen Int -> Gen BuiltinByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Gen Int
forall a. HasCallStack => [a] -> Gen a
elements [Int
0 .. Int -> Int
toCellCandidatesNumber Int
i]
uniqueNames :: Eq name => (BuiltinByteString -> name) -> [b] -> Gen [(name, b)]
uniqueNames :: forall name b.
Eq name =>
(BuiltinByteString -> name) -> [b] -> Gen [(name, b)]
uniqueNames BuiltinByteString -> name
wrap [b]
ys = do
let len :: Int
len = [b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
ys
[name]
xs <- Int -> Gen name -> Gen [name]
forall a. Eq a => Int -> Gen a -> Gen [a]
uniqueVectorOf Int
len (Gen name -> Gen [name]) -> Gen name -> Gen [name]
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> name
wrap (BuiltinByteString -> name) -> Gen BuiltinByteString -> Gen name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen BuiltinByteString
genShortHex Int
len
[(name, b)] -> Gen [(name, b)]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(name, b)] -> Gen [(name, b)]) -> [(name, b)] -> Gen [(name, b)]
forall a b. (a -> b) -> a -> b
$ [name] -> [b] -> [(name, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [name]
xs [b]
ys
newtype FaceValue = FaceValue
{ FaceValue -> Integer
unFaceValue :: Integer
}
instance Arbitrary FaceValue where
arbitrary :: Gen FaceValue
arbitrary = [(Int, Gen FaceValue)] -> Gen FaceValue
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
[ (Int
2, FaceValue -> Gen FaceValue
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FaceValue -> Gen FaceValue) -> FaceValue -> Gen FaceValue
forall a b. (a -> b) -> a -> b
$ Integer -> FaceValue
FaceValue Integer
0)
, (Int
1, Integer -> FaceValue
FaceValue (Integer -> FaceValue) -> (Int -> Integer) -> Int -> FaceValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> FaceValue) -> Gen Int -> Gen FaceValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @Int)
]
newtype NoArbitrary a = NoArbitrary
{ forall a. NoArbitrary a -> a
unNoArbitrary :: a
}
instance Arbitrary (NoArbitrary a) where
arbitrary :: Gen (NoArbitrary a)
arbitrary = String -> Gen (NoArbitrary a)
forall a. HasCallStack => String -> a
error String
"No such 'Arbitrary' instance"
shrink :: NoArbitrary a -> [NoArbitrary a]
shrink NoArbitrary a
_ = []
instance Arbitrary Value where
arbitrary :: Gen Value
arbitrary = do
[[Integer]]
faceValues <- Double -> [Integer] -> Gen [[Integer]]
forall a. Double -> [a] -> Gen [[a]]
multiSplit0 Double
0.2 ([Integer] -> Gen [[Integer]])
-> ([FaceValue] -> [Integer]) -> [FaceValue] -> Gen [[Integer]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FaceValue -> Integer) -> [FaceValue] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map FaceValue -> Integer
unFaceValue ([FaceValue] -> Gen [[Integer]])
-> Gen [FaceValue] -> Gen [[Integer]]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen [FaceValue]
forall a. Arbitrary a => Gen a
arbitrary
[(CurrencySymbol, [(TokenName, Integer)])]
currencies <- (BuiltinByteString -> CurrencySymbol)
-> [[(TokenName, Integer)]]
-> Gen [(CurrencySymbol, [(TokenName, Integer)])]
forall name b.
Eq name =>
(BuiltinByteString -> name) -> [b] -> Gen [(name, b)]
uniqueNames BuiltinByteString -> CurrencySymbol
CurrencySymbol ([[(TokenName, Integer)]]
-> Gen [(CurrencySymbol, [(TokenName, Integer)])])
-> Gen [[(TokenName, Integer)]]
-> Gen [(CurrencySymbol, [(TokenName, Integer)])]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([Integer] -> Gen [(TokenName, Integer)])
-> [[Integer]] -> Gen [[(TokenName, Integer)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((BuiltinByteString -> TokenName)
-> [Integer] -> Gen [(TokenName, Integer)]
forall name b.
Eq name =>
(BuiltinByteString -> name) -> [b] -> Gen [(name, b)]
uniqueNames BuiltinByteString -> TokenName
TokenName) [[Integer]]
faceValues
Value -> Gen Value
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Gen Value) -> Value -> Gen Value
forall a b. (a -> b) -> a -> b
$ [(CurrencySymbol, [(TokenName, Integer)])] -> Value
listsToValue [(CurrencySymbol, [(TokenName, Integer)])]
currencies
shrink :: Value -> [Value]
shrink
= ([(CurrencySymbol, [(TokenName, Integer)])] -> Value)
-> [[(CurrencySymbol, [(TokenName, Integer)])]] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map [(CurrencySymbol, [(TokenName, Integer)])] -> Value
listsToValue
([[(CurrencySymbol, [(TokenName, Integer)])]] -> [Value])
-> (Value -> [[(CurrencySymbol, [(TokenName, Integer)])]])
-> Value
-> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(NoArbitrary CurrencySymbol, [(NoArbitrary TokenName, Integer)])]
-> [[(NoArbitrary CurrencySymbol,
[(NoArbitrary TokenName, Integer)])]])
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> [[(CurrencySymbol, [(TokenName, Integer)])]]
forall a b. Coercible a b => a -> b
coerce (forall a. Arbitrary a => a -> [a]
shrink @[(NoArbitrary CurrencySymbol, [(NoArbitrary TokenName, Integer)])])
([(CurrencySymbol, [(TokenName, Integer)])]
-> [[(CurrencySymbol, [(TokenName, Integer)])]])
-> (Value -> [(CurrencySymbol, [(TokenName, Integer)])])
-> Value
-> [[(CurrencySymbol, [(TokenName, Integer)])]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [(CurrencySymbol, [(TokenName, Integer)])]
valueToLists