{-# OPTIONS_GHC -Wno-orphans #-}
module Plutarch.LedgerApi.V3.Tx (
PTxId (..),
PTxOutRef (..),
) where
import GHC.Generics (Generic)
import Plutarch.LedgerApi.Utils (Mret)
import Plutarch.Prelude
import Plutarch.Unsafe (punsafeCoerce)
import PlutusLedgerApi.V3 qualified as Plutus
newtype PTxId (s :: S) = PTxId (Term s (PDataNewtype PByteString))
deriving stock
(
(forall x. PTxId s -> Rep (PTxId s) x)
-> (forall x. Rep (PTxId s) x -> PTxId s) -> Generic (PTxId s)
forall x. Rep (PTxId s) x -> PTxId s
forall x. PTxId s -> Rep (PTxId s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PTxId s) x -> PTxId s
forall (s :: S) x. PTxId s -> Rep (PTxId s) x
$cfrom :: forall (s :: S) x. PTxId s -> Rep (PTxId s) x
from :: forall x. PTxId s -> Rep (PTxId s) x
$cto :: forall (s :: S) x. Rep (PTxId s) x -> PTxId s
to :: forall x. Rep (PTxId s) x -> PTxId s
Generic
)
deriving anyclass
(
(forall (s :: S). PTxId s -> Term s (PInner PTxId))
-> (forall (s :: S) (b :: PType).
Term s (PInner PTxId) -> (PTxId s -> Term s b) -> Term s b)
-> PlutusType PTxId
forall (s :: S). PTxId s -> Term s (PInner PTxId)
forall (s :: S) (b :: PType).
Term s (PInner PTxId) -> (PTxId s -> Term s b) -> Term s b
forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
$cpcon' :: forall (s :: S). PTxId s -> Term s (PInner PTxId)
pcon' :: forall (s :: S). PTxId s -> Term s (PInner PTxId)
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PTxId) -> (PTxId s -> Term s b) -> Term s b
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PTxId) -> (PTxId s -> Term s b) -> Term s b
PlutusType
,
(forall (s :: S). Term s (PAsData PTxId) -> Term s PTxId)
-> (forall (s :: S). Term s PTxId -> Term s PData) -> PIsData PTxId
forall (s :: S). Term s (PAsData PTxId) -> Term s PTxId
forall (s :: S). Term s PTxId -> Term s PData
forall (a :: PType).
(forall (s :: S). Term s (PAsData a) -> Term s a)
-> (forall (s :: S). Term s a -> Term s PData) -> PIsData a
$cpfromDataImpl :: forall (s :: S). Term s (PAsData PTxId) -> Term s PTxId
pfromDataImpl :: forall (s :: S). Term s (PAsData PTxId) -> Term s PTxId
$cpdataImpl :: forall (s :: S). Term s PTxId -> Term s PData
pdataImpl :: forall (s :: S). Term s PTxId -> Term s PData
PIsData
,
(forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PBool)
-> PEq PTxId
forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PBool
forall (t :: PType).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
$c#== :: forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PBool
#== :: forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PBool
PEq
,
PEq PTxId
PEq PTxId =>
(forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PBool)
-> (forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PBool)
-> (forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PTxId)
-> (forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PTxId)
-> POrd PTxId
forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PBool
forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PTxId
forall (t :: PType).
PEq t =>
(forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> (forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> (forall (s :: S). Term s t -> Term s t -> Term s t)
-> (forall (s :: S). Term s t -> Term s t -> Term s t)
-> POrd t
$c#<= :: forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PBool
#<= :: forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PBool
$c#< :: forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PBool
#< :: forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PBool
$cpmax :: forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PTxId
pmax :: forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PTxId
$cpmin :: forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PTxId
pmin :: forall (s :: S). Term s PTxId -> Term s PTxId -> Term s PTxId
POrd
,
(forall (s :: S). Bool -> Term s PTxId -> Term s PString)
-> PShow PTxId
forall (s :: S). Bool -> Term s PTxId -> Term s PString
forall (t :: PType).
(forall (s :: S). Bool -> Term s t -> Term s PString) -> PShow t
$cpshow' :: forall (s :: S). Bool -> Term s PTxId -> Term s PString
pshow' :: forall (s :: S). Bool -> Term s PTxId -> Term s PString
PShow
)
instance DerivePlutusType PTxId where
type DPTStrat _ = PlutusTypeNewtype
deriving via
DeriveDataPLiftable PTxId Plutus.TxId
instance
PLiftable PTxId
instance PTryFrom PData PTxId where
type PTryFromExcess PData PTxId = Mret PTxId
ptryFrom' :: forall (s :: S) (r :: PType).
Term s PData
-> ((Term s PTxId, Reduce (PTryFromExcess PData PTxId s))
-> Term s r)
-> Term s r
ptryFrom' Term s PData
opq = TermCont s (Term s PTxId, Reduce (PTryFromExcess PData PTxId s))
-> ((Term s PTxId, Reduce (PTryFromExcess PData PTxId s))
-> Term s r)
-> Term s r
forall (r :: PType) (s :: S) a.
TermCont s a -> (a -> Term s r) -> Term s r
runTermCont (TermCont s (Term s PTxId, Reduce (PTryFromExcess PData PTxId s))
-> ((Term s PTxId, Reduce (PTryFromExcess PData PTxId s))
-> Term s r)
-> Term s r)
-> TermCont s (Term s PTxId, Reduce (PTryFromExcess PData PTxId s))
-> ((Term s PTxId, Reduce (PTryFromExcess PData PTxId s))
-> Term s r)
-> Term s r
forall a b. (a -> b) -> a -> b
$ do
Term s PByteString
unwrapped <- ((Term s PByteString -> Term s r) -> Term s r)
-> TermCont s (Term s PByteString)
forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont s a
tcont (((Term s PByteString -> Term s r) -> Term s r)
-> TermCont s (Term s PByteString))
-> (Term s PByteString
-> (Term s PByteString -> Term s r) -> Term s r)
-> Term s PByteString
-> TermCont s (Term s PByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term s PByteString -> (Term s PByteString -> Term s r) -> Term s r
forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (Term s PByteString -> TermCont s (Term s PByteString))
-> Term s PByteString -> TermCont s (Term s PByteString)
forall a b. (a -> b) -> a -> b
$ forall (b :: PType) (a :: PType) (s :: S) (r :: PType).
PTryFrom a b =>
Term s a
-> ((Term s b, Reduce (PTryFromExcess a b s)) -> Term s r)
-> Term s r
ptryFrom @(PAsData PByteString) Term s PData
opq (Term s (PAsData PByteString), Term s PByteString)
-> Term s PByteString
(Term s (PAsData PByteString),
Reduce (PTryFromExcess PData (PAsData PByteString) s))
-> Term s PByteString
forall a b. (a, b) -> b
snd
((() -> Term s r) -> Term s r) -> TermCont s ()
forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont s a
tcont (((() -> Term s r) -> Term s r) -> TermCont s ())
-> ((() -> Term s r) -> Term s r) -> TermCont s ()
forall a b. (a -> b) -> a -> b
$ \() -> Term s r
f ->
Term s PBool -> Term s r -> Term s r -> Term s r
forall (a :: PType) (s :: S).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
(Term s (PByteString :--> PInteger)
forall (s :: S). Term s (PByteString :--> PInteger)
plengthBS Term s (PByteString :--> PInteger)
-> Term s PByteString -> Term s PInteger
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
unwrapped Term s PInteger -> Term s PInteger -> Term s PBool
forall (s :: S). Term s PInteger -> Term s PInteger -> Term s PBool
forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PInteger
32)
(() -> Term s r
f ())
(Term s PString -> Term s r
forall (a :: PType) (s :: S). Term s PString -> Term s a
ptraceInfoError Term s PString
"ptryFrom(PTxId): must be 32 bytes long")
(Term s PTxId, Term s PTxId)
-> TermCont s (Term s PTxId, Term s PTxId)
forall a. a -> TermCont s a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Term s PData -> Term s PTxId
forall (b :: PType) (a :: PType) (s :: S). Term s a -> Term s b
punsafeCoerce Term s PData
opq, PTxId s -> Term s PTxId
forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon (PTxId s -> Term s PTxId)
-> (Term s PByteString -> PTxId s)
-> Term s PByteString
-> Term s PTxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term s (PDataNewtype PByteString) -> PTxId s
forall (s :: S). Term s (PDataNewtype PByteString) -> PTxId s
PTxId (Term s (PDataNewtype PByteString) -> PTxId s)
-> (Term s PByteString -> Term s (PDataNewtype PByteString))
-> Term s PByteString
-> PTxId s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDataNewtype PByteString s -> Term s (PDataNewtype PByteString)
forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon (PDataNewtype PByteString s -> Term s (PDataNewtype PByteString))
-> (Term s PByteString -> PDataNewtype PByteString s)
-> Term s PByteString
-> Term s (PDataNewtype PByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term s (PAsData PByteString) -> PDataNewtype PByteString s
forall (a :: PType) (s :: S).
Term s (PAsData a) -> PDataNewtype a s
PDataNewtype (Term s (PAsData PByteString) -> PDataNewtype PByteString s)
-> (Term s PByteString -> Term s (PAsData PByteString))
-> Term s PByteString
-> PDataNewtype PByteString s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term s PByteString -> Term s (PAsData PByteString)
forall (a :: PType) (s :: S).
PIsData a =>
Term s a -> Term s (PAsData a)
pdata (Term s PByteString -> Term s PTxId)
-> Term s PByteString -> Term s PTxId
forall a b. (a -> b) -> a -> b
$ Term s PByteString
unwrapped)
instance PTryFrom PData (PAsData PTxId) where
type PTryFromExcess PData (PAsData PTxId) = Mret PTxId
ptryFrom' :: forall (s :: S) (r :: PType).
Term s PData
-> ((Term s (PAsData PTxId),
Reduce (PTryFromExcess PData (PAsData PTxId) s))
-> Term s r)
-> Term s r
ptryFrom' Term s PData
opq = TermCont
s
(Term s (PAsData PTxId),
Reduce (PTryFromExcess PData (PAsData PTxId) s))
-> ((Term s (PAsData PTxId),
Reduce (PTryFromExcess PData (PAsData PTxId) s))
-> Term s r)
-> Term s r
forall (r :: PType) (s :: S) a.
TermCont s a -> (a -> Term s r) -> Term s r
runTermCont (TermCont
s
(Term s (PAsData PTxId),
Reduce (PTryFromExcess PData (PAsData PTxId) s))
-> ((Term s (PAsData PTxId),
Reduce (PTryFromExcess PData (PAsData PTxId) s))
-> Term s r)
-> Term s r)
-> TermCont
s
(Term s (PAsData PTxId),
Reduce (PTryFromExcess PData (PAsData PTxId) s))
-> ((Term s (PAsData PTxId),
Reduce (PTryFromExcess PData (PAsData PTxId) s))
-> Term s r)
-> Term s r
forall a b. (a -> b) -> a -> b
$ do
Term s PByteString
unwrapped <- ((Term s PByteString -> Term s r) -> Term s r)
-> TermCont s (Term s PByteString)
forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont s a
tcont (((Term s PByteString -> Term s r) -> Term s r)
-> TermCont s (Term s PByteString))
-> (Term s PByteString
-> (Term s PByteString -> Term s r) -> Term s r)
-> Term s PByteString
-> TermCont s (Term s PByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term s PByteString -> (Term s PByteString -> Term s r) -> Term s r
forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (Term s PByteString -> TermCont s (Term s PByteString))
-> Term s PByteString -> TermCont s (Term s PByteString)
forall a b. (a -> b) -> a -> b
$ forall (b :: PType) (a :: PType) (s :: S) (r :: PType).
PTryFrom a b =>
Term s a
-> ((Term s b, Reduce (PTryFromExcess a b s)) -> Term s r)
-> Term s r
ptryFrom @(PAsData PByteString) Term s PData
opq (Term s (PAsData PByteString), Term s PByteString)
-> Term s PByteString
(Term s (PAsData PByteString),
Reduce (PTryFromExcess PData (PAsData PByteString) s))
-> Term s PByteString
forall a b. (a, b) -> b
snd
((() -> Term s r) -> Term s r) -> TermCont s ()
forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont s a
tcont (((() -> Term s r) -> Term s r) -> TermCont s ())
-> ((() -> Term s r) -> Term s r) -> TermCont s ()
forall a b. (a -> b) -> a -> b
$ \() -> Term s r
f ->
Term s PBool -> Term s r -> Term s r -> Term s r
forall (a :: PType) (s :: S).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
(Term s (PByteString :--> PInteger)
forall (s :: S). Term s (PByteString :--> PInteger)
plengthBS Term s (PByteString :--> PInteger)
-> Term s PByteString -> Term s PInteger
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
unwrapped Term s PInteger -> Term s PInteger -> Term s PBool
forall (s :: S). Term s PInteger -> Term s PInteger -> Term s PBool
forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PInteger
32)
(() -> Term s r
f ())
(Term s PString -> Term s r
forall (a :: PType) (s :: S). Term s PString -> Term s a
ptraceInfoError Term s PString
"ptryFrom(PTxId): must be 32 bytes long")
(Term s (PAsData PTxId), Term s PTxId)
-> TermCont s (Term s (PAsData PTxId), Term s PTxId)
forall a. a -> TermCont s a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Term s PData -> Term s (PAsData PTxId)
forall (b :: PType) (a :: PType) (s :: S). Term s a -> Term s b
punsafeCoerce Term s PData
opq, PTxId s -> Term s PTxId
forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon (PTxId s -> Term s PTxId)
-> (Term s PByteString -> PTxId s)
-> Term s PByteString
-> Term s PTxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term s (PDataNewtype PByteString) -> PTxId s
forall (s :: S). Term s (PDataNewtype PByteString) -> PTxId s
PTxId (Term s (PDataNewtype PByteString) -> PTxId s)
-> (Term s PByteString -> Term s (PDataNewtype PByteString))
-> Term s PByteString
-> PTxId s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDataNewtype PByteString s -> Term s (PDataNewtype PByteString)
forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon (PDataNewtype PByteString s -> Term s (PDataNewtype PByteString))
-> (Term s PByteString -> PDataNewtype PByteString s)
-> Term s PByteString
-> Term s (PDataNewtype PByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term s (PAsData PByteString) -> PDataNewtype PByteString s
forall (a :: PType) (s :: S).
Term s (PAsData a) -> PDataNewtype a s
PDataNewtype (Term s (PAsData PByteString) -> PDataNewtype PByteString s)
-> (Term s PByteString -> Term s (PAsData PByteString))
-> Term s PByteString
-> PDataNewtype PByteString s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term s PByteString -> Term s (PAsData PByteString)
forall (a :: PType) (s :: S).
PIsData a =>
Term s a -> Term s (PAsData a)
pdata (Term s PByteString -> Term s PTxId)
-> Term s PByteString -> Term s PTxId
forall a b. (a -> b) -> a -> b
$ Term s PByteString
unwrapped)
newtype PTxOutRef (s :: S)
= PTxOutRef
( Term
s
( PDataRecord
'[ "id" ':= PTxId
, "idx" ':= PInteger
]
)
)
deriving stock
(
(forall x. PTxOutRef s -> Rep (PTxOutRef s) x)
-> (forall x. Rep (PTxOutRef s) x -> PTxOutRef s)
-> Generic (PTxOutRef s)
forall x. Rep (PTxOutRef s) x -> PTxOutRef s
forall x. PTxOutRef s -> Rep (PTxOutRef s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PTxOutRef s) x -> PTxOutRef s
forall (s :: S) x. PTxOutRef s -> Rep (PTxOutRef s) x
$cfrom :: forall (s :: S) x. PTxOutRef s -> Rep (PTxOutRef s) x
from :: forall x. PTxOutRef s -> Rep (PTxOutRef s) x
$cto :: forall (s :: S) x. Rep (PTxOutRef s) x -> PTxOutRef s
to :: forall x. Rep (PTxOutRef s) x -> PTxOutRef s
Generic
)
deriving anyclass
(
(forall (s :: S). PTxOutRef s -> Term s (PInner PTxOutRef))
-> (forall (s :: S) (b :: PType).
Term s (PInner PTxOutRef) -> (PTxOutRef s -> Term s b) -> Term s b)
-> PlutusType PTxOutRef
forall (s :: S). PTxOutRef s -> Term s (PInner PTxOutRef)
forall (s :: S) (b :: PType).
Term s (PInner PTxOutRef) -> (PTxOutRef s -> Term s b) -> Term s b
forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
$cpcon' :: forall (s :: S). PTxOutRef s -> Term s (PInner PTxOutRef)
pcon' :: forall (s :: S). PTxOutRef s -> Term s (PInner PTxOutRef)
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PTxOutRef) -> (PTxOutRef s -> Term s b) -> Term s b
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PTxOutRef) -> (PTxOutRef s -> Term s b) -> Term s b
PlutusType
,
(forall (s :: S). Term s (PAsData PTxOutRef) -> Term s PTxOutRef)
-> (forall (s :: S). Term s PTxOutRef -> Term s PData)
-> PIsData PTxOutRef
forall (s :: S). Term s (PAsData PTxOutRef) -> Term s PTxOutRef
forall (s :: S). Term s PTxOutRef -> Term s PData
forall (a :: PType).
(forall (s :: S). Term s (PAsData a) -> Term s a)
-> (forall (s :: S). Term s a -> Term s PData) -> PIsData a
$cpfromDataImpl :: forall (s :: S). Term s (PAsData PTxOutRef) -> Term s PTxOutRef
pfromDataImpl :: forall (s :: S). Term s (PAsData PTxOutRef) -> Term s PTxOutRef
$cpdataImpl :: forall (s :: S). Term s PTxOutRef -> Term s PData
pdataImpl :: forall (s :: S). Term s PTxOutRef -> Term s PData
PIsData
,
(forall (s :: S).
Term s PTxOutRef -> Term s (PDataRecord (PFields PTxOutRef)))
-> PDataFields PTxOutRef
forall (s :: S).
Term s PTxOutRef -> Term s (PDataRecord (PFields PTxOutRef))
forall (a :: PType).
(forall (s :: S). Term s a -> Term s (PDataRecord (PFields a)))
-> PDataFields a
$cptoFields :: forall (s :: S).
Term s PTxOutRef -> Term s (PDataRecord (PFields PTxOutRef))
ptoFields :: forall (s :: S).
Term s PTxOutRef -> Term s (PDataRecord (PFields PTxOutRef))
PDataFields
,
(forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PBool)
-> PEq PTxOutRef
forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PBool
forall (t :: PType).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
$c#== :: forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PBool
#== :: forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PBool
PEq
,
PEq PTxOutRef
PEq PTxOutRef =>
(forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PBool)
-> (forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PBool)
-> (forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PTxOutRef)
-> (forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PTxOutRef)
-> POrd PTxOutRef
forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PBool
forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PTxOutRef
forall (t :: PType).
PEq t =>
(forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> (forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> (forall (s :: S). Term s t -> Term s t -> Term s t)
-> (forall (s :: S). Term s t -> Term s t -> Term s t)
-> POrd t
$c#<= :: forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PBool
#<= :: forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PBool
$c#< :: forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PBool
#< :: forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PBool
$cpmax :: forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PTxOutRef
pmax :: forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PTxOutRef
$cpmin :: forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PTxOutRef
pmin :: forall (s :: S).
Term s PTxOutRef -> Term s PTxOutRef -> Term s PTxOutRef
POrd
,
PTryFrom PData
,
(forall (s :: S). Bool -> Term s PTxOutRef -> Term s PString)
-> PShow PTxOutRef
forall (s :: S). Bool -> Term s PTxOutRef -> Term s PString
forall (t :: PType).
(forall (s :: S). Bool -> Term s t -> Term s PString) -> PShow t
$cpshow' :: forall (s :: S). Bool -> Term s PTxOutRef -> Term s PString
pshow' :: forall (s :: S). Bool -> Term s PTxOutRef -> Term s PString
PShow
)
instance DerivePlutusType PTxOutRef where
type DPTStrat _ = PlutusTypeData
deriving via
DeriveDataPLiftable PTxOutRef Plutus.TxOutRef
instance
PLiftable PTxOutRef
instance PTryFrom PData (PAsData PTxOutRef)