{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module PlutusLedgerApi.Test.V3.MintValue where
import Data.Coerce (coerce)
import PlutusCore.Generators.QuickCheck.Split (multiSplit0)
import PlutusLedgerApi.Test.V1.Value (NoArbitrary (..), uniqueNames)
import PlutusLedgerApi.V1.Value (CurrencySymbol (..), TokenName (..))
import PlutusLedgerApi.V3.MintValue (MintValue (..))
import PlutusTx.AssocMap qualified as Map
import PlutusTx.List qualified as List
import Test.QuickCheck (Arbitrary (..))
instance Arbitrary MintValue where
arbitrary :: Gen MintValue
arbitrary = do
[[Integer]]
faceValues <- Double -> [Integer] -> Gen [[Integer]]
forall a. Double -> [a] -> Gen [[a]]
multiSplit0 Double
0.2 ([Integer] -> Gen [[Integer]])
-> ([Quantity] -> [Integer]) -> [Quantity] -> Gen [[Integer]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quantity -> Integer) -> [Quantity] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Quantity -> Integer
unQuantity ([Quantity] -> Gen [[Integer]])
-> Gen [Quantity] -> Gen [[Integer]]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen [Quantity]
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
MintValue -> Gen MintValue
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MintValue -> Gen MintValue) -> MintValue -> Gen MintValue
forall a b. (a -> b) -> a -> b
$ [(CurrencySymbol, [(TokenName, Integer)])] -> MintValue
listsToMintValue [(CurrencySymbol, [(TokenName, Integer)])]
currencies
shrink :: MintValue -> [MintValue]
shrink =
([(CurrencySymbol, [(TokenName, Integer)])] -> MintValue)
-> [[(CurrencySymbol, [(TokenName, Integer)])]] -> [MintValue]
forall a b. (a -> b) -> [a] -> [b]
map [(CurrencySymbol, [(TokenName, Integer)])] -> MintValue
listsToMintValue
([[(CurrencySymbol, [(TokenName, Integer)])]] -> [MintValue])
-> (MintValue -> [[(CurrencySymbol, [(TokenName, Integer)])]])
-> MintValue
-> [MintValue]
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)])]])
-> (MintValue -> [(CurrencySymbol, [(TokenName, Integer)])])
-> MintValue
-> [[(CurrencySymbol, [(TokenName, Integer)])]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MintValue -> [(CurrencySymbol, [(TokenName, Integer)])]
mintValueToLists
listsToMintValue :: [(CurrencySymbol, [(TokenName, Integer)])] -> MintValue
listsToMintValue :: [(CurrencySymbol, [(TokenName, Integer)])] -> MintValue
listsToMintValue = Map CurrencySymbol (Map TokenName Integer) -> MintValue
forall a b. Coercible a b => a -> b
coerce (Map CurrencySymbol (Map TokenName Integer) -> MintValue)
-> ([(CurrencySymbol, [(TokenName, Integer)])]
-> Map CurrencySymbol (Map TokenName Integer))
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> MintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CurrencySymbol, Map TokenName Integer)]
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. [(k, v)] -> Map k v
Map.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]
List.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 v. [(k, v)] -> Map k v
Map.unsafeFromList)
mintValueToLists :: MintValue -> [(CurrencySymbol, [(TokenName, Integer)])]
mintValueToLists :: MintValue -> [(CurrencySymbol, [(TokenName, Integer)])]
mintValueToLists = ((CurrencySymbol, Map TokenName Integer)
-> (CurrencySymbol, [(TokenName, Integer)]))
-> [(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, [(TokenName, Integer)])]
forall a b. (a -> b) -> [a] -> [b]
List.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 v. Map k v -> [(k, v)]
Map.toList) ([(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, [(TokenName, Integer)])])
-> (MintValue -> [(CurrencySymbol, Map TokenName Integer)])
-> MintValue
-> [(CurrencySymbol, [(TokenName, Integer)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CurrencySymbol (Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)]
forall k v. Map k v -> [(k, v)]
Map.toList (Map CurrencySymbol (Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)])
-> (MintValue -> Map CurrencySymbol (Map TokenName Integer))
-> MintValue
-> [(CurrencySymbol, Map TokenName Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MintValue -> Map CurrencySymbol (Map TokenName Integer)
forall a b. Coercible a b => a -> b
coerce
newtype Quantity = Quantity {Quantity -> Integer
unQuantity :: Integer}
deriving newtype (Gen Quantity
Gen Quantity -> (Quantity -> [Quantity]) -> Arbitrary Quantity
Quantity -> [Quantity]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Quantity
arbitrary :: Gen Quantity
$cshrink :: Quantity -> [Quantity]
shrink :: Quantity -> [Quantity]
Arbitrary, Int -> Quantity -> ShowS
[Quantity] -> ShowS
Quantity -> String
(Int -> Quantity -> ShowS)
-> (Quantity -> String) -> ([Quantity] -> ShowS) -> Show Quantity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Quantity -> ShowS
showsPrec :: Int -> Quantity -> ShowS
$cshow :: Quantity -> String
show :: Quantity -> String
$cshowList :: [Quantity] -> ShowS
showList :: [Quantity] -> ShowS
Show)