mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-20 01:07:18 +03:00
Make AnyChoice and AnyContractKey take template type into account (#3541)
* Make AnyChoice and AnyContractKey take template type into account fixes #3540 * Update template desugaring * Switch to proper ghc-lib release
This commit is contained in:
parent
917c43a048
commit
1bc4bb76a4
@ -520,12 +520,12 @@ HASKELL_LSP_HASH = "80a3944306fb455fce36f7b3aafb8f0f8f6096a0bd3c46ed25cc0ff288d6
|
||||
|
||||
GRPC_HASKELL_CORE_VERSION = "0.0.0.0"
|
||||
|
||||
GHC_LIB_VERSION = "8.8.1.20191111"
|
||||
GHC_LIB_VERSION = "8.8.1.20191120"
|
||||
|
||||
http_archive(
|
||||
name = "haskell_ghc__lib__parser",
|
||||
build_file = "//3rdparty/haskell:BUILD.ghc-lib-parser",
|
||||
sha256 = "2b406c537667e7a802aa1551a9c2b697b47d1b40e3d8d99f9d0711209a6636fd",
|
||||
sha256 = "89e5e8eadd66a90970b866a0669da28b1cd4fff2511a2dc09151a5b269bc0bc1",
|
||||
strip_prefix = "ghc-lib-parser-{}".format(GHC_LIB_VERSION),
|
||||
urls = ["https://digitalassetsdk.bintray.com/ghc-lib/ghc-lib-parser-{}.tar.gz".format(GHC_LIB_VERSION)],
|
||||
)
|
||||
@ -598,7 +598,7 @@ hazel_repositories(
|
||||
|
||||
# Read [Working on ghc-lib] for ghc-lib update instructions at
|
||||
# https://github.com/digital-asset/daml/blob/master/ghc-lib/working-on-ghc-lib.md.
|
||||
hazel_ghclibs(GHC_LIB_VERSION, "0000000000000000000000000000000000000000000000000000000000000000", "89378f66a8283ddb785538e6d94c1a282d27fa2f3658b537ea5d3cee2efa786e") +
|
||||
hazel_ghclibs(GHC_LIB_VERSION, "0000000000000000000000000000000000000000000000000000000000000000", "2433176141caffd066313876ef756e2fcb34dc96a809d40eec753a4248ba016e") +
|
||||
hazel_github_external("digital-asset", "hlint", "951fdb6d28d7eed8ea1c7f3be69da29b61fcbe8f", "f5fb4cf98cde3ecf1209857208369a63ba21b04313d570c41dffe9f9139a1d34") +
|
||||
# Not in stackage
|
||||
hazel_hackage(
|
||||
|
@ -357,8 +357,6 @@ convertGenericTemplate env x
|
||||
let thisField = FieldName "contract"
|
||||
tupleTyCon <- qDA_Types env $ mkTypeCon ["Tuple2"]
|
||||
let tupleType = TypeConApp tupleTyCon [TContractId polyType, polyType]
|
||||
let anyContractKeyTy = TypeConApp (Qualified stdlibRef (mkModName ["DA", "Internal", "LF"]) (mkTypeCon ["AnyContractKey"])) []
|
||||
let anyContractKeyField = mkField "getAnyContractKey"
|
||||
let fetchByKey =
|
||||
ETmLam (mkVar "key", keyType) $
|
||||
EUpdate $ UBind (Binding (res, TTuple [(selfField, TContractId monoType), (thisField, monoType)]) $ EUpdate $ UFetchByKey $ RetrieveByKey monoTyCon $ EVar $ mkVar "key") $
|
||||
@ -379,9 +377,9 @@ convertGenericTemplate env x
|
||||
(mkTypeVar "proxy", KArrow KStar KStar)
|
||||
(ETmLam
|
||||
(mkVar "_", TApp (TVar $ mkTypeVar "proxy") polyType)
|
||||
(ETmLam (mkVar "key", keyType) $ ERecCon anyContractKeyTy [(anyContractKeyField, EToAny keyType $ EVar $ mkVar "key")]))
|
||||
(ETmLam (mkVar "key", keyType) $ EToAny keyType $ EVar $ mkVar "key"))
|
||||
else EBuiltin BEError `ETyApp`
|
||||
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> keyType :-> typeConAppToType anyContractKeyTy) `ETmApp`
|
||||
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> keyType :-> TUnit) `ETmApp`
|
||||
EBuiltin (BEText "toAnyContractKey is not supported in this DAML-LF version")
|
||||
let fromAnyContractKey =
|
||||
if envLfVersion env `supports` featureAnyType
|
||||
@ -389,9 +387,9 @@ convertGenericTemplate env x
|
||||
(mkTypeVar "proxy", KArrow KStar KStar)
|
||||
(ETmLam
|
||||
(mkVar "_", TApp (TVar $ mkTypeVar "proxy") polyType)
|
||||
(ETmLam (mkVar "any", typeConAppToType anyContractKeyTy) $ EFromAny keyType $ ERecProj anyContractKeyTy anyContractKeyField $ EVar $ mkVar "any"))
|
||||
(ETmLam (mkVar "any", TAny) $ EFromAny keyType $ EVar $ mkVar "any"))
|
||||
else EBuiltin BEError `ETyApp`
|
||||
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> typeConAppToType anyContractKeyTy :-> TOptional keyType) `ETmApp`
|
||||
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> TUnit :-> TOptional keyType) `ETmApp`
|
||||
EBuiltin (BEText "fromAnyContractKey is not supported in this DAML-LF version")
|
||||
pure (Just $ TemplateKey keyType (applyThis key) (ETmApp maintainers hasKey), [hasKey, key, maintainers, fetchByKey, lookupByKey, toAnyContractKey, fromAnyContractKey], choices)
|
||||
choices -> pure (Nothing, [], choices)
|
||||
@ -427,17 +425,15 @@ convertGenericTemplate env x
|
||||
let exercise =
|
||||
mkETmLams [(self, TContractId polyType), (arg, argType)] $
|
||||
EUpdate $ UExercise monoTyCon chcName (wrapCid $ EVar self) Nothing (EVar arg)
|
||||
let anyChoiceTy = TypeConApp (Qualified stdlibRef (mkModName ["DA", "Internal", "LF"]) (mkTypeCon ["AnyChoice"])) []
|
||||
let anyChoiceField = mkField "getAnyChoice"
|
||||
let toAnyChoice =
|
||||
if envLfVersion env `supports` featureAnyType
|
||||
then ETyLam
|
||||
(mkTypeVar "proxy", KArrow KStar KStar)
|
||||
(ETmLam
|
||||
(mkVar "_", TApp (TVar $ mkTypeVar "proxy") polyType)
|
||||
(ETmLam chcArgBinder $ ERecCon anyChoiceTy [(anyChoiceField, EToAny argType $ EVar arg)]))
|
||||
(ETmLam chcArgBinder $ EToAny argType $ EVar arg))
|
||||
else EBuiltin BEError `ETyApp`
|
||||
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> argType :-> typeConAppToType anyChoiceTy) `ETmApp`
|
||||
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> argType :-> TUnit) `ETmApp`
|
||||
EBuiltin (BEText "toAnyChoice is not supported in this DAML-LF version")
|
||||
let fromAnyChoice =
|
||||
if envLfVersion env `supports` featureAnyType
|
||||
@ -445,9 +441,9 @@ convertGenericTemplate env x
|
||||
(mkTypeVar "proxy", KArrow KStar KStar)
|
||||
(ETmLam
|
||||
(mkVar "_", TApp (TVar $ mkTypeVar "proxy") polyType)
|
||||
(ETmLam (mkVar "any", typeConAppToType anyChoiceTy) $ EFromAny argType $ ERecProj anyChoiceTy anyChoiceField $ EVar $ mkVar "any"))
|
||||
(ETmLam (mkVar "any", TAny) $ EFromAny argType $ EVar $ mkVar "any"))
|
||||
else EBuiltin BEError `ETyApp`
|
||||
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> typeConAppToType anyChoiceTy :-> TOptional argType) `ETmApp`
|
||||
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> TUnit :-> TOptional argType) `ETmApp`
|
||||
EBuiltin (BEText "fromAnyChoice is not supported in this DAML-LF version")
|
||||
pure (TemplateChoice{..}, [consumption, controllers, action, exercise, toAnyChoice, fromAnyChoice])
|
||||
convertGenericChoice es = unhandled "generic choice" es
|
||||
|
@ -11,7 +11,7 @@ module DA.Internal.Desugar (
|
||||
Eq(..), Show(..),
|
||||
Bool(..), Text, Optional,
|
||||
concat, magic,
|
||||
Party, ContractId, Update, AnyTemplate, AnyChoice, AnyContractKey, TemplateTypeRep
|
||||
Party, ContractId, Update, Any, AnyTemplate, AnyChoice, AnyContractKey, TemplateTypeRep
|
||||
) where
|
||||
|
||||
import DA.Internal.Prelude
|
||||
|
@ -39,8 +39,9 @@ module DA.Internal.LF
|
||||
, unpackPair
|
||||
|
||||
, AnyTemplate
|
||||
, AnyChoice
|
||||
, AnyContractKey
|
||||
, AnyChoice(..)
|
||||
, AnyContractKey(..)
|
||||
, Any
|
||||
|
||||
, TemplateTypeRep
|
||||
) where
|
||||
@ -219,10 +220,16 @@ data Any = Any Opaque
|
||||
newtype AnyTemplate = AnyTemplate { getAnyTemplate : Any }
|
||||
|
||||
-- | Existential choice type that can wrap an arbitrary choice.
|
||||
newtype AnyChoice = AnyChoice { getAnyChoice : Any }
|
||||
data AnyChoice = AnyChoice
|
||||
{ getAnyChoice : Any
|
||||
, getAnyChoiceTemplateTypRep : TemplateTypeRep
|
||||
}
|
||||
|
||||
-- | Existential contract key type that can wrap an arbitrary contract key.
|
||||
newtype AnyContractKey = AnyContractKey { getAnyContractKey : Any }
|
||||
data AnyContractKey = AnyContractKey
|
||||
{ getAnyContractKey : Any
|
||||
, getanyContractKeyTemplateRep : TemplateTypeRep
|
||||
}
|
||||
|
||||
-- | Value-level representation of a type.
|
||||
-- We do not expose this directly and instead only expose TemplateTypeRep.
|
||||
|
@ -58,14 +58,20 @@ stakeholder t = signatory t ++ observer t
|
||||
class Template t => Choice t c r | t c -> r where
|
||||
-- | Exercise a choice on the contract with the given contract ID.
|
||||
exercise : ContractId t -> c -> Update r
|
||||
_toAnyChoice : proxy t -> c -> AnyChoice
|
||||
_fromAnyChoice : proxy t -> AnyChoice -> Optional c
|
||||
_toAnyChoice : proxy t -> c -> Any
|
||||
_fromAnyChoice : proxy t -> Any -> Optional c
|
||||
|
||||
toAnyChoice : forall t c r. Choice t c r => c -> AnyChoice
|
||||
toAnyChoice = _toAnyChoice ([] : [t])
|
||||
toAnyChoice c =
|
||||
AnyChoice
|
||||
(_toAnyChoice ([] : [t]) c)
|
||||
(templateTypeRep @t)
|
||||
|
||||
fromAnyChoice : forall t c r. Choice t c r => AnyChoice -> Optional c
|
||||
fromAnyChoice = _fromAnyChoice ([] : [t])
|
||||
fromAnyChoice (AnyChoice any typeRep)
|
||||
| Some c <- _fromAnyChoice ([] : [t]) any
|
||||
, templateTypeRep @t == typeRep = Some c
|
||||
| otherwise = None
|
||||
|
||||
class Template t => TemplateKey t k | t -> k where
|
||||
-- | The key of a contract.
|
||||
@ -101,14 +107,20 @@ class Template t => TemplateKey t k | t -> k where
|
||||
-- | The list of maintainers of a contract key.
|
||||
maintainer : k -> [Party]
|
||||
|
||||
_toAnyContractKey : proxy t -> k -> AnyContractKey
|
||||
_fromAnyContractKey : proxy t -> AnyContractKey -> Optional k
|
||||
_toAnyContractKey : proxy t -> k -> Any
|
||||
_fromAnyContractKey : proxy t -> Any -> Optional k
|
||||
|
||||
toAnyContractKey : forall t k. TemplateKey t k => k -> AnyContractKey
|
||||
toAnyContractKey = _toAnyContractKey ([] : [t])
|
||||
toAnyContractKey k =
|
||||
AnyContractKey
|
||||
(_toAnyContractKey ([] : [t]) k)
|
||||
(templateTypeRep @t)
|
||||
|
||||
fromAnyContractKey : forall t k. TemplateKey t k => AnyContractKey -> Optional k
|
||||
fromAnyContractKey = _fromAnyContractKey ([] : [t])
|
||||
fromAnyContractKey (AnyContractKey any rep)
|
||||
| Some k <- _fromAnyContractKey ([] : [t]) any
|
||||
, templateTypeRep @t == rep = Some k
|
||||
| otherwise = None
|
||||
|
||||
-- | Exercise a choice on the contract associated with the given key.
|
||||
--
|
||||
|
@ -7,7 +7,7 @@ daml 1.2
|
||||
module Prelude (module X) where
|
||||
|
||||
import DA.Internal.Prelude as X hiding (magic)
|
||||
import DA.Internal.LF as X hiding (Pair(..), TextMap, unpackPair)
|
||||
import DA.Internal.LF as X hiding (Pair(..), TextMap, unpackPair, Any)
|
||||
-- Template desugaring uses fromAnyTemplate and toAnyTemplate so we
|
||||
-- can’t remove them from the typeclass for older LF versions
|
||||
-- but we can hide them.
|
||||
|
@ -58,3 +58,5 @@ main = scenario do
|
||||
fromAnyChoice @GT2 @(CT T2) (toAnyChoice @GT1 ct1) === None
|
||||
fromAnyChoice @GT2 @(CT T2) (toAnyChoice @GT2 ct2) === Some ct2
|
||||
fromAnyChoice @GT1 @(CT T1) (toAnyChoice @GT2 ct2) === None
|
||||
fromAnyChoice @T1 @Archive (toAnyChoice @T2 Archive) === None
|
||||
fromAnyChoice @T2 @Archive (toAnyChoice @T2 Archive) === Some Archive
|
||||
|
@ -15,6 +15,15 @@ template T1
|
||||
key p : Party
|
||||
maintainer key
|
||||
|
||||
template T1'
|
||||
with
|
||||
x : Int
|
||||
p : Party
|
||||
where
|
||||
signatory p
|
||||
key p : Party
|
||||
maintainer key
|
||||
|
||||
template T2
|
||||
with
|
||||
y : Text
|
||||
@ -39,6 +48,7 @@ template instance GT2 = GenericT T2
|
||||
main = scenario do
|
||||
p <- getParty "alice"
|
||||
fromAnyContractKey @T1 (toAnyContractKey @T1 p) === Some p
|
||||
fromAnyContractKey @T1' (toAnyContractKey @T1 p) === None
|
||||
fromAnyContractKey @T2 (toAnyContractKey @T2 (p, "foobar")) === Some (p, "foobar")
|
||||
|
||||
fromAnyContractKey @T2 (toAnyContractKey @T1 p) === None
|
||||
|
@ -10,6 +10,7 @@ module ProposalDesugared
|
||||
( main
|
||||
) where
|
||||
|
||||
import DA.Internal.Desugar
|
||||
import DA.Assert
|
||||
import DA.List
|
||||
import DA.Text
|
||||
@ -92,9 +93,9 @@ class Template t => ProposalInstance t where
|
||||
_fetchByKeyProposal = error "code will be injected by the compiler"
|
||||
_lookupByKeyProposal : ([Party], Text) -> Update (Optional (ContractId (Proposal t)))
|
||||
_lookupByKeyProposal = error "code will be injected by the compiler"
|
||||
_toAnyContractKeyProposal : proxy (Proposal t) -> ([Party], Text) -> AnyContractKey
|
||||
_toAnyContractKeyProposal : proxy (Proposal t) -> ([Party], Text) -> Any
|
||||
_toAnyContractKeyProposal = error "code will be injected by the compiler"
|
||||
_fromAnyContractKeyProposal : proxy (Proposal t) -> AnyContractKey -> Optional ([Party], Text)
|
||||
_fromAnyContractKeyProposal : proxy (Proposal t) -> Any -> Optional ([Party], Text)
|
||||
_fromAnyContractKeyProposal = error "code will be injected by the compiler"
|
||||
|
||||
_consumptionProposalArchive : PreConsuming (Proposal t)
|
||||
@ -106,9 +107,9 @@ class Template t => ProposalInstance t where
|
||||
pure ()
|
||||
_exerciseProposalArchive : ContractId (Proposal t) -> Archive -> Update ()
|
||||
_exerciseProposalArchive = error "code will be injected by the compiler"
|
||||
_toAnyChoiceProposalArchive : proxy (Proposal t) -> Archive -> AnyChoice
|
||||
_toAnyChoiceProposalArchive : proxy (Proposal t) -> Archive -> Any
|
||||
_toAnyChoiceProposalArchive = error "code will be injected by the compiler"
|
||||
_fromAnyChoiceProposalArchive : proxy (Proposal t) -> AnyChoice -> Optional Archive
|
||||
_fromAnyChoiceProposalArchive : proxy (Proposal t) -> Any -> Optional Archive
|
||||
_fromAnyChoiceProposalArchive = error "code will be injected by the compiler"
|
||||
|
||||
_consumptionProposalAccept : PreConsuming (Proposal t)
|
||||
@ -120,9 +121,9 @@ class Template t => ProposalInstance t where
|
||||
create asset
|
||||
_exerciseProposalAccept : ContractId (Proposal t) -> Accept -> Update (ContractId t)
|
||||
_exerciseProposalAccept = error "code will be injected by the compiler"
|
||||
_toAnyChoiceProposalAccept : proxy (Proposal t) -> Accept -> AnyChoice
|
||||
_toAnyChoiceProposalAccept : proxy (Proposal t) -> Accept -> Any
|
||||
_toAnyChoiceProposalAccept = error "code will be injected by the compiler"
|
||||
_fromAnyChoiceProposalAccept : proxy (Proposal t) -> AnyChoice -> Optional Accept
|
||||
_fromAnyChoiceProposalAccept : proxy (Proposal t) -> Any -> Optional Accept
|
||||
_fromAnyChoiceProposalAccept = error "code will be injected by the compiler"
|
||||
|
||||
|
||||
@ -190,9 +191,9 @@ class IouInstance where
|
||||
pure ()
|
||||
_exerciseIouArchive : ContractId Iou -> Archive -> Update ()
|
||||
_exerciseIouArchive = error "code will be injected by the compiler"
|
||||
_toAnyChoiceIouArchive : proxy Iou -> Archive -> AnyChoice
|
||||
_toAnyChoiceIouArchive : proxy Iou -> Archive -> Any
|
||||
_toAnyChoiceIouArchive = error "code will be injected by the compiler"
|
||||
_fromAnyChoiceIouArchive : proxy Iou -> AnyChoice -> Optional Archive
|
||||
_fromAnyChoiceIouArchive : proxy Iou -> Any -> Optional Archive
|
||||
_fromAnyChoiceIouArchive = error "code will be injected by the compiler"
|
||||
|
||||
_consumptionIouBurn : PreConsuming Iou
|
||||
@ -204,9 +205,9 @@ class IouInstance where
|
||||
pure ()
|
||||
_exerciseIouBurn : ContractId Iou -> Burn -> Update ()
|
||||
_exerciseIouBurn = error "code will be injected by the compiler"
|
||||
_toAnyChoiceIouBurn : proxy Iou -> Burn -> AnyChoice
|
||||
_toAnyChoiceIouBurn : proxy Iou -> Burn -> Any
|
||||
_toAnyChoiceIouBurn = error "code will be injected by the compiler"
|
||||
_fromAnyChoiceIouBurn : proxy Iou -> AnyChoice -> Optional Burn
|
||||
_fromAnyChoiceIouBurn : proxy Iou -> Any -> Optional Burn
|
||||
_fromAnyChoiceIouBurn = error "code will be injected by the compiler"
|
||||
|
||||
instance IouInstance where
|
||||
|
@ -120,6 +120,7 @@ getIntegrationTests registerTODO scenarioService version = do
|
||||
-- only run Test.daml (see https://github.com/digital-asset/daml/issues/726)
|
||||
bondTradingLocation <- locateRunfiles $ mainWorkspace </> "compiler/damlc/tests/bond-trading"
|
||||
let allTestFiles = damlTestFiles ++ [("bond-trading/Test.daml", bondTradingLocation </> "Test.daml")]
|
||||
let (generatedFiles, nongeneratedFiles) = partition (\(f, _) -> takeFileName f == "ProposalDesugared.daml") allTestFiles
|
||||
|
||||
let outdir = "compiler/damlc/output"
|
||||
createDirectoryIfMissing True outdir
|
||||
@ -134,12 +135,17 @@ getIntegrationTests registerTODO scenarioService version = do
|
||||
-- initialise the compiler service
|
||||
vfs <- makeVFSHandle
|
||||
damlEnv <- mkDamlEnv opts (Just scenarioService)
|
||||
-- We use a separate service for generated files so that we can test files containing internal imports.
|
||||
pure $
|
||||
withResource
|
||||
(initialise (mainRule opts) (pure $ LSP.IdInt 0) (const $ pure ()) IdeLogger.noLogging damlEnv (toCompileOpts opts (IdeReportProgress False)) vfs)
|
||||
shutdown $ \service ->
|
||||
withTestArguments $ \args -> testGroup ("Tests for DAML-LF " ++ renderPretty version) $
|
||||
map (testCase args version service outdir registerTODO) allTestFiles
|
||||
withResource
|
||||
(initialise (mainRule opts) (pure $ LSP.IdInt 0) (const $ pure ()) IdeLogger.noLogging damlEnv (toCompileOpts opts (IdeReportProgress False)) vfs)
|
||||
shutdown $ \service ->
|
||||
withResource
|
||||
(initialise (mainRule opts) (pure $ LSP.IdInt 0) (const $ pure ()) IdeLogger.noLogging damlEnv (toCompileOpts opts { optIsGenerated = True } (IdeReportProgress False)) vfs)
|
||||
shutdown $ \serviceGenerated ->
|
||||
withTestArguments $ \args -> testGroup ("Tests for DAML-LF " ++ renderPretty version) $
|
||||
map (testCase args version service outdir registerTODO) nongeneratedFiles <>
|
||||
map (testCase args version serviceGenerated outdir registerTODO) generatedFiles
|
||||
|
||||
newtype TestCase = TestCase ((String -> IO ()) -> IO Result)
|
||||
|
||||
|
@ -83,7 +83,7 @@ object Converter {
|
||||
|
||||
def toAnyChoice(v: SValue): Either[String, AnyChoice] = {
|
||||
v match {
|
||||
case SRecord(_, _, vals) if vals.size == 1 => {
|
||||
case SRecord(_, _, vals) if vals.size == 2 => {
|
||||
vals.get(0) match {
|
||||
case SAny(_, choiceVal @ SRecord(_, _, _)) =>
|
||||
Right(AnyChoice(choiceVal.id.qualifiedName.name.toString, choiceVal))
|
||||
|
@ -98,9 +98,9 @@ class IouInstance where
|
||||
_actionIouArchive self this@Iou{..} arg@Archive = pure ()
|
||||
_exerciseIouArchive : ContractId Iou -> Archive -> Update ()
|
||||
_exerciseIouArchive = magic @"archive"
|
||||
_toAnyChoiceIouArchive : proxy Iou -> Archive -> AnyChoice
|
||||
_toAnyChoiceIouArchive : proxy Iou -> Archive -> Any
|
||||
_toAnyChoiceIouArchive = magic @"toAnyChoice"
|
||||
_fromAnyChoiceIouArchive : proxy Iou -> AnyChoice -> Optional Archive
|
||||
_fromAnyChoiceIouArchive : proxy Iou -> Any -> Optional Archive
|
||||
_fromAnyChoiceIouArchive = magic @"fromAnyChoice"
|
||||
|
||||
_consumptionIouTransfer : PreConsuming Iou
|
||||
@ -111,9 +111,9 @@ class IouInstance where
|
||||
_actionIouTransfer self this@Iou{..} arg@Transfer{..} = create this with owner = newOwner
|
||||
_exerciseIouTransfer : ContractId Iou -> Transfer -> Update (ContractId Iou)
|
||||
_exerciseIouTransfer = magic @"exercise"
|
||||
_toAnyChoiceIouTransfer : proxy Iou -> Transfer -> AnyChoice
|
||||
_toAnyChoiceIouTransfer : proxy Iou -> Transfer -> Any
|
||||
_toAnyChoiceIouTransfer = magic @"toAnyChoice"
|
||||
_fromAnyChoiceIouTransfer : proxy Iou -> AnyChoice -> Optional Transfer
|
||||
_fromAnyChoiceIouTransfer : proxy Iou -> Any -> Optional Transfer
|
||||
_fromAnyChoiceIouTransfer = magic @"fromAnyChoice"
|
||||
```
|
||||
|
||||
@ -138,8 +138,8 @@ When a type `t` is a `Template` instance, `class Choice` (defined by the DAML st
|
||||
```haskell
|
||||
class Template t => Choice t c r | t c -> r where
|
||||
exercise : ContractId t -> c -> Update r
|
||||
_toAnyChoice : proxy t -> c -> AnyChoice
|
||||
_fromAnyChoice : proxy t -> AnyChoice -> Optional c
|
||||
_toAnyChoice : proxy t -> c -> Any
|
||||
_fromAnyChoice : proxy t -> Any -> Optional c
|
||||
```
|
||||
|
||||
In this example, `c` is identified with `Transfer` and `r` with `ContractId Iou`.
|
||||
@ -163,6 +163,8 @@ class Template t => TemplateKey t k | t -> k where
|
||||
key : t -> k
|
||||
fetchByKey : k -> Update (ContractId t, t)
|
||||
lookupByKey : k -> Update (Optional (ContractId t))
|
||||
_toAnyContractKey : proxy t -> k -> Any
|
||||
_fromAnyContractKey : proxy t -> Any -> Optional ks
|
||||
```
|
||||
|
||||
In the following `Enrollment` contract, there are no choices but there are declarations of `key` and `maintainer`.
|
||||
@ -237,9 +239,9 @@ class EnrollmentInstance where
|
||||
_actionEnrollmentArchive self this@Enrollment{..} arg@Archive = pure ()
|
||||
_exerciseEnrollmentArchive : ContractId Enrollment -> Archive -> Update ()
|
||||
_exerciseEnrollmentArchive = magic @"archive"
|
||||
_toAnyChoiceEnrollmentArchive : proxy Enrollment -> Archive -> AnyChoice
|
||||
_toAnyChoiceEnrollmentArchive : proxy Enrollment -> Archive -> Any
|
||||
_toAnyChoiceEnrollmentArchive = magic @"toAnyChoice"
|
||||
_fromAnyChoiceEnrollmentArchive : proxy Enrollment -> AnyChoice -> Optional Archive
|
||||
_fromAnyChoiceEnrollmentArchive : proxy Enrollment -> Any -> Optional Archive
|
||||
_fromAnyChoiceEnrollmentArchive = magic @"fromAnyChoice"
|
||||
|
||||
instance EnrollmentInstance
|
||||
@ -260,6 +262,8 @@ instance TemplateKey Enrollment Registration where
|
||||
fetchByKey = _fetchByKeyEnrollment
|
||||
lookupByKey = _lookupByKeyEnrollment
|
||||
maintainer = _maintainerEnrollment (_hasKeyEnrollment : HasKey Enrollment)
|
||||
_fromAnyContractKey = _fromAnyContractKeyEnrollment
|
||||
_toAnyContractKey = _toAnyContractKeyEnrollment
|
||||
```
|
||||
|
||||
### Example (3)
|
||||
@ -335,9 +339,9 @@ class Template t => ProposalInstance t where
|
||||
_actionProposalArchive self this@Proposal{..} arg@Archive = pure ()
|
||||
_exerciseProposalArchive : ContractId (Proposal t) -> Archive -> Update ()
|
||||
_exerciseProposalArchive = magic @"archive"
|
||||
_toAnyChoiceProposalArchive : proxy (Proposal t) -> Archive -> AnyChoice
|
||||
_toAnyChoiceProposalArchive : proxy (Proposal t) -> Archive -> Any
|
||||
_toAnyChoiceProposalArchive = magic @"toAnyChoice"
|
||||
_fromAnyChoiceProposalArchive : proxy (Proposal t) -> AnyChoice -> Optional Archive
|
||||
_fromAnyChoiceProposalArchive : proxy (Proposal t) -> Any -> Optional Archive
|
||||
_fromAnyChoiceProposalArchive = magic @"fromAnyChoice"
|
||||
|
||||
_consumptionProposalAccept : PreConsuming (Proposal t)
|
||||
@ -349,9 +353,9 @@ class Template t => ProposalInstance t where
|
||||
create asset
|
||||
_exerciseProposalAccept : ContractId (Proposal t) -> Accept -> Update (ContractId t)
|
||||
_exerciseProposalAccept = magic @"exercise"
|
||||
_toAnyChoiceProposalAccept : proxy (Proposal t) -> Accept -> AnyChoice
|
||||
_toAnyChoiceProposalAccept : proxy (Proposal t) -> Accept -> Any
|
||||
_toAnyChoiceProposalAccept = magic @"toAnyChoice"
|
||||
_fromAnyChoiceProposalAccept : proxy (Proposal t) -> AnyChoice -> Optional Accept
|
||||
_fromAnyChoiceProposalAccept : proxy (Proposal t) -> Any -> Optional Accept
|
||||
_fromAnyChoiceProposalAccept = magic @"fromAnyChoice"
|
||||
|
||||
instance ProposalInstance t => Template (Proposal t) where
|
||||
@ -369,6 +373,8 @@ instance ProposalInstance t => TemplateKey (Proposal t) ([Party], Text) where
|
||||
key = _keyProposal
|
||||
fetchByKey = _fetchByKeyProposal
|
||||
lookupByKey = _lookupByKeyProposal
|
||||
_toAnyContractKey = _toAnyContractKeyProposal
|
||||
_fromAnyContractKey = _fromAnyContractKeyProposal
|
||||
|
||||
instance ProposalInstance t => Choice (Proposal t) Accept (ContractId t) where
|
||||
exercise = _exerciseProposalAccept
|
||||
|
@ -359,15 +359,39 @@ object Converter {
|
||||
}
|
||||
}
|
||||
|
||||
// Extract the value from a newtype wrapper around Any, e.g., AnyChoice or AnyContractKey
|
||||
private def toAnyWrapper(wrapper: String, v: SValue): Either[String, SValue] = {
|
||||
private def toAnyTemplate(v: SValue): Either[String, SValue] = {
|
||||
v match {
|
||||
case SRecord(_, _, vals) if vals.size == 1 =>
|
||||
vals.get(0) match {
|
||||
case SAny(_, v) => Right(v)
|
||||
case v => Left(s"Expected Any but got $v")
|
||||
}
|
||||
case _ => Left(s"Expected $wrapper but got $v")
|
||||
case _ => Left(s"Expected AnyTemplate but got $v")
|
||||
}
|
||||
}
|
||||
|
||||
// toAnyChoice and toAnyContractKey are identical right now
|
||||
// but there is no resaon why they have to be, so we
|
||||
// use two different methods.
|
||||
private def toAnyChoice(v: SValue): Either[String, SValue] = {
|
||||
v match {
|
||||
case SRecord(_, _, vals) if vals.size == 2 =>
|
||||
vals.get(0) match {
|
||||
case SAny(_, v) => Right(v)
|
||||
case v => Left(s"Expected Any but got $v")
|
||||
}
|
||||
case _ => Left(s"Expected AnyChoice but got $v")
|
||||
}
|
||||
}
|
||||
|
||||
private def toAnyContractKey(v: SValue): Either[String, SValue] = {
|
||||
v match {
|
||||
case SRecord(_, _, vals) if vals.size == 2 =>
|
||||
vals.get(0) match {
|
||||
case SAny(_, v) => Right(v)
|
||||
case v => Left(s"Expected Any but got $v")
|
||||
}
|
||||
case _ => Left(s"Expected AnyContractKey but got $v")
|
||||
}
|
||||
}
|
||||
|
||||
@ -384,7 +408,7 @@ object Converter {
|
||||
v match {
|
||||
case SRecord(_, _, vals) if vals.size == 1 => {
|
||||
for {
|
||||
tpl <- toAnyWrapper("AnyTemplate", vals.get(0))
|
||||
tpl <- toAnyTemplate(vals.get(0))
|
||||
templateId <- extractTemplateId(tpl)
|
||||
templateArg <- toLedgerRecord(tpl)
|
||||
} yield CreateCommand(Some(toApiIdentifier(templateId)), Some(templateArg))
|
||||
@ -398,7 +422,7 @@ object Converter {
|
||||
case SRecord(_, _, vals) if vals.size == 2 => {
|
||||
for {
|
||||
anyContractId <- toAnyContractId(vals.get(0))
|
||||
choiceVal <- toAnyWrapper("AnyChoice", vals.get(1))
|
||||
choiceVal <- toAnyChoice(vals.get(1))
|
||||
choiceName <- extractChoiceName(choiceVal)
|
||||
choiceArg <- toLedgerValue(choiceVal)
|
||||
} yield {
|
||||
@ -420,9 +444,9 @@ object Converter {
|
||||
case SRecord(_, _, vals) if vals.size == 3 => {
|
||||
for {
|
||||
tplId <- toTemplateTypeRep(vals.get(0))
|
||||
keyVal <- toAnyWrapper("AnyContractKey", vals.get(1))
|
||||
keyVal <- toAnyContractKey(vals.get(1))
|
||||
keyArg <- toLedgerValue(keyVal)
|
||||
choiceVal <- toAnyWrapper("AnyChoice", vals.get(2))
|
||||
choiceVal <- toAnyChoice(vals.get(2))
|
||||
choiceName <- extractChoiceName(choiceVal)
|
||||
choiceArg <- toLedgerValue(choiceVal)
|
||||
} yield {
|
||||
|
@ -47,3 +47,6 @@ HEAD — ongoing
|
||||
See `issue #3461 <https://github.com/digital-asset/daml/pull/3461>`_.
|
||||
|
||||
- [JSON API - Experimental] Terminate process immediately after creating schema. See issue #3386.
|
||||
|
||||
- [DAML Stdlib] ``fromAnyChoice`` and ``fromAnyContractKey`` now take
|
||||
the template type into account.
|
||||
|
Loading…
Reference in New Issue
Block a user