{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingVia        #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeApplications   #-}
{-# LANGUAGE TypeFamilies       #-}
{-# OPTIONS_GHC -fexpose-all-unfoldings #-}
{-# OPTIONS_GHC -fno-full-laziness #-}
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fno-spec-constr #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -fno-strictness #-}
{-# OPTIONS_GHC -fno-unbox-small-strict-fields #-}
{-# OPTIONS_GHC -fno-unbox-strict-fields #-}

module PlutusLedgerApi.V3.MintValue
  ( MintValue (..) -- Constructor is exported for testing
  , emptyMintValue
  , mintValueToMap
  , mintValueMinted
  , mintValueBurned
  )
where

import PlutusTx.Prelude

import Control.DeepSeq (NFData)
import Data.Data (Data, Typeable)
import GHC.Generics (Generic)
import PlutusLedgerApi.V1.Value (CurrencySymbol, TokenName, Value (..))
import PlutusTx (FromData (..), ToData (..), UnsafeFromData (..))
import PlutusTx.AssocMap (Map)
import PlutusTx.AssocMap qualified as Map
import PlutusTx.Blueprint.Class (HasBlueprintSchema (..))
import PlutusTx.Blueprint.Definition (HasBlueprintDefinition (..), definitionIdFromType,
                                      definitionRef)
import PlutusTx.Blueprint.Schema (MapSchema (..), Schema (..))
import PlutusTx.Blueprint.Schema.Annotation (emptySchemaInfo, title)
import PlutusTx.Lift (makeLift)
import Prelude qualified as Haskell
import Prettyprinter (Pretty)
import Prettyprinter.Extras (PrettyShow (PrettyShow))

{- Note [MintValue vs Value]

'MintValue' differs conceptually from 'Value' in how negative quantities are interpreted:

In 'MintValue', negative quantities are interpreted as assets being burned. For 'Value',
negative quantities are either don't make sense (e.g. in a transaction output) or interpreted
as a negative balance.

We want to distinguish these at the type level to avoid using 'MintValue' where 'Value' is assumed.
Users should project 'MintValue' into 'Value' using 'mintValueMinted' or 'mintValueBurned'.
-}

-- | A 'MintValue' represents assets that are minted and burned in a transaction.
newtype MintValue = UnsafeMintValue (Map CurrencySymbol (Map TokenName Integer))
  deriving stock ((forall x. MintValue -> Rep MintValue x)
-> (forall x. Rep MintValue x -> MintValue) -> Generic MintValue
forall x. Rep MintValue x -> MintValue
forall x. MintValue -> Rep MintValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MintValue -> Rep MintValue x
from :: forall x. MintValue -> Rep MintValue x
$cto :: forall x. Rep MintValue x -> MintValue
to :: forall x. Rep MintValue x -> MintValue
Generic, Typeable MintValue
Typeable MintValue =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> MintValue -> c MintValue)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MintValue)
-> (MintValue -> Constr)
-> (MintValue -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MintValue))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MintValue))
-> ((forall b. Data b => b -> b) -> MintValue -> MintValue)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MintValue -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MintValue -> r)
-> (forall u. (forall d. Data d => d -> u) -> MintValue -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MintValue -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> MintValue -> m MintValue)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MintValue -> m MintValue)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MintValue -> m MintValue)
-> Data MintValue
MintValue -> Constr
MintValue -> DataType
(forall b. Data b => b -> b) -> MintValue -> MintValue
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> MintValue -> u
forall u. (forall d. Data d => d -> u) -> MintValue -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MintValue -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MintValue -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MintValue -> m MintValue
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MintValue -> m MintValue
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MintValue
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MintValue -> c MintValue
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MintValue)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MintValue)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MintValue -> c MintValue
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MintValue -> c MintValue
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MintValue
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MintValue
$ctoConstr :: MintValue -> Constr
toConstr :: MintValue -> Constr
$cdataTypeOf :: MintValue -> DataType
dataTypeOf :: MintValue -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MintValue)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MintValue)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MintValue)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MintValue)
$cgmapT :: (forall b. Data b => b -> b) -> MintValue -> MintValue
gmapT :: (forall b. Data b => b -> b) -> MintValue -> MintValue
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MintValue -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MintValue -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MintValue -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MintValue -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MintValue -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> MintValue -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MintValue -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MintValue -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MintValue -> m MintValue
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MintValue -> m MintValue
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MintValue -> m MintValue
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MintValue -> m MintValue
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MintValue -> m MintValue
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MintValue -> m MintValue
Data, Typeable, Int -> MintValue -> ShowS
[MintValue] -> ShowS
MintValue -> String
(Int -> MintValue -> ShowS)
-> (MintValue -> String)
-> ([MintValue] -> ShowS)
-> Show MintValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MintValue -> ShowS
showsPrec :: Int -> MintValue -> ShowS
$cshow :: MintValue -> String
show :: MintValue -> String
$cshowList :: [MintValue] -> ShowS
showList :: [MintValue] -> ShowS
Haskell.Show)
  deriving anyclass (MintValue -> ()
(MintValue -> ()) -> NFData MintValue
forall a. (a -> ()) -> NFData a
$crnf :: MintValue -> ()
rnf :: MintValue -> ()
NFData)
  deriving newtype (MintValue -> BuiltinData
(MintValue -> BuiltinData) -> ToData MintValue
forall a. (a -> BuiltinData) -> ToData a
$ctoBuiltinData :: MintValue -> BuiltinData
toBuiltinData :: MintValue -> BuiltinData
ToData, BuiltinData -> Maybe MintValue
(BuiltinData -> Maybe MintValue) -> FromData MintValue
forall a. (BuiltinData -> Maybe a) -> FromData a
$cfromBuiltinData :: BuiltinData -> Maybe MintValue
fromBuiltinData :: BuiltinData -> Maybe MintValue
FromData, BuiltinData -> MintValue
(BuiltinData -> MintValue) -> UnsafeFromData MintValue
forall a. (BuiltinData -> a) -> UnsafeFromData a
$cunsafeFromBuiltinData :: BuiltinData -> MintValue
unsafeFromBuiltinData :: BuiltinData -> MintValue
UnsafeFromData)
  deriving ((forall ann. MintValue -> Doc ann)
-> (forall ann. [MintValue] -> Doc ann) -> Pretty MintValue
forall ann. [MintValue] -> Doc ann
forall ann. MintValue -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. MintValue -> Doc ann
pretty :: forall ann. MintValue -> Doc ann
$cprettyList :: forall ann. [MintValue] -> Doc ann
prettyList :: forall ann. [MintValue] -> Doc ann
Pretty) via (PrettyShow MintValue)

instance Haskell.Eq MintValue where
  MintValue
l == :: MintValue -> MintValue -> Bool
== MintValue
r = MintValue -> Value
mintValueMinted MintValue
l Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== MintValue -> Value
mintValueMinted MintValue
r Bool -> Bool -> Bool
&& MintValue -> Value
mintValueBurned MintValue
l Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== MintValue -> Value
mintValueBurned MintValue
r

instance HasBlueprintDefinition MintValue where
  type Unroll MintValue = '[MintValue, CurrencySymbol, TokenName, Integer]
  definitionId :: DefinitionId
definitionId = forall t. Typeable t => DefinitionId
definitionIdFromType @MintValue

instance HasBlueprintSchema MintValue referencedTypes where
  schema :: Schema referencedTypes
schema =
    SchemaInfo -> MapSchema referencedTypes -> Schema referencedTypes
forall (referencedTypes :: [*]).
SchemaInfo -> MapSchema referencedTypes -> Schema referencedTypes
SchemaMap
      SchemaInfo
emptySchemaInfo{title = Just "MintValue"}
      MkMapSchema
        { $sel:keySchema:MkMapSchema :: Schema referencedTypes
keySchema = forall t (ts :: [*]). HasBlueprintDefinition t => Schema ts
definitionRef @CurrencySymbol
        , $sel:valueSchema:MkMapSchema :: Schema referencedTypes
valueSchema =
            SchemaInfo -> MapSchema referencedTypes -> Schema referencedTypes
forall (referencedTypes :: [*]).
SchemaInfo -> MapSchema referencedTypes -> Schema referencedTypes
SchemaMap
              SchemaInfo
emptySchemaInfo
              MkMapSchema
                { $sel:keySchema:MkMapSchema :: Schema referencedTypes
keySchema = forall t (ts :: [*]). HasBlueprintDefinition t => Schema ts
definitionRef @TokenName
                , $sel:valueSchema:MkMapSchema :: Schema referencedTypes
valueSchema = forall t (ts :: [*]). HasBlueprintDefinition t => Schema ts
definitionRef @Integer
                , $sel:minItems:MkMapSchema :: Maybe Natural
minItems = Maybe Natural
forall a. Maybe a
Nothing
                , $sel:maxItems:MkMapSchema :: Maybe Natural
maxItems = Maybe Natural
forall a. Maybe a
Nothing
                }
        , $sel:minItems:MkMapSchema :: Maybe Natural
minItems = Maybe Natural
forall a. Maybe a
Nothing
        , $sel:maxItems:MkMapSchema :: Maybe Natural
maxItems = Maybe Natural
forall a. Maybe a
Nothing
        }
  {-# INLINEABLE schema #-}

emptyMintValue :: MintValue
emptyMintValue :: MintValue
emptyMintValue = Map CurrencySymbol (Map TokenName Integer) -> MintValue
UnsafeMintValue Map CurrencySymbol (Map TokenName Integer)
forall k v. Map k v
Map.empty
{-# INLINEABLE emptyMintValue #-}

mintValueToMap :: MintValue -> Map CurrencySymbol (Map TokenName Integer)
mintValueToMap :: MintValue -> Map CurrencySymbol (Map TokenName Integer)
mintValueToMap (UnsafeMintValue Map CurrencySymbol (Map TokenName Integer)
m) = Map CurrencySymbol (Map TokenName Integer)
m
{-# INLINEABLE mintValueToMap #-}

-- | Get the 'Value' minted by the 'MintValue'.
mintValueMinted :: MintValue -> Value
mintValueMinted :: MintValue -> Value
mintValueMinted (UnsafeMintValue Map CurrencySymbol (Map TokenName Integer)
values) = (Integer -> [Integer])
-> Map CurrencySymbol (Map TokenName Integer) -> Value
filterQuantities (\Integer
x -> [Integer
x | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0]) Map CurrencySymbol (Map TokenName Integer)
values
{-# INLINEABLE mintValueMinted #-}

{- | Get the 'Value' burned by the 'MintValue'.
All the negative quantities in the 'MintValue' become positive in the resulting 'Value'.
-}
mintValueBurned :: MintValue -> Value
mintValueBurned :: MintValue -> Value
mintValueBurned (UnsafeMintValue Map CurrencySymbol (Map TokenName Integer)
values) = (Integer -> [Integer])
-> Map CurrencySymbol (Map TokenName Integer) -> Value
filterQuantities (\Integer
x -> [Integer -> Integer
forall n. (Ord n, AdditiveGroup n) => n -> n
abs Integer
x | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0]) Map CurrencySymbol (Map TokenName Integer)
values
{-# INLINEABLE mintValueBurned #-}

filterQuantities :: (Integer -> [Integer]) -> Map CurrencySymbol (Map TokenName Integer) -> Value
filterQuantities :: (Integer -> [Integer])
-> Map CurrencySymbol (Map TokenName Integer) -> Value
filterQuantities Integer -> [Integer]
mapQuantity Map CurrencySymbol (Map TokenName Integer)
values =
  Map CurrencySymbol (Map TokenName Integer) -> Value
Value ([(CurrencySymbol, Map TokenName Integer)]
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. [(k, v)] -> Map k v
Map.unsafeFromList (((CurrencySymbol, Map TokenName Integer)
 -> [(CurrencySymbol, Map TokenName Integer)]
 -> [(CurrencySymbol, Map TokenName Integer)])
-> [(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, Map TokenName Integer)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CurrencySymbol, Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, Map TokenName Integer)]
filterTokenQuantities [] (Map CurrencySymbol (Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)]
forall k v. Map k v -> [(k, v)]
Map.toList Map CurrencySymbol (Map TokenName Integer)
values)))
  where
    {-# INLINEABLE filterTokenQuantities #-}
    filterTokenQuantities
      :: (CurrencySymbol, Map TokenName Integer)
      -> [(CurrencySymbol, Map TokenName Integer)]
      -> [(CurrencySymbol, Map TokenName Integer)]
    filterTokenQuantities :: (CurrencySymbol, Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, Map TokenName Integer)]
filterTokenQuantities (CurrencySymbol
currency, Map TokenName Integer
tokenQuantities) =
      case ((TokenName, Integer) -> [(TokenName, Integer)])
-> [(TokenName, Integer)] -> [(TokenName, Integer)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Integer -> [Integer])
-> (TokenName, Integer) -> [(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) -> (TokenName, a) -> f (TokenName, b)
traverse Integer -> [Integer]
mapQuantity) (Map TokenName Integer -> [(TokenName, Integer)]
forall k v. Map k v -> [(k, v)]
Map.toList Map TokenName Integer
tokenQuantities) of
        []         -> [(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, Map TokenName Integer)]
forall a. a -> a
id
        [(TokenName, Integer)]
quantities -> ((CurrencySymbol
currency, [(TokenName, Integer)] -> Map TokenName Integer
forall k v. [(k, v)] -> Map k v
Map.unsafeFromList [(TokenName, Integer)]
quantities) (CurrencySymbol, Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, Map TokenName Integer)]
forall a. a -> [a] -> [a]
:)
{-# INLINEABLE filterQuantities #-}

----------------------------------------------------------------------------------------------------
-- TH Splices --------------------------------------------------------------------------------------

$(makeLift ''MintValue)