-- editorconfig-checker-disable-file
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingVia        #-}
{-# LANGUAGE NoImplicitPrelude  #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeApplications   #-}

{-# OPTIONS_GHC -Wno-orphans #-}
-- Prevent unboxing, which the plugin can't deal with
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fno-spec-constr #-}
{-# OPTIONS_GHC -fno-specialise #-}

-- | Functions for working with 'Value'.
module PlutusLedgerApi.V1.Value(
    -- ** Currency symbols
      CurrencySymbol(..)
    , currencySymbol
    , adaSymbol
    -- ** Token names
    , TokenName(..)
    , tokenName
    , toString
    , adaToken
    -- * Asset classes
    , AssetClass(..)
    , assetClass
    , assetClassValue
    , assetClassValueOf
    -- ** Value
    , Value(..)
    , singleton
    , valueOf
    , scale
    , symbols
      -- * Partial order operations
    , geq
    , gt
    , leq
    , lt
      -- * Etc.
    , isZero
    , split
    , unionWith
    , flattenValue
    ) where

import Prelude qualified as Haskell

import Control.DeepSeq (NFData)
import Data.ByteString qualified as BS
import Data.Data (Data)
import Data.String (IsString (fromString))
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as E
import GHC.Generics (Generic)
import PlutusLedgerApi.V1.Bytes (LedgerBytes (LedgerBytes), encodeByteString)
import PlutusTx qualified
import PlutusTx.AssocMap qualified as Map
import PlutusTx.Lift (makeLift)
import PlutusTx.Ord qualified as Ord
import PlutusTx.Prelude as PlutusTx hiding (sort)
import PlutusTx.These (These (..))
import Prettyprinter (Pretty, (<>))
import Prettyprinter.Extras (PrettyShow (PrettyShow))

{- | ByteString representing the currency, hashed with /BLAKE2b-224/.
It is empty for `Ada`, 28 bytes for `MintingPolicyHash`.
Forms an `AssetClass` along with `TokenName`.
A `Value` is a map from `CurrencySymbol`'s to a map from `TokenName` to an `Integer`.

This is a simple type without any validation, __use with caution__.
You may want to add checks for its invariants. See the
 [Shelley ledger specification](https://hydra.iohk.io/build/16861845/download/1/ledger-spec.pdf).
-}
newtype CurrencySymbol = CurrencySymbol { CurrencySymbol -> BuiltinByteString
unCurrencySymbol :: PlutusTx.BuiltinByteString }
    deriving
        (String -> CurrencySymbol
forall a. (String -> a) -> IsString a
fromString :: String -> CurrencySymbol
$cfromString :: String -> CurrencySymbol
IsString        -- ^ from hex encoding
        , Int -> CurrencySymbol -> ShowS
[CurrencySymbol] -> ShowS
CurrencySymbol -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CurrencySymbol] -> ShowS
$cshowList :: [CurrencySymbol] -> ShowS
show :: CurrencySymbol -> String
$cshow :: CurrencySymbol -> String
showsPrec :: Int -> CurrencySymbol -> ShowS
$cshowsPrec :: Int -> CurrencySymbol -> ShowS
Haskell.Show   -- ^ using hex encoding
        , forall ann. [CurrencySymbol] -> Doc ann
forall ann. CurrencySymbol -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [CurrencySymbol] -> Doc ann
$cprettyList :: forall ann. [CurrencySymbol] -> Doc ann
pretty :: forall ann. CurrencySymbol -> Doc ann
$cpretty :: forall ann. CurrencySymbol -> Doc ann
Pretty         -- ^ using hex encoding
        ) via LedgerBytes
    deriving stock (forall x. Rep CurrencySymbol x -> CurrencySymbol
forall x. CurrencySymbol -> Rep CurrencySymbol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CurrencySymbol x -> CurrencySymbol
$cfrom :: forall x. CurrencySymbol -> Rep CurrencySymbol x
Generic, Typeable CurrencySymbol
CurrencySymbol -> DataType
CurrencySymbol -> Constr
(forall b. Data b => b -> b) -> CurrencySymbol -> CurrencySymbol
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) -> CurrencySymbol -> u
forall u. (forall d. Data d => d -> u) -> CurrencySymbol -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CurrencySymbol -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CurrencySymbol -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CurrencySymbol -> m CurrencySymbol
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CurrencySymbol -> m CurrencySymbol
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CurrencySymbol
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CurrencySymbol -> c CurrencySymbol
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CurrencySymbol)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CurrencySymbol)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CurrencySymbol -> m CurrencySymbol
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CurrencySymbol -> m CurrencySymbol
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CurrencySymbol -> m CurrencySymbol
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CurrencySymbol -> m CurrencySymbol
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CurrencySymbol -> m CurrencySymbol
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CurrencySymbol -> m CurrencySymbol
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CurrencySymbol -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CurrencySymbol -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> CurrencySymbol -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CurrencySymbol -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CurrencySymbol -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CurrencySymbol -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CurrencySymbol -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CurrencySymbol -> r
gmapT :: (forall b. Data b => b -> b) -> CurrencySymbol -> CurrencySymbol
$cgmapT :: (forall b. Data b => b -> b) -> CurrencySymbol -> CurrencySymbol
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CurrencySymbol)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CurrencySymbol)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CurrencySymbol)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CurrencySymbol)
dataTypeOf :: CurrencySymbol -> DataType
$cdataTypeOf :: CurrencySymbol -> DataType
toConstr :: CurrencySymbol -> Constr
$ctoConstr :: CurrencySymbol -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CurrencySymbol
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CurrencySymbol
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CurrencySymbol -> c CurrencySymbol
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CurrencySymbol -> c CurrencySymbol
Data)
    deriving newtype (CurrencySymbol -> CurrencySymbol -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CurrencySymbol -> CurrencySymbol -> Bool
$c/= :: CurrencySymbol -> CurrencySymbol -> Bool
== :: CurrencySymbol -> CurrencySymbol -> Bool
$c== :: CurrencySymbol -> CurrencySymbol -> Bool
Haskell.Eq, Eq CurrencySymbol
CurrencySymbol -> CurrencySymbol -> Bool
CurrencySymbol -> CurrencySymbol -> Ordering
CurrencySymbol -> CurrencySymbol -> CurrencySymbol
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 :: CurrencySymbol -> CurrencySymbol -> CurrencySymbol
$cmin :: CurrencySymbol -> CurrencySymbol -> CurrencySymbol
max :: CurrencySymbol -> CurrencySymbol -> CurrencySymbol
$cmax :: CurrencySymbol -> CurrencySymbol -> CurrencySymbol
>= :: CurrencySymbol -> CurrencySymbol -> Bool
$c>= :: CurrencySymbol -> CurrencySymbol -> Bool
> :: CurrencySymbol -> CurrencySymbol -> Bool
$c> :: CurrencySymbol -> CurrencySymbol -> Bool
<= :: CurrencySymbol -> CurrencySymbol -> Bool
$c<= :: CurrencySymbol -> CurrencySymbol -> Bool
< :: CurrencySymbol -> CurrencySymbol -> Bool
$c< :: CurrencySymbol -> CurrencySymbol -> Bool
compare :: CurrencySymbol -> CurrencySymbol -> Ordering
$ccompare :: CurrencySymbol -> CurrencySymbol -> Ordering
Haskell.Ord, CurrencySymbol -> CurrencySymbol -> Bool
forall a. (a -> a -> Bool) -> Eq a
== :: CurrencySymbol -> CurrencySymbol -> Bool
$c== :: CurrencySymbol -> CurrencySymbol -> Bool
Eq, Eq CurrencySymbol
CurrencySymbol -> CurrencySymbol -> Bool
CurrencySymbol -> CurrencySymbol -> Ordering
CurrencySymbol -> CurrencySymbol -> CurrencySymbol
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 :: CurrencySymbol -> CurrencySymbol -> CurrencySymbol
$cmin :: CurrencySymbol -> CurrencySymbol -> CurrencySymbol
max :: CurrencySymbol -> CurrencySymbol -> CurrencySymbol
$cmax :: CurrencySymbol -> CurrencySymbol -> CurrencySymbol
>= :: CurrencySymbol -> CurrencySymbol -> Bool
$c>= :: CurrencySymbol -> CurrencySymbol -> Bool
> :: CurrencySymbol -> CurrencySymbol -> Bool
$c> :: CurrencySymbol -> CurrencySymbol -> Bool
<= :: CurrencySymbol -> CurrencySymbol -> Bool
$c<= :: CurrencySymbol -> CurrencySymbol -> Bool
< :: CurrencySymbol -> CurrencySymbol -> Bool
$c< :: CurrencySymbol -> CurrencySymbol -> Bool
compare :: CurrencySymbol -> CurrencySymbol -> Ordering
$ccompare :: CurrencySymbol -> CurrencySymbol -> Ordering
Ord, CurrencySymbol -> BuiltinData
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: CurrencySymbol -> BuiltinData
$ctoBuiltinData :: CurrencySymbol -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe CurrencySymbol
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe CurrencySymbol
$cfromBuiltinData :: BuiltinData -> Maybe CurrencySymbol
PlutusTx.FromData, BuiltinData -> CurrencySymbol
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> CurrencySymbol
$cunsafeFromBuiltinData :: BuiltinData -> CurrencySymbol
PlutusTx.UnsafeFromData)
    deriving anyclass (CurrencySymbol -> ()
forall a. (a -> ()) -> NFData a
rnf :: CurrencySymbol -> ()
$crnf :: CurrencySymbol -> ()
NFData)

{-# INLINABLE currencySymbol #-}
-- | Creates `CurrencySymbol` from raw `ByteString`.
currencySymbol :: BS.ByteString -> CurrencySymbol
currencySymbol :: ByteString -> CurrencySymbol
currencySymbol = BuiltinByteString -> CurrencySymbol
CurrencySymbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin

{- | ByteString of a name of a token.
Shown as UTF-8 string when possible.
Should be no longer than 32 bytes, empty for Ada.
Forms an `AssetClass` along with a `CurrencySymbol`.

This is a simple type without any validation, __use with caution__.
You may want to add checks for its invariants. See the
 [Shelley ledger specification](https://hydra.iohk.io/build/16861845/download/1/ledger-spec.pdf).
-}
newtype TokenName = TokenName { TokenName -> BuiltinByteString
unTokenName :: PlutusTx.BuiltinByteString }
    deriving stock (forall x. Rep TokenName x -> TokenName
forall x. TokenName -> Rep TokenName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenName x -> TokenName
$cfrom :: forall x. TokenName -> Rep TokenName x
Generic, Typeable TokenName
TokenName -> DataType
TokenName -> Constr
(forall b. Data b => b -> b) -> TokenName -> TokenName
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) -> TokenName -> u
forall u. (forall d. Data d => d -> u) -> TokenName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenName -> m TokenName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenName -> m TokenName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenName -> c TokenName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenName)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenName -> m TokenName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenName -> m TokenName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenName -> m TokenName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenName -> m TokenName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenName -> m TokenName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenName -> m TokenName
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TokenName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TokenName -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TokenName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TokenName -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenName -> r
gmapT :: (forall b. Data b => b -> b) -> TokenName -> TokenName
$cgmapT :: (forall b. Data b => b -> b) -> TokenName -> TokenName
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenName)
dataTypeOf :: TokenName -> DataType
$cdataTypeOf :: TokenName -> DataType
toConstr :: TokenName -> Constr
$ctoConstr :: TokenName -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenName -> c TokenName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenName -> c TokenName
Data)
    deriving newtype (TokenName -> TokenName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenName -> TokenName -> Bool
$c/= :: TokenName -> TokenName -> Bool
== :: TokenName -> TokenName -> Bool
$c== :: TokenName -> TokenName -> Bool
Haskell.Eq, Eq TokenName
TokenName -> TokenName -> Bool
TokenName -> TokenName -> Ordering
TokenName -> TokenName -> TokenName
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 :: TokenName -> TokenName -> TokenName
$cmin :: TokenName -> TokenName -> TokenName
max :: TokenName -> TokenName -> TokenName
$cmax :: TokenName -> TokenName -> TokenName
>= :: TokenName -> TokenName -> Bool
$c>= :: TokenName -> TokenName -> Bool
> :: TokenName -> TokenName -> Bool
$c> :: TokenName -> TokenName -> Bool
<= :: TokenName -> TokenName -> Bool
$c<= :: TokenName -> TokenName -> Bool
< :: TokenName -> TokenName -> Bool
$c< :: TokenName -> TokenName -> Bool
compare :: TokenName -> TokenName -> Ordering
$ccompare :: TokenName -> TokenName -> Ordering
Haskell.Ord, TokenName -> TokenName -> Bool
forall a. (a -> a -> Bool) -> Eq a
== :: TokenName -> TokenName -> Bool
$c== :: TokenName -> TokenName -> Bool
Eq, Eq TokenName
TokenName -> TokenName -> Bool
TokenName -> TokenName -> Ordering
TokenName -> TokenName -> TokenName
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 :: TokenName -> TokenName -> TokenName
$cmin :: TokenName -> TokenName -> TokenName
max :: TokenName -> TokenName -> TokenName
$cmax :: TokenName -> TokenName -> TokenName
>= :: TokenName -> TokenName -> Bool
$c>= :: TokenName -> TokenName -> Bool
> :: TokenName -> TokenName -> Bool
$c> :: TokenName -> TokenName -> Bool
<= :: TokenName -> TokenName -> Bool
$c<= :: TokenName -> TokenName -> Bool
< :: TokenName -> TokenName -> Bool
$c< :: TokenName -> TokenName -> Bool
compare :: TokenName -> TokenName -> Ordering
$ccompare :: TokenName -> TokenName -> Ordering
Ord, TokenName -> BuiltinData
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: TokenName -> BuiltinData
$ctoBuiltinData :: TokenName -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe TokenName
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe TokenName
$cfromBuiltinData :: BuiltinData -> Maybe TokenName
PlutusTx.FromData, BuiltinData -> TokenName
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> TokenName
$cunsafeFromBuiltinData :: BuiltinData -> TokenName
PlutusTx.UnsafeFromData)
    deriving anyclass (TokenName -> ()
forall a. (a -> ()) -> NFData a
rnf :: TokenName -> ()
$crnf :: TokenName -> ()
NFData)
    deriving forall ann. [TokenName] -> Doc ann
forall ann. TokenName -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [TokenName] -> Doc ann
$cprettyList :: forall ann. [TokenName] -> Doc ann
pretty :: forall ann. TokenName -> Doc ann
$cpretty :: forall ann. TokenName -> Doc ann
Pretty via (PrettyShow TokenName)

-- | UTF-8 encoding. Doesn't verify length.
instance IsString TokenName where
    fromString :: String -> TokenName
fromString = Text -> TokenName
fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

{-# INLINABLE tokenName #-}
-- | Creates `TokenName` from raw `BS.ByteString`.
tokenName :: BS.ByteString -> TokenName
tokenName :: ByteString -> TokenName
tokenName = BuiltinByteString -> TokenName
TokenName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin

fromText :: Text -> TokenName
fromText :: Text -> TokenName
fromText = ByteString -> TokenName
tokenName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
E.encodeUtf8

fromTokenName :: (BS.ByteString -> r) -> (Text -> r) -> TokenName -> r
fromTokenName :: forall r. (ByteString -> r) -> (Text -> r) -> TokenName -> r
fromTokenName ByteString -> r
handleBytestring Text -> r
handleText (TokenName BuiltinByteString
bs) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\UnicodeException
_ -> ByteString -> r
handleBytestring forall a b. (a -> b) -> a -> b
$ forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin BuiltinByteString
bs) Text -> r
handleText forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
E.decodeUtf8' (forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin BuiltinByteString
bs)

-- | Encode a `ByteString` to a hex `Text`.
asBase16 :: BS.ByteString -> Text
asBase16 :: ByteString -> Text
asBase16 ByteString
bs = [Text] -> Text
Text.concat [Text
"0x", ByteString -> Text
encodeByteString ByteString
bs]

-- | Wrap the input `Text` in double quotes.
quoted :: Text -> Text
quoted :: Text -> Text
quoted Text
s = [Text] -> Text
Text.concat [Text
"\"", Text
s, Text
"\""]

toString :: TokenName -> Haskell.String
toString :: TokenName -> String
toString = Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. (ByteString -> r) -> (Text -> r) -> TokenName -> r
fromTokenName ByteString -> Text
asBase16 forall a. a -> a
id

instance Haskell.Show TokenName where
    show :: TokenName -> String
show = Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. (ByteString -> r) -> (Text -> r) -> TokenName -> r
fromTokenName ByteString -> Text
asBase16 Text -> Text
quoted

{-# INLINABLE adaSymbol #-}
-- | The 'CurrencySymbol' of the 'Ada' currency.
adaSymbol :: CurrencySymbol
adaSymbol :: CurrencySymbol
adaSymbol = BuiltinByteString -> CurrencySymbol
CurrencySymbol BuiltinByteString
emptyByteString

{-# INLINABLE adaToken #-}
-- | The 'TokenName' of the 'Ada' currency.
adaToken :: TokenName
adaToken :: TokenName
adaToken = BuiltinByteString -> TokenName
TokenName BuiltinByteString
emptyByteString

-- | An asset class, identified by a `CurrencySymbol` and a `TokenName`.
newtype AssetClass = AssetClass { AssetClass -> (CurrencySymbol, TokenName)
unAssetClass :: (CurrencySymbol, TokenName) }
    deriving stock (forall x. Rep AssetClass x -> AssetClass
forall x. AssetClass -> Rep AssetClass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssetClass x -> AssetClass
$cfrom :: forall x. AssetClass -> Rep AssetClass x
Generic, Typeable AssetClass
AssetClass -> DataType
AssetClass -> Constr
(forall b. Data b => b -> b) -> AssetClass -> AssetClass
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) -> AssetClass -> u
forall u. (forall d. Data d => d -> u) -> AssetClass -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssetClass -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssetClass -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AssetClass -> m AssetClass
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AssetClass -> m AssetClass
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssetClass
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssetClass -> c AssetClass
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssetClass)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AssetClass)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AssetClass -> m AssetClass
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AssetClass -> m AssetClass
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AssetClass -> m AssetClass
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AssetClass -> m AssetClass
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AssetClass -> m AssetClass
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AssetClass -> m AssetClass
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AssetClass -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AssetClass -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> AssetClass -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AssetClass -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssetClass -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssetClass -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssetClass -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssetClass -> r
gmapT :: (forall b. Data b => b -> b) -> AssetClass -> AssetClass
$cgmapT :: (forall b. Data b => b -> b) -> AssetClass -> AssetClass
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AssetClass)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AssetClass)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssetClass)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssetClass)
dataTypeOf :: AssetClass -> DataType
$cdataTypeOf :: AssetClass -> DataType
toConstr :: AssetClass -> Constr
$ctoConstr :: AssetClass -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssetClass
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssetClass
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssetClass -> c AssetClass
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssetClass -> c AssetClass
Data)
    deriving newtype (AssetClass -> AssetClass -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssetClass -> AssetClass -> Bool
$c/= :: AssetClass -> AssetClass -> Bool
== :: AssetClass -> AssetClass -> Bool
$c== :: AssetClass -> AssetClass -> Bool
Haskell.Eq, Eq AssetClass
AssetClass -> AssetClass -> Bool
AssetClass -> AssetClass -> Ordering
AssetClass -> AssetClass -> AssetClass
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 :: AssetClass -> AssetClass -> AssetClass
$cmin :: AssetClass -> AssetClass -> AssetClass
max :: AssetClass -> AssetClass -> AssetClass
$cmax :: AssetClass -> AssetClass -> AssetClass
>= :: AssetClass -> AssetClass -> Bool
$c>= :: AssetClass -> AssetClass -> Bool
> :: AssetClass -> AssetClass -> Bool
$c> :: AssetClass -> AssetClass -> Bool
<= :: AssetClass -> AssetClass -> Bool
$c<= :: AssetClass -> AssetClass -> Bool
< :: AssetClass -> AssetClass -> Bool
$c< :: AssetClass -> AssetClass -> Bool
compare :: AssetClass -> AssetClass -> Ordering
$ccompare :: AssetClass -> AssetClass -> Ordering
Haskell.Ord, Int -> AssetClass -> ShowS
[AssetClass] -> ShowS
AssetClass -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssetClass] -> ShowS
$cshowList :: [AssetClass] -> ShowS
show :: AssetClass -> String
$cshow :: AssetClass -> String
showsPrec :: Int -> AssetClass -> ShowS
$cshowsPrec :: Int -> AssetClass -> ShowS
Haskell.Show, AssetClass -> AssetClass -> Bool
forall a. (a -> a -> Bool) -> Eq a
== :: AssetClass -> AssetClass -> Bool
$c== :: AssetClass -> AssetClass -> Bool
Eq, Eq AssetClass
AssetClass -> AssetClass -> Bool
AssetClass -> AssetClass -> Ordering
AssetClass -> AssetClass -> AssetClass
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 :: AssetClass -> AssetClass -> AssetClass
$cmin :: AssetClass -> AssetClass -> AssetClass
max :: AssetClass -> AssetClass -> AssetClass
$cmax :: AssetClass -> AssetClass -> AssetClass
>= :: AssetClass -> AssetClass -> Bool
$c>= :: AssetClass -> AssetClass -> Bool
> :: AssetClass -> AssetClass -> Bool
$c> :: AssetClass -> AssetClass -> Bool
<= :: AssetClass -> AssetClass -> Bool
$c<= :: AssetClass -> AssetClass -> Bool
< :: AssetClass -> AssetClass -> Bool
$c< :: AssetClass -> AssetClass -> Bool
compare :: AssetClass -> AssetClass -> Ordering
$ccompare :: AssetClass -> AssetClass -> Ordering
Ord, AssetClass -> BuiltinData
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: AssetClass -> BuiltinData
$ctoBuiltinData :: AssetClass -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe AssetClass
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe AssetClass
$cfromBuiltinData :: BuiltinData -> Maybe AssetClass
PlutusTx.FromData, BuiltinData -> AssetClass
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> AssetClass
$cunsafeFromBuiltinData :: BuiltinData -> AssetClass
PlutusTx.UnsafeFromData)
    deriving anyclass (AssetClass -> ()
forall a. (a -> ()) -> NFData a
rnf :: AssetClass -> ()
$crnf :: AssetClass -> ()
NFData)
    deriving forall ann. [AssetClass] -> Doc ann
forall ann. AssetClass -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [AssetClass] -> Doc ann
$cprettyList :: forall ann. [AssetClass] -> Doc ann
pretty :: forall ann. AssetClass -> Doc ann
$cpretty :: forall ann. AssetClass -> Doc ann
Pretty via (PrettyShow (CurrencySymbol, TokenName))

{-# INLINABLE assetClass #-}
assetClass :: CurrencySymbol -> TokenName -> AssetClass
assetClass :: CurrencySymbol -> TokenName -> AssetClass
assetClass CurrencySymbol
s TokenName
t = (CurrencySymbol, TokenName) -> AssetClass
AssetClass (CurrencySymbol
s, TokenName
t)

{- | The 'Value' type represents a collection of amounts of different currencies.
We can think of 'Value' as a vector space whose dimensions are currencies.
To create a value of 'Value', we need to specify a currency. This can be done
using 'Ledger.Ada.adaValueOf'. To get the ada dimension of 'Value' we use
'Ledger.Ada.fromValue'. Plutus contract authors will be able to define modules
similar to 'Ledger.Ada' for their own currencies.

Operations on currencies are usually implemented /pointwise/. That is,
we apply the operation to the quantities for each currency in turn. So
when we add two 'Value's the resulting 'Value' has, for each currency,
the sum of the quantities of /that particular/ currency in the argument
'Value'. The effect of this is that the currencies in the 'Value' are "independent",
and are operated on separately.

Whenever we need to get the quantity of a currency in a 'Value' where there
is no explicit quantity of that currency in the 'Value', then the quantity is
taken to be zero.

There is no 'Ord Value' instance since 'Value' is only a partial order, so 'compare' can't
do the right thing in some cases.
 -}
newtype Value = Value { Value -> Map CurrencySymbol (Map TokenName Integer)
getValue :: Map.Map CurrencySymbol (Map.Map TokenName Integer) }
    deriving stock (forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Value x -> Value
$cfrom :: forall x. Value -> Rep Value x
Generic, Typeable Value
Value -> DataType
Value -> Constr
(forall b. Data b => b -> b) -> Value -> Value
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) -> Value -> u
forall u. (forall d. Data d => d -> u) -> Value -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Value -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Value -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Value -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Value -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
gmapT :: (forall b. Data b => b -> b) -> Value -> Value
$cgmapT :: (forall b. Data b => b -> b) -> Value -> Value
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
dataTypeOf :: Value -> DataType
$cdataTypeOf :: Value -> DataType
toConstr :: Value -> Constr
$ctoConstr :: Value -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
Data, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Haskell.Show)
    deriving anyclass (Value -> ()
forall a. (a -> ()) -> NFData a
rnf :: Value -> ()
$crnf :: Value -> ()
NFData)
    deriving newtype (Value -> BuiltinData
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: Value -> BuiltinData
$ctoBuiltinData :: Value -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe Value
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe Value
$cfromBuiltinData :: BuiltinData -> Maybe Value
PlutusTx.FromData, BuiltinData -> Value
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> Value
$cunsafeFromBuiltinData :: BuiltinData -> Value
PlutusTx.UnsafeFromData)
    deriving forall ann. [Value] -> Doc ann
forall ann. Value -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [Value] -> Doc ann
$cprettyList :: forall ann. [Value] -> Doc ann
pretty :: forall ann. Value -> Doc ann
$cpretty :: forall ann. Value -> Doc ann
Pretty via (PrettyShow Value)

instance Haskell.Eq Value where
    == :: Value -> Value -> Bool
(==) = Value -> Value -> Bool
eq

instance Eq Value where
    {-# INLINABLE (==) #-}
    == :: Value -> Value -> Bool
(==) = Value -> Value -> Bool
eq

instance Haskell.Semigroup Value where
    <> :: Value -> Value -> Value
(<>) = (Integer -> Integer -> Integer) -> Value -> Value -> Value
unionWith forall a. AdditiveSemigroup a => a -> a -> a
(+)

instance Semigroup Value where
    {-# INLINABLE (<>) #-}
    <> :: Value -> Value -> Value
(<>) = (Integer -> Integer -> Integer) -> Value -> Value -> Value
unionWith forall a. AdditiveSemigroup a => a -> a -> a
(+)

instance Haskell.Monoid Value where
    mempty :: Value
mempty = Map CurrencySymbol (Map TokenName Integer) -> Value
Value forall k v. Map k v
Map.empty

instance Monoid Value where
    {-# INLINABLE mempty #-}
    mempty :: Value
mempty = Map CurrencySymbol (Map TokenName Integer) -> Value
Value forall k v. Map k v
Map.empty

instance Group Value where
    {-# INLINABLE inv #-}
    inv :: Value -> Value
inv = forall s v. Module s v => s -> v -> v
scale @Integer @Value (-Integer
1)

deriving via (Additive Value) instance AdditiveSemigroup Value
deriving via (Additive Value) instance AdditiveMonoid Value
deriving via (Additive Value) instance AdditiveGroup Value

instance Module Integer Value where
    {-# INLINABLE scale #-}
    scale :: Integer -> Value -> Value
scale Integer
i (Value Map CurrencySymbol (Map TokenName Integer)
xs) = Map CurrencySymbol (Map TokenName Integer) -> Value
Value (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Integer
i' -> Integer
i forall a. MultiplicativeSemigroup a => a -> a -> a
* Integer
i')) Map CurrencySymbol (Map TokenName Integer)
xs)

instance JoinSemiLattice Value where
    {-# INLINABLE (\/) #-}
    \/ :: Value -> Value -> Value
(\/) = (Integer -> Integer -> Integer) -> Value -> Value -> Value
unionWith forall a. Ord a => a -> a -> a
Ord.max

instance MeetSemiLattice Value where
    {-# INLINABLE (/\) #-}
    /\ :: Value -> Value -> Value
(/\) = (Integer -> Integer -> Integer) -> Value -> Value -> Value
unionWith forall a. Ord a => a -> a -> a
Ord.min

{-# INLINABLE valueOf #-}
-- | Get the quantity of the given currency in the 'Value'.
valueOf :: Value -> CurrencySymbol -> TokenName -> Integer
valueOf :: Value -> CurrencySymbol -> TokenName -> Integer
valueOf (Value Map CurrencySymbol (Map TokenName Integer)
mp) CurrencySymbol
cur TokenName
tn =
    case forall k v. Eq k => k -> Map k v -> Maybe v
Map.lookup CurrencySymbol
cur Map CurrencySymbol (Map TokenName Integer)
mp of
        Maybe (Map TokenName Integer)
Nothing -> Integer
0 :: Integer
        Just Map TokenName Integer
i  -> case forall k v. Eq k => k -> Map k v -> Maybe v
Map.lookup TokenName
tn Map TokenName Integer
i of
            Maybe Integer
Nothing -> Integer
0
            Just Integer
v  -> Integer
v

{-# INLINABLE symbols #-}
-- | The list of 'CurrencySymbol's of a 'Value'.
symbols :: Value -> [CurrencySymbol]
symbols :: Value -> [CurrencySymbol]
symbols (Value Map CurrencySymbol (Map TokenName Integer)
mp) = forall k v. Map k v -> [k]
Map.keys Map CurrencySymbol (Map TokenName Integer)
mp

{-# INLINABLE singleton #-}
-- | Make a 'Value' containing only the given quantity of the given currency.
singleton :: CurrencySymbol -> TokenName -> Integer -> Value
singleton :: CurrencySymbol -> TokenName -> Integer -> Value
singleton CurrencySymbol
c TokenName
tn Integer
i = Map CurrencySymbol (Map TokenName Integer) -> Value
Value (forall k v. k -> v -> Map k v
Map.singleton CurrencySymbol
c (forall k v. k -> v -> Map k v
Map.singleton TokenName
tn Integer
i))

{-# INLINABLE assetClassValue #-}
-- | A 'Value' containing the given amount of the asset class.
assetClassValue :: AssetClass -> Integer -> Value
assetClassValue :: AssetClass -> Integer -> Value
assetClassValue (AssetClass (CurrencySymbol
c, TokenName
t)) Integer
i = CurrencySymbol -> TokenName -> Integer -> Value
singleton CurrencySymbol
c TokenName
t Integer
i

{-# INLINABLE assetClassValueOf #-}
-- | Get the quantity of the given 'AssetClass' class in the 'Value'.
assetClassValueOf :: Value -> AssetClass -> Integer
assetClassValueOf :: Value -> AssetClass -> Integer
assetClassValueOf Value
v (AssetClass (CurrencySymbol
c, TokenName
t)) = Value -> CurrencySymbol -> TokenName -> Integer
valueOf Value
v CurrencySymbol
c TokenName
t

{-# INLINABLE unionVal #-}
-- | Combine two 'Value' maps
unionVal :: Value -> Value -> Map.Map CurrencySymbol (Map.Map TokenName (These Integer Integer))
unionVal :: Value
-> Value
-> Map CurrencySymbol (Map TokenName (These Integer Integer))
unionVal (Value Map CurrencySymbol (Map TokenName Integer)
l) (Value Map CurrencySymbol (Map TokenName Integer)
r) =
    let
        combined :: Map
  CurrencySymbol
  (These (Map TokenName Integer) (Map TokenName Integer))
combined = forall k v r. Eq k => Map k v -> Map k r -> Map k (These v r)
Map.union Map CurrencySymbol (Map TokenName Integer)
l Map CurrencySymbol (Map TokenName Integer)
r
        unThese :: These (Map k a) (Map k b) -> Map k (These a b)
unThese These (Map k a) (Map k b)
k = case These (Map k a) (Map k b)
k of
            This Map k a
a    -> forall a b. a -> These a b
This forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map k a
a
            That Map k b
b    -> forall a b. b -> These a b
That forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map k b
b
            These Map k a
a Map k b
b -> forall k v r. Eq k => Map k v -> Map k r -> Map k (These v r)
Map.union Map k a
a Map k b
b
    in forall {k} {a} {b}.
Eq k =>
These (Map k a) (Map k b) -> Map k (These a b)
unThese forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map
  CurrencySymbol
  (These (Map TokenName Integer) (Map TokenName Integer))
combined

{-# INLINABLE unionWith #-}
unionWith :: (Integer -> Integer -> Integer) -> Value -> Value -> Value
unionWith :: (Integer -> Integer -> Integer) -> Value -> Value -> Value
unionWith Integer -> Integer -> Integer
f Value
ls Value
rs =
    let
        combined :: Map CurrencySymbol (Map TokenName (These Integer Integer))
combined = Value
-> Value
-> Map CurrencySymbol (Map TokenName (These Integer Integer))
unionVal Value
ls Value
rs
        unThese :: These Integer Integer -> Integer
unThese These Integer Integer
k' = case These Integer Integer
k' of
            This Integer
a    -> Integer -> Integer -> Integer
f Integer
a Integer
0
            That Integer
b    -> Integer -> Integer -> Integer
f Integer
0 Integer
b
            These Integer
a Integer
b -> Integer -> Integer -> Integer
f Integer
a Integer
b
    in Map CurrencySymbol (Map TokenName Integer) -> Value
Value (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap These Integer Integer -> Integer
unThese) Map CurrencySymbol (Map TokenName (These Integer Integer))
combined)

{-# INLINABLE flattenValue #-}
-- | Convert a value to a simple list, keeping only the non-zero amounts.
flattenValue :: Value -> [(CurrencySymbol, TokenName, Integer)]
flattenValue :: Value -> [(CurrencySymbol, TokenName, Integer)]
flattenValue Value
v = forall {c} {a} {b}.
(Eq c, Num c) =>
[(a, b, c)] -> [(a, Map b c)] -> [(a, b, c)]
goOuter [] (forall k v. Map k v -> [(k, v)]
Map.toList forall a b. (a -> b) -> a -> b
$ Value -> Map CurrencySymbol (Map TokenName Integer)
getValue Value
v)
  where
    goOuter :: [(a, b, c)] -> [(a, Map b c)] -> [(a, b, c)]
goOuter [(a, b, c)]
acc []             = [(a, b, c)]
acc
    goOuter [(a, b, c)]
acc ((a
cs, Map b c
m) : [(a, Map b c)]
tl) = [(a, b, c)] -> [(a, Map b c)] -> [(a, b, c)]
goOuter (forall {c} {a} {b}.
(Eq c, Num c) =>
a -> [(a, b, c)] -> [(b, c)] -> [(a, b, c)]
goInner a
cs [(a, b, c)]
acc (forall k v. Map k v -> [(k, v)]
Map.toList Map b c
m)) [(a, Map b c)]
tl

    goInner :: a -> [(a, b, c)] -> [(b, c)] -> [(a, b, c)]
goInner a
_ [(a, b, c)]
acc [] = [(a, b, c)]
acc
    goInner a
cs [(a, b, c)]
acc ((b
tn, c
a) : [(b, c)]
tl)
        | c
a forall a. Eq a => a -> a -> Bool
/= c
0    = a -> [(a, b, c)] -> [(b, c)] -> [(a, b, c)]
goInner a
cs ((a
cs, b
tn, c
a) forall a. a -> [a] -> [a]
: [(a, b, c)]
acc) [(b, c)]
tl
        | Bool
otherwise = a -> [(a, b, c)] -> [(b, c)] -> [(a, b, c)]
goInner a
cs [(a, b, c)]
acc [(b, c)]
tl

-- Num operations

{-# INLINABLE isZero #-}
-- | Check whether a 'Value' is zero.
isZero :: Value -> Bool
isZero :: Value -> Bool
isZero (Value Map CurrencySymbol (Map TokenName Integer)
xs) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Map.all (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Map.all (\Integer
i -> Integer
0 forall a. Eq a => a -> a -> Bool
== Integer
i)) Map CurrencySymbol (Map TokenName Integer)
xs

{-# INLINABLE checkPred #-}
checkPred :: (These Integer Integer -> Bool) -> Value -> Value -> Bool
checkPred :: (These Integer Integer -> Bool) -> Value -> Value -> Bool
checkPred These Integer Integer -> Bool
f Value
l Value
r =
    let
      inner :: Map.Map TokenName (These Integer Integer) -> Bool
      inner :: Map TokenName (These Integer Integer) -> Bool
inner = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Map.all These Integer Integer -> Bool
f
    in
      forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Map.all Map TokenName (These Integer Integer) -> Bool
inner (Value
-> Value
-> Map CurrencySymbol (Map TokenName (These Integer Integer))
unionVal Value
l Value
r)

{-# INLINABLE checkBinRel #-}
-- | Check whether a binary relation holds for value pairs of two 'Value' maps,
--   supplying 0 where a key is only present in one of them.
checkBinRel :: (Integer -> Integer -> Bool) -> Value -> Value -> Bool
checkBinRel :: (Integer -> Integer -> Bool) -> Value -> Value -> Bool
checkBinRel Integer -> Integer -> Bool
f Value
l Value
r =
    let
        unThese :: These Integer Integer -> Bool
unThese These Integer Integer
k' = case These Integer Integer
k' of
            This Integer
a    -> Integer -> Integer -> Bool
f Integer
a Integer
0
            That Integer
b    -> Integer -> Integer -> Bool
f Integer
0 Integer
b
            These Integer
a Integer
b -> Integer -> Integer -> Bool
f Integer
a Integer
b
    in (These Integer Integer -> Bool) -> Value -> Value -> Bool
checkPred These Integer Integer -> Bool
unThese Value
l Value
r

{-# INLINABLE eq #-}
-- | Check whether one 'Value' is equal to another. See 'Value' for an explanation of how operations on 'Value's work.
eq :: Value -> Value -> Bool
-- If both are zero then checkBinRel will be vacuously true, but this is fine.
eq :: Value -> Value -> Bool
eq = (Integer -> Integer -> Bool) -> Value -> Value -> Bool
checkBinRel forall a. Eq a => a -> a -> Bool
(==)

{-# INLINABLE geq #-}
-- | Check whether one 'Value' is greater than or equal to another. See 'Value' for an explanation of how operations on 'Value's work.
geq :: Value -> Value -> Bool
-- If both are zero then checkBinRel will be vacuously true, but this is fine.
geq :: Value -> Value -> Bool
geq = (Integer -> Integer -> Bool) -> Value -> Value -> Bool
checkBinRel forall a. Ord a => a -> a -> Bool
(>=)

{-# INLINABLE leq #-}
-- | Check whether one 'Value' is less than or equal to another. See 'Value' for an explanation of how operations on 'Value's work.
leq :: Value -> Value -> Bool
-- If both are zero then checkBinRel will be vacuously true, but this is fine.
leq :: Value -> Value -> Bool
leq = (Integer -> Integer -> Bool) -> Value -> Value -> Bool
checkBinRel forall a. Ord a => a -> a -> Bool
(<=)

{-# INLINABLE gt #-}
-- | Check whether one 'Value' is strictly greater than another.
-- This is *not* a pointwise operation. @gt l r@ means @geq l r && not (eq l r)@.
gt :: Value -> Value -> Bool
gt :: Value -> Value -> Bool
gt Value
l Value
r = Value -> Value -> Bool
geq Value
l Value
r Bool -> Bool -> Bool
&& Bool -> Bool
not (Value -> Value -> Bool
eq Value
l Value
r)

{-# INLINABLE lt #-}
-- | Check whether one 'Value' is strictly less than another.
-- This is *not* a pointwise operation. @lt l r@ means @leq l r && not (eq l r)@.
lt :: Value -> Value -> Bool
lt :: Value -> Value -> Bool
lt Value
l Value
r = Value -> Value -> Bool
leq Value
l Value
r Bool -> Bool -> Bool
&& Bool -> Bool
not (Value -> Value -> Bool
eq Value
l Value
r)

-- | Split a value into its positive and negative parts. The first element of
--   the tuple contains the negative parts of the value, the second element
--   contains the positive parts.
--
--   @negate (fst (split a)) `plus` (snd (split a)) == a@
--
{-# INLINABLE split #-}
split :: Value -> (Value, Value)
split :: Value -> (Value, Value)
split (Value Map CurrencySymbol (Map TokenName Integer)
mp) = (forall a. AdditiveGroup a => a -> a
negate (Map CurrencySymbol (Map TokenName Integer) -> Value
Value Map CurrencySymbol (Map TokenName Integer)
neg), Map CurrencySymbol (Map TokenName Integer) -> Value
Value Map CurrencySymbol (Map TokenName Integer)
pos) where
  (Map CurrencySymbol (Map TokenName Integer)
neg, Map CurrencySymbol (Map TokenName Integer)
pos) = forall v a b k. (v -> These a b) -> Map k v -> (Map k a, Map k b)
Map.mapThese Map TokenName Integer
-> These (Map TokenName Integer) (Map TokenName Integer)
splitIntl Map CurrencySymbol (Map TokenName Integer)
mp

  splitIntl :: Map.Map TokenName Integer -> These (Map.Map TokenName Integer) (Map.Map TokenName Integer)
  splitIntl :: Map TokenName Integer
-> These (Map TokenName Integer) (Map TokenName Integer)
splitIntl Map TokenName Integer
mp' = forall a b. a -> b -> These a b
These Map TokenName Integer
l Map TokenName Integer
r where
    (Map TokenName Integer
l, Map TokenName Integer
r) = forall v a b k. (v -> These a b) -> Map k v -> (Map k a, Map k b)
Map.mapThese (\Integer
i -> if Integer
i forall a. Ord a => a -> a -> Bool
<= Integer
0 then forall a b. a -> These a b
This Integer
i else forall a b. b -> These a b
That Integer
i) Map TokenName Integer
mp'

makeLift ''CurrencySymbol
makeLift ''TokenName
makeLift ''AssetClass
makeLift ''Value