Skip to content

Commit

Permalink
Rework PLift, add type role to Term, and remove bogus derivations
Browse files Browse the repository at this point in the history
  • Loading branch information
@L-as
L-as committed Jan 17, 2022
1 parent e986557 commit f87b4fa
Show file tree
Hide file tree
Showing 11 changed files with 182 additions and 138 deletions.
108 changes: 63 additions & 45 deletions Plutarch/Api/V1.hs
View file
@@ -1,4 +1,5 @@
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Plutarch.Api.V1 (
-- * V1 Specific types
Expand Down Expand Up @@ -60,7 +61,7 @@ module Plutarch.Api.V1 (
--------------------------------------------------------------------------------

import Plutarch (PMatch)
import Plutarch.Bool (PBool, PEq, POrd)
import Plutarch.Bool (PBool)
import Plutarch.Builtin (PAsData, PBuiltinList, PData, PIsData, type PBuiltinMap)
import Plutarch.ByteString (PByteString)
import Plutarch.DataRepr (
Expand All @@ -73,12 +74,12 @@ import Plutarch.DataRepr (
pmatchRepr,
)
import Plutarch.Integer (PInteger, PIntegral)
import Plutarch.Lift (PLifted, PUnsafeLiftDecl)
import Plutarch.Lift (DerivePConstantViaData (DerivePConstantViaData), DerivePConstantViaNewtype (DerivePConstantViaNewtype), PConstant, PLifted, PUnsafeLiftDecl)

-- ctor in-scope for deriving
import Plutarch.Prelude
import qualified Plutus.V1.Ledger.Api as Plutus
import qualified PlutusTx.Prelude as PlutusTx
import qualified PlutusTx.Builtins.Internal as PT

--------------------------------------------------------------------------------

Expand All @@ -105,8 +106,11 @@ newtype PTxInfo (s :: S)
)
)
deriving
(PMatch, PIsData, PUnsafeLiftDecl Plutus.TxInfo)
via PIsDataReprInstances PTxInfo Plutus.TxInfo
(PMatch, PIsData)
via PIsDataReprInstances PTxInfo

instance PUnsafeLiftDecl PTxInfo where type PLifted PTxInfo = Plutus.TxInfo
deriving via (DerivePConstantViaData Plutus.TxInfo PTxInfo) instance (PConstant Plutus.TxInfo)

instance PIsDataRepr PTxInfo where
type
Expand All @@ -129,8 +133,11 @@ instance PIsDataRepr PTxInfo where
newtype PScriptContext (s :: S)
= PScriptContext (Term s (PDataList '[PTxInfo, PScriptPurpose]))
deriving
(PMatch, PIsData, PUnsafeLiftDecl Plutus.ScriptContext)
via PIsDataReprInstances PScriptContext Plutus.ScriptContext
(PMatch, PIsData)
via PIsDataReprInstances PScriptContext

instance PUnsafeLiftDecl PScriptContext where type PLifted PScriptContext = Plutus.ScriptContext
deriving via (DerivePConstantViaData Plutus.ScriptContext PScriptContext) instance (PConstant Plutus.ScriptContext)

instance PIsDataRepr PScriptContext where
type
Expand All @@ -150,8 +157,11 @@ data PScriptPurpose (s :: S)
| PRewarding (Term s (PDataList '[PStakingCredential]))
| PCertifying (Term s (PDataList '[PDCert]))
deriving
(PMatch, PIsData, PUnsafeLiftDecl Plutus.ScriptPurpose)
via (PIsDataReprInstances PScriptPurpose Plutus.ScriptPurpose)
(PMatch, PIsData)
via (PIsDataReprInstances PScriptPurpose)

instance PUnsafeLiftDecl PScriptPurpose where type PLifted PScriptPurpose = Plutus.ScriptPurpose
deriving via (DerivePConstantViaData Plutus.ScriptPurpose PScriptPurpose) instance (PConstant Plutus.ScriptPurpose)

instance PIsDataRepr PScriptPurpose where
type
Expand All @@ -174,61 +184,59 @@ instance PIsDataRepr PScriptPurpose where
---------- Scripts

newtype PDatum (s :: S) = PDatum (Term s PData)
deriving (PIsData, PEq) via PData

newtype PRedeemer (s :: S) = PRedeemer (Term s PData)
deriving (PIsData, PEq) via PData

newtype PDatumHash (s :: S)
= PDatumHash (Term s PByteString)
deriving (PEq, POrd, PIsData) via PByteString

newtype PStakeValidatorHash (s :: S)
= PStakeValidatorHash (Term s PByteString)
deriving (PEq, POrd, PIsData) via PByteString

newtype PRedeemerHash (s :: S)
= PRedeemerHash (Term s PByteString)
deriving (PEq, POrd, PIsData) via PByteString

newtype PValidatorHash (s :: S)
= PValidatorHash (Term s PByteString)
deriving (PEq, POrd, PIsData) via PByteString

---------- Value

newtype PTokenName (s :: S)
= PTokenName (Term s PByteString)
deriving (PEq, POrd, PIsData) via (PByteString)
deriving newtype (Semigroup, Monoid)
instance PUnsafeLiftDecl PTokenName where type PLifted PTokenName = Plutus.TokenName
deriving via
(DerivePConstantViaNewtype Plutus.TokenName PTokenName PByteString)
instance
(PConstant Plutus.TokenName)

newtype PValue (s :: S)
= PValue (Term s (PMap PCurrencySymbol (PMap PTokenName PInteger)))
deriving (PIsData) via (PMap PCurrencySymbol (PMap PTokenName PInteger))

newtype PCurrencySymbol (s :: S)
= PCurrencySymbol (Term s PByteString)
deriving (PEq, POrd, PIsData) via PByteString
instance PUnsafeLiftDecl PCurrencySymbol where type PLifted PCurrencySymbol = Plutus.CurrencySymbol
deriving via
(DerivePConstantViaNewtype Plutus.CurrencySymbol PCurrencySymbol PByteString)
instance
(PConstant Plutus.CurrencySymbol)

---------- Crypto

newtype PPubKeyHash (s :: S)
= PPubKeyHash (Term s PByteString)
deriving (PEq, POrd, PIsData) via PByteString

newtype PPubKey (s :: S)
= PPubKey (Term s PByteString)
deriving (PEq, POrd, PIsData) via PByteString

newtype PSignature (s :: S)
= PSignature (Term s PByteString)
deriving (PEq, POrd, PIsData) via PByteString

---------- Time

newtype PPOSIXTime (s :: S)
= PPOSIXTime (Term s PInteger)
deriving (POrd, PEq, PIntegral, PIsData) via (PInteger)
deriving (PIntegral) via (PInteger)
deriving newtype (Num)

type PPOSIXTimeRange = PInterval PPOSIXTime
Expand All @@ -253,7 +261,6 @@ newtype PInterval a (s :: S)
)
via PIsDataReprInstances
(PInterval a)
(Plutus.Interval (PLifted a))

instance PIsDataRepr (PInterval a) where
type
Expand All @@ -275,7 +282,6 @@ newtype PLowerBound a (s :: S)
)
via ( PIsDataReprInstances
(PLowerBound a)
(Plutus.LowerBound (PLifted a))
)

instance PIsDataRepr (PLowerBound a) where
Expand All @@ -298,7 +304,6 @@ newtype PUpperBound a (s :: S)
)
via ( PIsDataReprInstances
(PUpperBound a)
(Plutus.UpperBound (PLifted a))
)

instance PIsDataRepr (PUpperBound a) where
Expand All @@ -322,7 +327,6 @@ data PExtended a (s :: S)
)
via ( PIsDataReprInstances
(PExtended a)
(Plutus.Extended (PLifted a))
)

instance PIsDataRepr (PExtended a) where
Expand All @@ -339,8 +343,11 @@ data PCredential (s :: S)
= PPubKeyCredential (Term s (PDataList '[PPubKeyHash]))
| PScriptCredential (Term s (PDataList '[PValidatorHash]))
deriving
(PMatch, PIsData, PUnsafeLiftDecl Plutus.Credential)
via (PIsDataReprInstances PCredential Plutus.Credential)
(PMatch, PIsData)
via (PIsDataReprInstances PCredential)

instance PUnsafeLiftDecl PDatum where type PLifted PDatum = Plutus.Datum
deriving via (DerivePConstantViaData Plutus.Datum PDatum) instance (PConstant Plutus.Datum)

instance PIsDataRepr PCredential where
type
Expand All @@ -362,9 +369,8 @@ data PStakingCredential (s :: S)
deriving
( PMatch
, PIsData
, PUnsafeLiftDecl Plutus.StakingCredential
)
via PIsDataReprInstances PStakingCredential Plutus.StakingCredential
via PIsDataReprInstances PStakingCredential

instance PIsDataRepr PStakingCredential where
type
Expand All @@ -388,8 +394,11 @@ newtype PAddress (s :: S)
)
)
deriving
(PMatch, PIsData, PUnsafeLiftDecl Plutus.Address)
via PIsDataReprInstances PAddress Plutus.Address
(PMatch, PIsData)
via PIsDataReprInstances PAddress

instance PUnsafeLiftDecl PRedeemer where type PLifted PRedeemer = Plutus.Redeemer
deriving via (DerivePConstantViaData Plutus.Redeemer PRedeemer) instance (PConstant Plutus.Redeemer)

instance PIsDataRepr PAddress where
type
Expand All @@ -408,8 +417,11 @@ instance PIsDataRepr PAddress where
newtype PTxId (s :: S)
= PTxId (Term s (PDataList '[PByteString]))
deriving
(PMatch, PIsData, PUnsafeLiftDecl Plutus.TxId)
via PIsDataReprInstances PTxId Plutus.TxId
(PMatch, PIsData)
via PIsDataReprInstances PTxId

instance PUnsafeLiftDecl PDatumHash where type PLifted PDatumHash = Plutus.DatumHash
deriving via (DerivePConstantViaData Plutus.DatumHash PDatumHash) instance (PConstant Plutus.DatumHash)

instance PIsDataRepr PTxId where
type PIsDataReprRepr PTxId = '[ '[PByteString]]
Expand All @@ -421,8 +433,11 @@ instance PIsDataRepr PTxId where
newtype PTxOutRef (s :: S)
= PTxOutRef (Term s (PDataList '[PTxId, PInteger]))
deriving
(PMatch, PIsData, PUnsafeLiftDecl Plutus.TxOutRef)
via PIsDataReprInstances PTxOutRef Plutus.TxOutRef
(PMatch, PIsData)
via PIsDataReprInstances PTxOutRef

instance PUnsafeLiftDecl PStakeValidatorHash where type PLifted PStakeValidatorHash = Plutus.StakeValidatorHash
deriving via (DerivePConstantViaData Plutus.StakeValidatorHash PStakeValidatorHash) instance (PConstant Plutus.StakeValidatorHash)

instance PIsDataRepr PTxOutRef where
type PIsDataReprRepr PTxOutRef = '[ '[PTxId, PInteger]]
Expand All @@ -434,8 +449,11 @@ instance PIsDataRepr PTxOutRef where
newtype PTxInInfo (s :: S)
= PTxInInfo (Term s (PDataList '[PTxOutRef, PTxOut]))
deriving
(PMatch, PIsData, PUnsafeLiftDecl Plutus.TxInfo)
via PIsDataReprInstances PTxInInfo Plutus.TxInfo
(PMatch, PIsData)
via PIsDataReprInstances PTxInInfo

instance PUnsafeLiftDecl PRedeemerHash where type PLifted PRedeemerHash = Plutus.RedeemerHash
deriving via (DerivePConstantViaData Plutus.RedeemerHash PRedeemerHash) instance (PConstant Plutus.RedeemerHash)

instance PIsDataRepr PTxInInfo where
type PIsDataReprRepr PTxInInfo = '[ '[PTxOutRef, PTxOut]]
Expand All @@ -456,8 +474,11 @@ newtype PTxOut (s :: S)
)
)
deriving
(PMatch, PIsData, PUnsafeLiftDecl Plutus.TxOut)
via (PIsDataReprInstances PTxOut Plutus.TxOut)
(PMatch, PIsData)
via (PIsDataReprInstances PTxOut)

instance PUnsafeLiftDecl PValidatorHash where type PLifted PValidatorHash = Plutus.ValidatorHash
deriving via (DerivePConstantViaData Plutus.ValidatorHash PValidatorHash) instance (PConstant Plutus.ValidatorHash)

instance PIsDataRepr PTxOut where
type
Expand All @@ -481,8 +502,8 @@ data PDCert (s :: S)
| PDCertGenesis (Term s (PDataList '[]))
| PDCertMir (Term s (PDataList '[]))
deriving
(PMatch, PIsData, PUnsafeLiftDecl Plutus.DCert)
via (PIsDataReprInstances PDCert Plutus.DCert)
(PMatch, PIsData)
via (PIsDataReprInstances PDCert)

instance PIsDataRepr PDCert where
type
Expand Down Expand Up @@ -510,7 +531,6 @@ instance PIsDataRepr PDCert where

newtype PMap (a :: PType) (b :: PType) (s :: S)
= PMap (Term s (PBuiltinMap a b))
deriving (PIsData) via (PBuiltinMap a b)

---------- Others

Expand All @@ -521,7 +541,6 @@ data PMaybe a (s :: S)
(PMatch, PIsData)
via PIsDataReprInstances
(PMaybe a)
(PlutusTx.Maybe (PLifted a))

instance PIsDataRepr (PMaybe a) where
type PIsDataReprRepr (PMaybe a) = '[ '[], '[a]]
Expand All @@ -540,7 +559,6 @@ data PEither a b (s :: S)
)
via PIsDataReprInstances
(PEither a b)
(PlutusTx.Either (PLifted a) (PLifted b))

instance PIsDataRepr (PEither a b) where
type
Expand Down
7 changes: 4 additions & 3 deletions Plutarch/Bool.hs
View file
@@ -1,4 +1,5 @@
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Plutarch.Bool (
PBool (..),
Expand All @@ -16,15 +17,15 @@ module Plutarch.Bool (
) where

import Plutarch (PlutusType (PInner, pcon', pmatch'), punsafeBuiltin)
import Plutarch.Lift (DerivePConstant, DerivePLiftViaCoercible, PConstant, PConstanted, PLifted, PLiftedRepr, PUnsafeLiftDecl, pconstant, pliftFromRepr, pliftToRepr)
import Plutarch.Lift (DerivePConstantViaCoercible (DerivePConstantViaCoercible), PConstant, PLifted, PUnsafeLiftDecl, pconstant)
import Plutarch.Prelude
import qualified PlutusCore as PLC

-- | Plutus 'BuiltinBool'
data PBool (s :: S) = PTrue | PFalse
deriving (PUnsafeLiftDecl) via (DerivePLiftViaCoercible Bool PBool Bool)

deriving via (DerivePConstant Bool) PBool instance (PConstant Bool)
instance PUnsafeLiftDecl PBool where type PLifted PBool = Bool
deriving via (DerivePConstantViaCoercible Bool PBool Bool) instance (PConstant Bool)

instance PlutusType PBool where
type PInner PBool _ = PBool
Expand Down

0 comments on commit f87b4fa

Please sign in to comment.