{-# OPTIONS_GHC -Wno-orphans #-}

-- | This modules exposes optics around 'Api.Value' and 'Api.Lovelace' that we
-- use in our 'Cooked.Skeleton.TxSkel' and are not defined anywhere else.
module Cooked.Skeleton.Value
  ( -- * Optics
    valueAssetClassAmountL,
    valueLovelaceL,
    valueAssetClassAmountP,
    valueLovelaceP,
    lovelaceIntegerI,
  )
where

import Optics.Core
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V1.Value qualified as Api
import PlutusTx.AssocMap qualified as PMap

-- | A lens to get or set the amount of tokens of a certain 'Api.AssetClass'
-- from a given 'Api.Value'. This removes the entry if the new amount is 0.
valueAssetClassAmountL :: (Script.ToMintingPolicyHash mp) => mp -> Api.TokenName -> Lens' Api.Value Integer
valueAssetClassAmountL :: forall mp.
ToMintingPolicyHash mp =>
mp -> TokenName -> Lens' Value Integer
valueAssetClassAmountL (mp -> CurrencySymbol
forall script.
ToMintingPolicyHash script =>
script -> CurrencySymbol
Script.toCurrencySymbol -> CurrencySymbol
cs) TokenName
tk =
  (Value -> Integer)
-> (Value -> Integer -> Value) -> Lens' Value Integer
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (Value -> AssetClass -> Integer
`Api.assetClassValueOf` CurrencySymbol -> TokenName -> AssetClass
Api.assetClass CurrencySymbol
cs TokenName
tk)
    ( \v :: Value
v@(Api.Value Map CurrencySymbol (Map TokenName Integer)
val) Integer
i -> case CurrencySymbol
-> Map CurrencySymbol (Map TokenName Integer)
-> Maybe (Map TokenName Integer)
forall k v. Eq k => k -> Map k v -> Maybe v
PMap.lookup CurrencySymbol
cs Map CurrencySymbol (Map TokenName Integer)
val of
        -- No previous cs entry and nothing to add.
        Maybe (Map TokenName Integer)
Nothing | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> Value
v
        -- No previous cs entry, and something to add.
        Maybe (Map TokenName Integer)
Nothing -> Map CurrencySymbol (Map TokenName Integer) -> Value
Api.Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Map CurrencySymbol (Map TokenName Integer) -> Value
forall a b. (a -> b) -> a -> b
$ CurrencySymbol
-> Map TokenName Integer
-> Map CurrencySymbol (Map TokenName Integer)
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. Eq k => k -> v -> Map k v -> Map k v
PMap.insert CurrencySymbol
cs (TokenName -> Integer -> Map TokenName Integer
forall k v. k -> v -> Map k v
PMap.singleton TokenName
tk Integer
i) Map CurrencySymbol (Map TokenName Integer)
val
        -- A previous cs and tk entry, which needs to be removed and the whole
        -- cs entry as well because it only containes this tk.
        Just (Map TokenName Integer -> [(TokenName, Integer)]
forall k v. Map k v -> [(k, v)]
PMap.toList -> [(TokenName
tk', Integer
_)]) | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0, TokenName
tk TokenName -> TokenName -> Bool
forall a. Eq a => a -> a -> Bool
== TokenName
tk' -> Map CurrencySymbol (Map TokenName Integer) -> Value
Api.Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Map CurrencySymbol (Map TokenName Integer) -> Value
forall a b. (a -> b) -> a -> b
$ CurrencySymbol
-> Map CurrencySymbol (Map TokenName Integer)
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. Eq k => k -> Map k v -> Map k v
PMap.delete CurrencySymbol
cs Map CurrencySymbol (Map TokenName Integer)
val
        -- A previous cs and tk entry, which needs to be removed, but the whole
        -- cs entry has other tokens and thus is kept.
        Just Map TokenName Integer
tokenMap | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> Map CurrencySymbol (Map TokenName Integer) -> Value
Api.Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Map CurrencySymbol (Map TokenName Integer) -> Value
forall a b. (a -> b) -> a -> b
$ CurrencySymbol
-> Map TokenName Integer
-> Map CurrencySymbol (Map TokenName Integer)
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. Eq k => k -> v -> Map k v -> Map k v
PMap.insert CurrencySymbol
cs (TokenName -> Map TokenName Integer -> Map TokenName Integer
forall k v. Eq k => k -> Map k v -> Map k v
PMap.delete TokenName
tk Map TokenName Integer
tokenMap) Map CurrencySymbol (Map TokenName Integer)
val
        -- A previous cs entry, in which we insert the new tk (regarless of
        -- whether the tk was already present).
        Just Map TokenName Integer
tokenMap -> Map CurrencySymbol (Map TokenName Integer) -> Value
Api.Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Map CurrencySymbol (Map TokenName Integer) -> Value
forall a b. (a -> b) -> a -> b
$ CurrencySymbol
-> Map TokenName Integer
-> Map CurrencySymbol (Map TokenName Integer)
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. Eq k => k -> v -> Map k v -> Map k v
PMap.insert CurrencySymbol
cs (TokenName
-> Integer -> Map TokenName Integer -> Map TokenName Integer
forall k v. Eq k => k -> v -> Map k v -> Map k v
PMap.insert TokenName
tk Integer
i Map TokenName Integer
tokenMap) Map CurrencySymbol (Map TokenName Integer)
val
    )

-- | Isomorphism between 'Api.Lovelace' and integers
lovelaceIntegerI :: Iso' Api.Lovelace Integer
lovelaceIntegerI :: Iso' Lovelace Integer
lovelaceIntegerI = (Lovelace -> Integer)
-> (Integer -> Lovelace) -> Iso' Lovelace Integer
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Lovelace -> Integer
Api.getLovelace Integer -> Lovelace
Api.Lovelace

-- | Focus the Lovelace part in a value.
valueLovelaceL :: Lens' Api.Value Api.Lovelace
valueLovelaceL :: Lens' Value Lovelace
valueLovelaceL = CurrencySymbol -> TokenName -> Lens' Value Integer
forall mp.
ToMintingPolicyHash mp =>
mp -> TokenName -> Lens' Value Integer
valueAssetClassAmountL CurrencySymbol
Api.adaSymbol TokenName
Api.adaToken Lens' Value Integer
-> Optic An_Iso NoIx Integer Integer Lovelace Lovelace
-> Lens' Value Lovelace
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Iso' Lovelace Integer
-> Optic
     (ReversedOptic An_Iso) NoIx Integer Integer Lovelace Lovelace
forall (is :: IxList) s t a b.
AcceptsEmptyIndices "re" is =>
Optic An_Iso is s t a b -> Optic (ReversedOptic An_Iso) is b a t s
forall k (is :: IxList) s t a b.
(ReversibleOptic k, AcceptsEmptyIndices "re" is) =>
Optic k is s t a b -> Optic (ReversedOptic k) is b a t s
re Iso' Lovelace Integer
lovelaceIntegerI

-- | A prism to build a value from an asset class and amount, or retrieves the
-- amount from this asset class if it is not zero
valueAssetClassAmountP :: (Script.ToMintingPolicyHash mp) => mp -> Api.TokenName -> Prism' Api.Value Integer
valueAssetClassAmountP :: forall mp.
ToMintingPolicyHash mp =>
mp -> TokenName -> Prism' Value Integer
valueAssetClassAmountP (mp -> CurrencySymbol
forall script.
ToMintingPolicyHash script =>
script -> CurrencySymbol
Script.toCurrencySymbol -> CurrencySymbol
cs) TokenName
tk
  | AssetClass
ac <- CurrencySymbol -> TokenName -> AssetClass
Api.assetClass CurrencySymbol
cs TokenName
tk =
      (Integer -> Value)
-> (Value -> Either Value Integer) -> Prism' Value Integer
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
        ( \case
            Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> Value
forall a. Monoid a => a
mempty
            Integer
i -> AssetClass -> Integer -> Value
Api.assetClassValue AssetClass
ac Integer
i
        )
        ( \Value
val -> case Value
val Value -> AssetClass -> Integer
`Api.assetClassValueOf` AssetClass
ac of
            Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> Value -> Either Value Integer
forall a b. a -> Either a b
Left Value
val
            Integer
i -> Integer -> Either Value Integer
forall a b. b -> Either a b
Right Integer
i
        )

-- | An instance of 'valueAssetClassAmountP' for 'Api.Lovelace'
valueLovelaceP :: Prism' Api.Value Api.Lovelace
valueLovelaceP :: Prism' Value Lovelace
valueLovelaceP = CurrencySymbol -> TokenName -> Prism' Value Integer
forall mp.
ToMintingPolicyHash mp =>
mp -> TokenName -> Prism' Value Integer
valueAssetClassAmountP CurrencySymbol
Api.adaSymbol TokenName
Api.adaToken Prism' Value Integer
-> Optic An_Iso NoIx Integer Integer Lovelace Lovelace
-> Prism' Value Lovelace
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Iso' Lovelace Integer
-> Optic
     (ReversedOptic An_Iso) NoIx Integer Integer Lovelace Lovelace
forall (is :: IxList) s t a b.
AcceptsEmptyIndices "re" is =>
Optic An_Iso is s t a b -> Optic (ReversedOptic An_Iso) is b a t s
forall k (is :: IxList) s t a b.
(ReversibleOptic k, AcceptsEmptyIndices "re" is) =>
Optic k is s t a b -> Optic (ReversedOptic k) is b a t s
re Iso' Lovelace Integer
lovelaceIntegerI

instance Ord Api.Value where
  compare :: Value -> Value -> Ordering
compare Value
v1 Value
v2 = [(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, Map TokenName Integer)] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Map CurrencySymbol (Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)]
forall k v. Map k v -> [(k, v)]
PMap.toList (Map CurrencySymbol (Map TokenName Integer)
 -> [(CurrencySymbol, Map TokenName Integer)])
-> Map CurrencySymbol (Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)]
forall a b. (a -> b) -> a -> b
$ Value -> Map CurrencySymbol (Map TokenName Integer)
Api.getValue Value
v1) (Map CurrencySymbol (Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)]
forall k v. Map k v -> [(k, v)]
PMap.toList (Map CurrencySymbol (Map TokenName Integer)
 -> [(CurrencySymbol, Map TokenName Integer)])
-> Map CurrencySymbol (Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)]
forall a b. (a -> b) -> a -> b
$ Value -> Map CurrencySymbol (Map TokenName Integer)
Api.getValue Value
v2)