{- | Plutarch utilities

@since 1.0.0
-}
module Agora.Utils (
  psymbolValueOf,
  pcountIf,
  pcurrencySymbolToScriptHash,
  pscriptHashToCurrencySymbol,
) where

import Data.Kind (Type)
import Plutarch.Internal.Term (punsafeCoerce)
import Plutarch.LedgerApi.AssocMap qualified as AssocMap
import Plutarch.LedgerApi.V3 (AmountGuarantees, KeyGuarantees, PCurrencySymbol, PMap (PMap), PScriptHash, PValue (PValue))
import Plutarch.Monadic qualified as P
import Plutarch.Prelude (
  PAsData,
  PBool,
  PInteger,
  PIsListLike,
  PMaybe (PJust, PNothing),
  S,
  Term,
  pfoldr,
  pfromData,
  phoistAcyclic,
  pif,
  plam,
  pmatch,
  precList,
  psndBuiltin,
  (#),
  (:-->),
 )

{- | Get the sum of all values belonging to a particular CurrencySymbol.

@since 1.0.0
-}
psymbolValueOf ::
  forall (keys :: KeyGuarantees) (amounts :: AmountGuarantees) (s :: S).
  Term s (PCurrencySymbol :--> PValue keys amounts :--> PInteger)
psymbolValueOf :: forall (keys :: KeyGuarantees) (amounts :: AmountGuarantees)
       (s :: S).
Term s (PCurrencySymbol :--> (PValue keys amounts :--> PInteger))
psymbolValueOf =
  ClosedTerm
  (PCurrencySymbol :--> (PValue keys amounts :--> PInteger))
-> Term
     s (PCurrencySymbol :--> (PValue keys amounts :--> PInteger))
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic (ClosedTerm
   (PCurrencySymbol :--> (PValue keys amounts :--> PInteger))
 -> Term
      s (PCurrencySymbol :--> (PValue keys amounts :--> PInteger)))
-> ClosedTerm
     (PCurrencySymbol :--> (PValue keys amounts :--> PInteger))
-> Term
     s (PCurrencySymbol :--> (PValue keys amounts :--> PInteger))
forall a b. (a -> b) -> a -> b
$
    (Term s PCurrencySymbol
 -> Term s (PValue keys amounts) -> Term s PInteger)
-> Term
     s (PCurrencySymbol :--> (PValue keys amounts :--> PInteger))
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s (PValue keys amounts) -> Term s PInteger)
-> Term s (c :--> (PValue keys amounts :--> PInteger))
plam ((Term s PCurrencySymbol
  -> Term s (PValue keys amounts) -> Term s PInteger)
 -> Term
      s (PCurrencySymbol :--> (PValue keys amounts :--> PInteger)))
-> (Term s PCurrencySymbol
    -> Term s (PValue keys amounts) -> Term s PInteger)
-> Term
     s (PCurrencySymbol :--> (PValue keys amounts :--> PInteger))
forall a b. (a -> b) -> a -> b
$ \Term s PCurrencySymbol
sym Term s (PValue keys amounts)
value' -> P.do
      PValue Term s (PMap keys PCurrencySymbol (PMap keys PTokenName PInteger))
value <- Term s (PValue keys amounts)
-> (PValue keys amounts s -> Term s PInteger) -> Term s PInteger
forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s (PValue keys amounts)
value'
      Term s (PMaybe (PMap keys PTokenName PInteger))
-> (PMaybe (PMap keys PTokenName PInteger) s -> Term s PInteger)
-> Term s PInteger
forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch (Term
  s
  (PCurrencySymbol
   :--> (PMap keys PCurrencySymbol (PMap keys PTokenName PInteger)
         :--> PMaybe (PMap keys PTokenName PInteger)))
forall (k :: PType) (v :: PType) (any :: KeyGuarantees) (s :: S).
(PIsData k, PIsData v) =>
Term s (k :--> (PMap any k v :--> PMaybe v))
AssocMap.plookup Term
  s
  (PCurrencySymbol
   :--> (PMap keys PCurrencySymbol (PMap keys PTokenName PInteger)
         :--> PMaybe (PMap keys PTokenName PInteger)))
-> Term s PCurrencySymbol
-> Term
     s
     (PMap keys PCurrencySymbol (PMap keys PTokenName PInteger)
      :--> PMaybe (PMap keys PTokenName PInteger))
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PCurrencySymbol
sym Term
  s
  (PMap keys PCurrencySymbol (PMap keys PTokenName PInteger)
   :--> PMaybe (PMap keys PTokenName PInteger))
-> Term
     s (PMap keys PCurrencySymbol (PMap keys PTokenName PInteger))
-> Term s (PMaybe (PMap keys PTokenName PInteger))
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PMap keys PCurrencySymbol (PMap keys PTokenName PInteger))
value) ((PMaybe (PMap keys PTokenName PInteger) s -> Term s PInteger)
 -> Term s PInteger)
-> (PMaybe (PMap keys PTokenName PInteger) s -> Term s PInteger)
-> Term s PInteger
forall a b. (a -> b) -> a -> b
$ \case
        PJust Term s (PMap keys PTokenName PInteger)
m' ->
          Term s (PMap keys PTokenName PInteger)
-> (PMap keys PTokenName PInteger s -> Term s PInteger)
-> Term s PInteger
forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s (PMap keys PTokenName PInteger)
m' ((PMap keys PTokenName PInteger s -> Term s PInteger)
 -> Term s PInteger)
-> (PMap keys PTokenName PInteger s -> Term s PInteger)
-> Term s PInteger
forall a b. (a -> b) -> a -> b
$ \case
            PMap Term
  s
  (PBuiltinList
     (PBuiltinPair (PAsData PTokenName) (PAsData PInteger)))
m -> Term
  s
  ((PBuiltinPair (PAsData PTokenName) (PAsData PInteger)
    :--> (PInteger :--> PInteger))
   :--> (PInteger
         :--> (PBuiltinList
                 (PBuiltinPair (PAsData PTokenName) (PAsData PInteger))
               :--> PInteger)))
forall (list :: PType -> PType) (a :: PType) (s :: S) (b :: PType).
PIsListLike list a =>
Term s ((a :--> (b :--> b)) :--> (b :--> (list a :--> b)))
pfoldr Term
  s
  ((PBuiltinPair (PAsData PTokenName) (PAsData PInteger)
    :--> (PInteger :--> PInteger))
   :--> (PInteger
         :--> (PBuiltinList
                 (PBuiltinPair (PAsData PTokenName) (PAsData PInteger))
               :--> PInteger)))
-> Term
     s
     (PBuiltinPair (PAsData PTokenName) (PAsData PInteger)
      :--> (PInteger :--> PInteger))
-> Term
     s
     (PInteger
      :--> (PBuiltinList
              (PBuiltinPair (PAsData PTokenName) (PAsData PInteger))
            :--> PInteger))
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# (Term s (PBuiltinPair (PAsData PTokenName) (PAsData PInteger))
 -> Term s PInteger -> Term s PInteger)
-> Term
     s
     (PBuiltinPair (PAsData PTokenName) (PAsData PInteger)
      :--> (PInteger :--> PInteger))
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PInteger -> Term s PInteger)
-> Term s (c :--> (PInteger :--> PInteger))
plam (\Term s (PBuiltinPair (PAsData PTokenName) (PAsData PInteger))
x Term s PInteger
v -> Term s (PAsData PInteger) -> Term s PInteger
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData (Term
  s
  (PBuiltinPair (PAsData PTokenName) (PAsData PInteger)
   :--> PAsData PInteger)
forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> b)
psndBuiltin Term
  s
  (PBuiltinPair (PAsData PTokenName) (PAsData PInteger)
   :--> PAsData PInteger)
-> Term s (PBuiltinPair (PAsData PTokenName) (PAsData PInteger))
-> Term s (PAsData PInteger)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinPair (PAsData PTokenName) (PAsData PInteger))
x) Term s PInteger -> Term s PInteger -> Term s PInteger
forall a. Num a => a -> a -> a
+ Term s PInteger
v) Term
  s
  (PInteger
   :--> (PBuiltinList
           (PBuiltinPair (PAsData PTokenName) (PAsData PInteger))
         :--> PInteger))
-> Term s PInteger
-> Term
     s
     (PBuiltinList
        (PBuiltinPair (PAsData PTokenName) (PAsData PInteger))
      :--> PInteger)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
0 Term
  s
  (PBuiltinList
     (PBuiltinPair (PAsData PTokenName) (PAsData PInteger))
   :--> PInteger)
-> Term
     s
     (PBuiltinList
        (PBuiltinPair (PAsData PTokenName) (PAsData PInteger)))
-> Term s PInteger
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term
  s
  (PBuiltinList
     (PBuiltinPair (PAsData PTokenName) (PAsData PInteger)))
m
        PMaybe (PMap keys PTokenName PInteger) s
PNothing -> Term s PInteger
0

{- | Fused filter and length function for Plutarch lists

@since 1.0.0
-}
pcountIf ::
  forall (list :: (S -> Type) -> (S -> Type)) (a :: S -> Type) (s :: S).
  (PIsListLike list a) =>
  Term s ((a :--> PBool) :--> list a :--> PInteger)
pcountIf :: forall (list :: PType -> PType) (a :: PType) (s :: S).
PIsListLike list a =>
Term s ((a :--> PBool) :--> (list a :--> PInteger))
pcountIf =
  ClosedTerm ((a :--> PBool) :--> (list a :--> PInteger))
-> Term s ((a :--> PBool) :--> (list a :--> PInteger))
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic (ClosedTerm ((a :--> PBool) :--> (list a :--> PInteger))
 -> Term s ((a :--> PBool) :--> (list a :--> PInteger)))
-> ClosedTerm ((a :--> PBool) :--> (list a :--> PInteger))
-> Term s ((a :--> PBool) :--> (list a :--> PInteger))
forall a b. (a -> b) -> a -> b
$
    (Term s (a :--> PBool) -> Term s (list a :--> PInteger))
-> Term s ((a :--> PBool) :--> (list a :--> PInteger))
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s (list a :--> PInteger))
-> Term s (c :--> (list a :--> PInteger))
plam ((Term s (a :--> PBool) -> Term s (list a :--> PInteger))
 -> Term s ((a :--> PBool) :--> (list a :--> PInteger)))
-> (Term s (a :--> PBool) -> Term s (list a :--> PInteger))
-> Term s ((a :--> PBool) :--> (list a :--> PInteger))
forall a b. (a -> b) -> a -> b
$ \Term s (a :--> PBool)
predicate ->
      (Term s (list a :--> PInteger)
 -> Term s a -> Term s (list a) -> Term s PInteger)
-> (Term s (list a :--> PInteger) -> Term s PInteger)
-> Term s (list a :--> PInteger)
forall (list :: PType -> PType) (a :: PType) (s :: S) (r :: PType).
PIsListLike list a =>
(Term s (list a :--> r) -> Term s a -> Term s (list a) -> Term s r)
-> (Term s (list a :--> r) -> Term s r) -> Term s (list a :--> r)
precList
        ( \Term s (list a :--> PInteger)
self Term s a
x Term s (list a)
xs ->
            Term s PBool
-> Term s PInteger -> Term s PInteger -> Term s PInteger
forall (a :: PType) (s :: S).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
              (Term s (a :--> PBool)
predicate Term s (a :--> PBool) -> Term s a -> Term s PBool
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s a
x)
              (Term s PInteger
1 Term s PInteger -> Term s PInteger -> Term s PInteger
forall a. Num a => a -> a -> a
+ (Term s (list a :--> PInteger)
self Term s (list a :--> PInteger) -> Term s (list a) -> Term s PInteger
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (list a)
xs))
              (Term s (list a :--> PInteger)
self Term s (list a :--> PInteger) -> Term s (list a) -> Term s PInteger
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (list a)
xs)
        )
        (Term s PInteger -> Term s (list a :--> PInteger) -> Term s PInteger
forall a b. a -> b -> a
const Term s PInteger
0)

{- | Extract PScriptHash of PCurrencySymbol

@since 1.0.0
-}
pcurrencySymbolToScriptHash ::
  forall (s :: S).
  Term s (PAsData PCurrencySymbol) ->
  Term s (PAsData PScriptHash)
pcurrencySymbolToScriptHash :: forall (s :: S).
Term s (PAsData PCurrencySymbol) -> Term s (PAsData PScriptHash)
pcurrencySymbolToScriptHash = Term s (PAsData PCurrencySymbol) -> Term s (PAsData PScriptHash)
forall (b :: PType) (a :: PType) (s :: S). Term s a -> Term s b
punsafeCoerce

{- | Convert a PScriptHash to PCurrencySymbol

@since 1.0.0
-}
pscriptHashToCurrencySymbol ::
  forall (s :: S).
  Term s (PAsData PScriptHash) ->
  Term s (PAsData PCurrencySymbol)
pscriptHashToCurrencySymbol :: forall (s :: S).
Term s (PAsData PScriptHash) -> Term s (PAsData PCurrencySymbol)
pscriptHashToCurrencySymbol = Term s (PAsData PScriptHash) -> Term s (PAsData PCurrencySymbol)
forall (b :: PType) (a :: PType) (s :: S). Term s a -> Term s b
punsafeCoerce