{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell   #-}
-- Otherwise we get a complaint about the 'fromIntegral' call in the generated instance of 'Integral' for 'Ada'
{-# OPTIONS_GHC -Wno-identities #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
-- | Functions for working with 'Ada' in Template Haskell.
module Plutus.Script.Utils.Ada(
      Ada (..)
    , getAda
    , adaSymbol
    , adaToken
    -- * Constructors
    , fromValue
    , toValue
    , lovelaceOf
    , adaOf
    , lovelaceValueOf
    , adaValueOf
    -- * Num operations
    , divide
    -- * Etc.
    , isZero
    ) where

import Prelude qualified as Haskell

import Data.Fixed (Fixed (MkFixed), Micro)

import Codec.Serialise.Class (Serialise)
import Data.Aeson (FromJSON, ToJSON)
import Data.Tagged (Tagged (Tagged))
import GHC.Generics (Generic)
import Plutus.V1.Ledger.Value (CurrencySymbol (CurrencySymbol), TokenName (TokenName), Value)
import Plutus.V1.Ledger.Value qualified as TH
import PlutusTx qualified
import PlutusTx.Lift (makeLift)
import PlutusTx.Prelude (AdditiveGroup, AdditiveMonoid, AdditiveSemigroup ((+)), Bool, Eq ((==)), Integer, Monoid,
                         MultiplicativeMonoid, MultiplicativeSemigroup, Ord, Semigroup, emptyByteString)
import PlutusTx.Prelude qualified as P
import Prettyprinter (Pretty)

{-# 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

-- | ADA, the special currency on the Cardano blockchain. The unit of Ada is Lovelace, and
--   1M Lovelace is one Ada.
--   See note [Currencies] in 'Ledger.Validation.Value.TH'.
newtype Ada = Lovelace { Ada -> Integer
getLovelace :: Integer }
    deriving (Int -> Ada
Ada -> Int
Ada -> [Ada]
Ada -> Ada
Ada -> Ada -> [Ada]
Ada -> Ada -> Ada -> [Ada]
(Ada -> Ada)
-> (Ada -> Ada)
-> (Int -> Ada)
-> (Ada -> Int)
-> (Ada -> [Ada])
-> (Ada -> Ada -> [Ada])
-> (Ada -> Ada -> [Ada])
-> (Ada -> Ada -> Ada -> [Ada])
-> Enum Ada
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Ada -> Ada -> Ada -> [Ada]
$cenumFromThenTo :: Ada -> Ada -> Ada -> [Ada]
enumFromTo :: Ada -> Ada -> [Ada]
$cenumFromTo :: Ada -> Ada -> [Ada]
enumFromThen :: Ada -> Ada -> [Ada]
$cenumFromThen :: Ada -> Ada -> [Ada]
enumFrom :: Ada -> [Ada]
$cenumFrom :: Ada -> [Ada]
fromEnum :: Ada -> Int
$cfromEnum :: Ada -> Int
toEnum :: Int -> Ada
$ctoEnum :: Int -> Ada
pred :: Ada -> Ada
$cpred :: Ada -> Ada
succ :: Ada -> Ada
$csucc :: Ada -> Ada
Haskell.Enum)
    deriving stock (Ada -> Ada -> Bool
(Ada -> Ada -> Bool) -> (Ada -> Ada -> Bool) -> Eq Ada
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ada -> Ada -> Bool
$c/= :: Ada -> Ada -> Bool
== :: Ada -> Ada -> Bool
$c== :: Ada -> Ada -> Bool
Haskell.Eq, Eq Ada
Eq Ada
-> (Ada -> Ada -> Ordering)
-> (Ada -> Ada -> Bool)
-> (Ada -> Ada -> Bool)
-> (Ada -> Ada -> Bool)
-> (Ada -> Ada -> Bool)
-> (Ada -> Ada -> Ada)
-> (Ada -> Ada -> Ada)
-> Ord Ada
Ada -> Ada -> Bool
Ada -> Ada -> Ordering
Ada -> Ada -> Ada
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 :: Ada -> Ada -> Ada
$cmin :: Ada -> Ada -> Ada
max :: Ada -> Ada -> Ada
$cmax :: Ada -> Ada -> Ada
>= :: Ada -> Ada -> Bool
$c>= :: Ada -> Ada -> Bool
> :: Ada -> Ada -> Bool
$c> :: Ada -> Ada -> Bool
<= :: Ada -> Ada -> Bool
$c<= :: Ada -> Ada -> Bool
< :: Ada -> Ada -> Bool
$c< :: Ada -> Ada -> Bool
compare :: Ada -> Ada -> Ordering
$ccompare :: Ada -> Ada -> Ordering
$cp1Ord :: Eq Ada
Haskell.Ord, Int -> Ada -> ShowS
[Ada] -> ShowS
Ada -> String
(Int -> Ada -> ShowS)
-> (Ada -> String) -> ([Ada] -> ShowS) -> Show Ada
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ada] -> ShowS
$cshowList :: [Ada] -> ShowS
show :: Ada -> String
$cshow :: Ada -> String
showsPrec :: Int -> Ada -> ShowS
$cshowsPrec :: Int -> Ada -> ShowS
Haskell.Show, (forall x. Ada -> Rep Ada x)
-> (forall x. Rep Ada x -> Ada) -> Generic Ada
forall x. Rep Ada x -> Ada
forall x. Ada -> Rep Ada x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ada x -> Ada
$cfrom :: forall x. Ada -> Rep Ada x
Generic)
    deriving anyclass ([Ada] -> Encoding
[Ada] -> Value
Ada -> Encoding
Ada -> Value
(Ada -> Value)
-> (Ada -> Encoding)
-> ([Ada] -> Value)
-> ([Ada] -> Encoding)
-> ToJSON Ada
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Ada] -> Encoding
$ctoEncodingList :: [Ada] -> Encoding
toJSONList :: [Ada] -> Value
$ctoJSONList :: [Ada] -> Value
toEncoding :: Ada -> Encoding
$ctoEncoding :: Ada -> Encoding
toJSON :: Ada -> Value
$ctoJSON :: Ada -> Value
ToJSON, Value -> Parser [Ada]
Value -> Parser Ada
(Value -> Parser Ada) -> (Value -> Parser [Ada]) -> FromJSON Ada
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Ada]
$cparseJSONList :: Value -> Parser [Ada]
parseJSON :: Value -> Parser Ada
$cparseJSON :: Value -> Parser Ada
FromJSON)
    deriving newtype (Ada -> Ada -> Bool
(Ada -> Ada -> Bool) -> Eq Ada
forall a. (a -> a -> Bool) -> Eq a
== :: Ada -> Ada -> Bool
$c== :: Ada -> Ada -> Bool
Eq, Eq Ada
Eq Ada
-> (Ada -> Ada -> Ordering)
-> (Ada -> Ada -> Bool)
-> (Ada -> Ada -> Bool)
-> (Ada -> Ada -> Bool)
-> (Ada -> Ada -> Bool)
-> (Ada -> Ada -> Ada)
-> (Ada -> Ada -> Ada)
-> Ord Ada
Ada -> Ada -> Bool
Ada -> Ada -> Ordering
Ada -> Ada -> Ada
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 :: Ada -> Ada -> Ada
$cmin :: Ada -> Ada -> Ada
max :: Ada -> Ada -> Ada
$cmax :: Ada -> Ada -> Ada
>= :: Ada -> Ada -> Bool
$c>= :: Ada -> Ada -> Bool
> :: Ada -> Ada -> Bool
$c> :: Ada -> Ada -> Bool
<= :: Ada -> Ada -> Bool
$c<= :: Ada -> Ada -> Bool
< :: Ada -> Ada -> Bool
$c< :: Ada -> Ada -> Bool
compare :: Ada -> Ada -> Ordering
$ccompare :: Ada -> Ada -> Ordering
$cp1Ord :: Eq Ada
Ord, Integer -> Ada
Ada -> Ada
Ada -> Ada -> Ada
(Ada -> Ada -> Ada)
-> (Ada -> Ada -> Ada)
-> (Ada -> Ada -> Ada)
-> (Ada -> Ada)
-> (Ada -> Ada)
-> (Ada -> Ada)
-> (Integer -> Ada)
-> Num Ada
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Ada
$cfromInteger :: Integer -> Ada
signum :: Ada -> Ada
$csignum :: Ada -> Ada
abs :: Ada -> Ada
$cabs :: Ada -> Ada
negate :: Ada -> Ada
$cnegate :: Ada -> Ada
* :: Ada -> Ada -> Ada
$c* :: Ada -> Ada -> Ada
- :: Ada -> Ada -> Ada
$c- :: Ada -> Ada -> Ada
+ :: Ada -> Ada -> Ada
$c+ :: Ada -> Ada -> Ada
Haskell.Num, Ada -> Ada -> Ada
(Ada -> Ada -> Ada) -> AdditiveSemigroup Ada
forall a. (a -> a -> a) -> AdditiveSemigroup a
+ :: Ada -> Ada -> Ada
$c+ :: Ada -> Ada -> Ada
AdditiveSemigroup, AdditiveSemigroup Ada
Ada
AdditiveSemigroup Ada -> Ada -> AdditiveMonoid Ada
forall a. AdditiveSemigroup a -> a -> AdditiveMonoid a
zero :: Ada
$czero :: Ada
$cp1AdditiveMonoid :: AdditiveSemigroup Ada
AdditiveMonoid, AdditiveMonoid Ada
AdditiveMonoid Ada -> (Ada -> Ada -> Ada) -> AdditiveGroup Ada
Ada -> Ada -> Ada
forall a. AdditiveMonoid a -> (a -> a -> a) -> AdditiveGroup a
- :: Ada -> Ada -> Ada
$c- :: Ada -> Ada -> Ada
$cp1AdditiveGroup :: AdditiveMonoid Ada
AdditiveGroup, Ada -> Ada -> Ada
(Ada -> Ada -> Ada) -> MultiplicativeSemigroup Ada
forall a. (a -> a -> a) -> MultiplicativeSemigroup a
* :: Ada -> Ada -> Ada
$c* :: Ada -> Ada -> Ada
MultiplicativeSemigroup, MultiplicativeSemigroup Ada
Ada
MultiplicativeSemigroup Ada -> Ada -> MultiplicativeMonoid Ada
forall a. MultiplicativeSemigroup a -> a -> MultiplicativeMonoid a
one :: Ada
$cone :: Ada
$cp1MultiplicativeMonoid :: MultiplicativeSemigroup Ada
MultiplicativeMonoid, Enum Ada
Real Ada
Real Ada
-> Enum Ada
-> (Ada -> Ada -> Ada)
-> (Ada -> Ada -> Ada)
-> (Ada -> Ada -> Ada)
-> (Ada -> Ada -> Ada)
-> (Ada -> Ada -> (Ada, Ada))
-> (Ada -> Ada -> (Ada, Ada))
-> (Ada -> Integer)
-> Integral Ada
Ada -> Integer
Ada -> Ada -> (Ada, Ada)
Ada -> Ada -> Ada
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Ada -> Integer
$ctoInteger :: Ada -> Integer
divMod :: Ada -> Ada -> (Ada, Ada)
$cdivMod :: Ada -> Ada -> (Ada, Ada)
quotRem :: Ada -> Ada -> (Ada, Ada)
$cquotRem :: Ada -> Ada -> (Ada, Ada)
mod :: Ada -> Ada -> Ada
$cmod :: Ada -> Ada -> Ada
div :: Ada -> Ada -> Ada
$cdiv :: Ada -> Ada -> Ada
rem :: Ada -> Ada -> Ada
$crem :: Ada -> Ada -> Ada
quot :: Ada -> Ada -> Ada
$cquot :: Ada -> Ada -> Ada
$cp2Integral :: Enum Ada
$cp1Integral :: Real Ada
Haskell.Integral, Num Ada
Ord Ada
Num Ada -> Ord Ada -> (Ada -> Rational) -> Real Ada
Ada -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Ada -> Rational
$ctoRational :: Ada -> Rational
$cp2Real :: Ord Ada
$cp1Real :: Num Ada
Haskell.Real, Decoder s Ada
Decoder s [Ada]
[Ada] -> Encoding
Ada -> Encoding
(Ada -> Encoding)
-> (forall s. Decoder s Ada)
-> ([Ada] -> Encoding)
-> (forall s. Decoder s [Ada])
-> Serialise Ada
forall s. Decoder s [Ada]
forall s. Decoder s Ada
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [Ada]
$cdecodeList :: forall s. Decoder s [Ada]
encodeList :: [Ada] -> Encoding
$cencodeList :: [Ada] -> Encoding
decode :: Decoder s Ada
$cdecode :: forall s. Decoder s Ada
encode :: Ada -> Encoding
$cencode :: Ada -> Encoding
Serialise, Ada -> BuiltinData
(Ada -> BuiltinData) -> ToData Ada
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: Ada -> BuiltinData
$ctoBuiltinData :: Ada -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe Ada
(BuiltinData -> Maybe Ada) -> FromData Ada
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe Ada
$cfromBuiltinData :: BuiltinData -> Maybe Ada
PlutusTx.FromData, BuiltinData -> Ada
(BuiltinData -> Ada) -> UnsafeFromData Ada
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> Ada
$cunsafeFromBuiltinData :: BuiltinData -> Ada
PlutusTx.UnsafeFromData)
    deriving [Ada] -> Doc ann
Ada -> Doc ann
(forall ann. Ada -> Doc ann)
-> (forall ann. [Ada] -> Doc ann) -> Pretty Ada
forall ann. [Ada] -> Doc ann
forall ann. Ada -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [Ada] -> Doc ann
$cprettyList :: forall ann. [Ada] -> Doc ann
pretty :: Ada -> Doc ann
$cpretty :: forall ann. Ada -> Doc ann
Pretty via (Tagged "Lovelace:" Integer)

instance Haskell.Semigroup Ada where
    Lovelace Integer
a1 <> :: Ada -> Ada -> Ada
<> Lovelace Integer
a2 = Integer -> Ada
Lovelace (Integer
a1 Integer -> Integer -> Integer
forall a. AdditiveSemigroup a => a -> a -> a
+ Integer
a2)

instance Semigroup Ada where
    Lovelace Integer
a1 <> :: Ada -> Ada -> Ada
<> Lovelace Integer
a2 = Integer -> Ada
Lovelace (Integer
a1 Integer -> Integer -> Integer
forall a. AdditiveSemigroup a => a -> a -> a
+ Integer
a2)

instance Haskell.Monoid Ada where
    mempty :: Ada
mempty = Integer -> Ada
Lovelace Integer
0

instance Monoid Ada where
    mempty :: Ada
mempty = Integer -> Ada
Lovelace Integer
0

makeLift ''Ada

{-# INLINABLE getAda #-}
-- | Get the amount of Ada (the unit of the currency Ada) in this 'Ada' value.
getAda :: Ada -> Micro
getAda :: Ada -> Micro
getAda (Lovelace Integer
i) = Integer -> Micro
forall k (a :: k). Integer -> Fixed a
MkFixed Integer
i

{-# INLINABLE toValue #-}
-- | Create a 'Value' containing only the given 'Ada'.
toValue :: Ada -> Value
toValue :: Ada -> Value
toValue (Lovelace Integer
i) = CurrencySymbol -> TokenName -> Integer -> Value
TH.singleton CurrencySymbol
adaSymbol TokenName
adaToken Integer
i

{-# INLINABLE fromValue #-}
-- | Get the 'Ada' in the given 'Value'.
fromValue :: Value -> Ada
fromValue :: Value -> Ada
fromValue Value
v = Integer -> Ada
Lovelace (Value -> CurrencySymbol -> TokenName -> Integer
TH.valueOf Value
v CurrencySymbol
adaSymbol TokenName
adaToken)

{-# INLINABLE lovelaceOf #-}
-- | Create 'Ada' representing the given quantity of Lovelace (the unit of the currency Ada).
lovelaceOf :: Integer -> Ada
lovelaceOf :: Integer -> Ada
lovelaceOf = Integer -> Ada
Lovelace

{-# INLINABLE adaOf #-}
-- | Create 'Ada' representing the given quantity of Ada (1M Lovelace).
adaOf :: Micro -> Ada
adaOf :: Micro -> Ada
adaOf (MkFixed Integer
x) = Integer -> Ada
Lovelace Integer
x

{-# INLINABLE lovelaceValueOf #-}
-- | A 'Value' with the given amount of Lovelace (the currency unit).
--
--   @lovelaceValueOf == toValue . lovelaceOf@
--
lovelaceValueOf :: Integer -> Value
lovelaceValueOf :: Integer -> Value
lovelaceValueOf = CurrencySymbol -> TokenName -> Integer -> Value
TH.singleton CurrencySymbol
adaSymbol TokenName
adaToken

{-# INLINABLE adaValueOf #-}
-- | A 'Value' with the given amount of Ada (the currency unit).
--
--   @adaValueOf == toValue . adaOf@
--
adaValueOf :: Micro -> Value
adaValueOf :: Micro -> Value
adaValueOf (MkFixed Integer
x) = CurrencySymbol -> TokenName -> Integer -> Value
TH.singleton CurrencySymbol
adaSymbol TokenName
adaToken Integer
x

{-# INLINABLE divide #-}
-- | Divide one 'Ada' value by another.
divide :: Ada -> Ada -> Ada
divide :: Ada -> Ada -> Ada
divide (Lovelace Integer
a) (Lovelace Integer
b) = Integer -> Ada
Lovelace (Integer -> Integer -> Integer
P.divide Integer
a Integer
b)

{-# INLINABLE isZero #-}
-- | Check whether an 'Ada' value is zero.
isZero :: Ada -> Bool
isZero :: Ada -> Bool
isZero (Lovelace Integer
i) = Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0