{-# LANGUAGE TypeApplications #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module PlutusLedgerApi.Test.V1.Value where

import PlutusLedgerApi.V1
import PlutusTx.AssocMap qualified as AssocMap
import PlutusTx.List qualified as ListTx

import PlutusCore.Generators.QuickCheck.Builtin
import PlutusCore.Generators.QuickCheck.Utils (multiSplit0)
import PlutusCore.Value qualified as PLC

import Data.Bifunctor
import Data.Coerce
import Data.Map.Strict qualified as Map
import Test.QuickCheck

-- | Convert a list representation of a 'Value' to the 'Value'.
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 v. [(k, v)] -> Map k v
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 v. [(k, v)] -> Map k v
AssocMap.unsafeFromList)

-- | Convert a 'Value' to its list representation.
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 v. Map k v -> [(k, v)]
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 v. Map k v -> [(k, v)]
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

-- | The value of a 'TokenName' in a 'Value'.
newtype FaceValue = FaceValue
    { FaceValue -> Integer
unFaceValue :: Integer
    }

instance Arbitrary FaceValue where
    -- We want to generate zeroes often, because there's a lot of corner cases associated with them
    -- and all non-zero numbers are handled pretty much the same anyway, so there isn't much point
    -- in diversifying them as much as possible.
    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)
        ]

instance Arbitrary Value where
    arbitrary :: Gen Value
arbitrary = do
        -- Generate values for all of the 'TokenName's in the final 'Value' and split them into a
        -- list of lists.
        [[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
        -- Generate 'TokenName's and 'CurrencySymbol's.
        [(CurrencySymbol, [(TokenName, Integer)])]
currencies <- (K -> CurrencySymbol)
-> [[(TokenName, Integer)]]
-> Gen [(CurrencySymbol, [(TokenName, Integer)])]
forall name b. Eq name => (K -> name) -> [b] -> Gen [(name, b)]
uniqueNames (BuiltinByteString -> CurrencySymbol
CurrencySymbol (BuiltinByteString -> CurrencySymbol)
-> (K -> BuiltinByteString) -> K -> CurrencySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> BuiltinByteString)
-> (K -> ByteString) -> K -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K -> ByteString
PLC.unK) ([[(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 ((K -> TokenName) -> [Integer] -> Gen [(TokenName, Integer)]
forall name b. Eq name => (K -> name) -> [b] -> Gen [(name, b)]
uniqueNames (BuiltinByteString -> TokenName
TokenName (BuiltinByteString -> TokenName)
-> (K -> BuiltinByteString) -> K -> TokenName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> BuiltinByteString)
-> (K -> ByteString) -> K -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K -> ByteString
PLC.unK)) [[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

valueFromBuiltin :: PLC.Value -> Value
valueFromBuiltin :: Value -> Value
valueFromBuiltin =
  [(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
. ((K, Map K Integer) -> (CurrencySymbol, [(TokenName, Integer)]))
-> [(K, Map K Integer)]
-> [(CurrencySymbol, [(TokenName, Integer)])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((K -> CurrencySymbol)
-> (Map K Integer -> [(TokenName, Integer)])
-> (K, Map K Integer)
-> (CurrencySymbol, [(TokenName, Integer)])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (BuiltinByteString -> CurrencySymbol
CurrencySymbol (BuiltinByteString -> CurrencySymbol)
-> (K -> BuiltinByteString) -> K -> CurrencySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> BuiltinByteString)
-> (K -> ByteString) -> K -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K -> ByteString
PLC.unK) Map K Integer -> [(TokenName, Integer)]
forall {c}. Map K c -> [(TokenName, c)]
inner)
    ([(K, Map K Integer)]
 -> [(CurrencySymbol, [(TokenName, Integer)])])
-> (Value -> [(K, Map K Integer)])
-> Value
-> [(CurrencySymbol, [(TokenName, Integer)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map K (Map K Integer) -> [(K, Map K Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList
    (Map K (Map K Integer) -> [(K, Map K Integer)])
-> (Value -> Map K (Map K Integer))
-> Value
-> [(K, Map K Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Map K (Map K Integer)
PLC.unpack
 where
  inner :: Map K c -> [(TokenName, c)]
inner = ((K, c) -> (TokenName, c)) -> [(K, c)] -> [(TokenName, c)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((K -> TokenName) -> (K, c) -> (TokenName, c)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (BuiltinByteString -> TokenName
TokenName (BuiltinByteString -> TokenName)
-> (K -> BuiltinByteString) -> K -> TokenName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> BuiltinByteString)
-> (K -> ByteString) -> K -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K -> ByteString
PLC.unK)) ([(K, c)] -> [(TokenName, c)])
-> (Map K c -> [(K, c)]) -> Map K c -> [(TokenName, c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map K c -> [(K, c)]
forall k a. Map k a -> [(k, a)]
Map.toList