Skip to content

Commit

Permalink
interface: adding interfaces to the TS codegen
Browse files Browse the repository at this point in the history 
We add TS interfaces corresponding to Daml interfaces to the generated
TS code.

CHANGELOG_BEGIN
CHANGELOG_END
  • Loading branch information
Robin Krom committed Oct 18, 2021
1 parent a940016 commit 7c47918
Show file tree
Hide file tree
Showing 4 changed files with 219 additions and 31 deletions.
64 changes: 60 additions & 4 deletions language-support/ts/codegen/README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -83,7 +83,7 @@ import * as daml from '@daml/types';

See the [SDK docs](https://github.com/digital-asset/daml/tree/main/docs/source/daml2js).

#### Interfaces
#### Typescript Interfaces

- `Serializable<T>`
- An object that implements the `Serializable<T>` interface has a field `decoder: () => jtv.Decoder<T>`;
Expand Down Expand Up @@ -285,10 +285,13 @@ export type Iou = {
amount: daml.Numeric;
}

export const Iou: daml.Template<Iou, Iou.Key, 'Iou:Iou'> & {
export interface IouInterface = {
Archive: daml.Choice<Iou, DA_Internal_Template.Archive, {}, Iou.Key>;
Transfer: daml.Choice<Iou, Transfer, daml.ContractId<Iou>, Iou.Key>;
} = {
}

export const Iou: daml.Template<Iou, Iou.Key, 'Iou:Iou'> & IouInterface
= {
templateId: 'Iou:Iou',
keyDecoder: () => daml.Party.decoder(),
decoder: () => jtv.object({
Expand Down Expand Up @@ -319,7 +322,60 @@ daml.registerTemplate(Iou);
```

`daml2js` has produced:
- Type definitions corresponding to the `Transfer` choice and the `Iou` template;
- Type definitions corresponding to the `Transfer` choice, the `Iou` template and the
`IouInterface` consisting of its declared choices;
- Companion objects for those types;
- An `Iou` template associated type definition `Key` in the `Iou` namespace;
- A module scoped function call to `registerTemplate` to add the `Iou` object to a central registry.

#### Daml Interfaces

An `Asset` interface.

```haskell
interface Asset where
choice Transfer : ContractId Asset
with
newOwner : Party
```.

A Daml interface is translated to a TypeScript interface as follows.

```typescript
export declare interface AssetInterface <T extends object>{
Transfer: damlTypes.Choice<T, Transfer, damlTypes.ContractId<AssetInterface<T>>, undefined>;
}
export declare const Asset: damlTypes.Template<object, undefined, 'Asset'> & AssetInterface<object>;
```

The following is a template implementing the `Asset` interface.

```haskell
template Iou
with
issuer: Party
owner: Party
currency: Text
amount: Decimal
where
signatory issuer
key owner : Party
maintainer key

implements Asset where
choice Transfer: ContractId Iou
with
newOwner: Party
controller owner
do
create this with owner = newOwner
```

The implementation is reflected in an extension of the `IouInterface` with the `AssetInterface`.

```typescript
export interface IouInterface extends AssetInterface = {
Archive: daml.Choice<Iou, DA_Internal_Template.Archive, {}, Iou.Key>;
Transfer: daml.Choice<Iou, Transfer, daml.ContractId<Iou>, Iou.Key>;
}
```
136 changes: 110 additions & 26 deletions language-support/ts/codegen/src/TsCodeGenMain.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -196,7 +196,8 @@ genModule pkgMap (Scope scope) curPkgId mod
Nothing -- If no serializable types, nothing to do.
| otherwise =
let (decls, refs) = unzip (map (genDataDef curPkgId mod tpls) serDefs)
imports = (PRSelf, modName) `Set.delete` Set.unions refs
(ifaceDecls, ifaceRefs) = unzip (map (genIfaceDecl curPkgId mod) $ NM.toList ifaces)
imports = (PRSelf, modName) `Set.delete` Set.unions (refs ++ ifaceRefs)
(internalImports, externalImports) = splitImports imports
rootPath = map (const "..") (unModuleName modName)
makeMod jsSyntax body = T.unlines $ intercalate [""] $ filter (not . null) $
Expand All @@ -205,12 +206,13 @@ genModule pkgMap (Scope scope) curPkgId mod
: map (internalImportDecl jsSyntax rootPath) internalImports
: body

(jsBody, tsDeclsBody) = unzip $ map (unzip . map renderTsDecl) decls
(jsBody, tsDeclsBody) = unzip $ map (unzip . map renderTsDecl) (decls ++ ifaceDecls)
depends = Set.map (Dependency . pkgRefStr pkgMap) externalImports
in Just ((makeMod ES5 jsBody, makeMod ES6 tsDeclsBody), depends)
where
modName = moduleName mod
tpls = moduleTemplates mod
ifaces = moduleInterfaces mod
serDefs = defDataTypes mod
modHeader ES5 = commonjsPrefix ++
[ "/* eslint-disable-next-line no-unused-vars */"
Expand Down Expand Up @@ -285,6 +287,37 @@ genDataDef curPkgId mod tpls def = case unTypeConName (dataTypeCon def) of
(decls, refs) = genDefDataType curPkgId c2 mod tpls def
tyDecls = [d | DeclTypeDef d <- decls]

genIfaceDecl :: PackageId -> Module -> DefInterface -> ([TsDecl], Set.Set ModuleRef)
genIfaceDecl pkgId mod DefInterface {intName, intVirtualChoices, intFixedChoices} =
( [ DeclInterface
(InterfaceDef
{ ifName = name
, ifChoices = choices
, ifModule = moduleName mod
, ifPkgId = pkgId
})
]
, Set.unions choiceRefs)
where
-- interfaces are not declared in JS code, only in the TS type declarations.
(name, _) = genTypeCon (moduleName mod) (Qualified PRSelf (moduleName mod) intName)
(choices, choiceRefs) =
unzip $
[ (ChoiceDef (unChoiceName (chcName chc)) argTy rTy, Set.union argRefs retRefs)
| chc <- NM.toList intFixedChoices
, let argTy = TypeRef (moduleName mod) (snd (chcArgBinder chc))
, let rTy = TypeRef (moduleName mod) (chcReturnType chc)
, let argRefs = Set.setOf typeModuleRef (refType argTy)
, let retRefs = Set.setOf typeModuleRef (refType rTy)
] ++
[ (ChoiceDef (unChoiceName (ifcName chc)) argTy rTy, Set.union argRefs retRefs)
| chc <- NM.toList intVirtualChoices
, let argTy = TypeRef (moduleName mod) (ifcArgType chc)
, let rTy = TypeRef (moduleName mod) (ifcRetType chc)
, let argRefs = Set.setOf typeModuleRef (refType argTy)
, let retRefs = Set.setOf typeModuleRef (refType rTy)
]

-- | The typescript declarations we produce.
data TsDecl
= DeclTemplateDef TemplateDef
Expand All @@ -293,6 +326,7 @@ data TsDecl
| DeclTemplateNamespace TemplateNamespace
| DeclTemplateRegistration TemplateRegistration
| DeclNamespace T.Text [TypeDef]
| DeclInterface InterfaceDef
-- ^ Note that we special-case some namespaces, e.g., the template namespace
-- that always have fixed contents. This constructor is only used for the namespace
-- for sums of products.
Expand All @@ -309,6 +343,7 @@ renderTsDecl = \case
, [ " " <> l | d <- decls, l <- T.lines (renderTypeDef d) ]
, [ "} //namespace " <> t ]
])
DeclInterface i -> renderInterfaceDef i


-- | Namespace containing type synonyms for Key, CreatedEvent, ArchivedEvent and Event
Expand All @@ -321,7 +356,7 @@ data TemplateNamespace = TemplateNamespace
renderTemplateNamespace :: TemplateNamespace -> T.Text
renderTemplateNamespace TemplateNamespace{..} = T.unlines $ concat
[ [ "export declare namespace " <> tnsName <> " {" ]
, [ " export type Key = " <> fst (genType keyDef) | Just keyDef <- [tnsMbKeyDef] ]
, [ " export type Key = " <> fst (genType keyDef Nothing) | Just keyDef <- [tnsMbKeyDef] ]
, [ " export type CreateEvent = damlLedger.CreateEvent" <> tParams [tnsName, tK, tI]
, " export type ArchiveEvent = damlLedger.ArchiveEvent" <> tParams [tnsName, tI]
, " export type Event = damlLedger.Event" <> tParams [tnsName, tK, tI]
Expand Down Expand Up @@ -350,6 +385,7 @@ data TemplateDef = TemplateDef
-- ^ Nothing if we do not have a key.
, tplKeyEncode :: Encode
, tplChoices' :: [ChoiceDef]
, tplImplements' :: [T.Text]
}

renderTemplateDef :: TemplateDef -> (T.Text, T.Text)
Expand Down Expand Up @@ -377,15 +413,10 @@ renderTemplateDef TemplateDef{..} =
, [ "};" ]
]
tsDecl = T.unlines $ concat
[ [ "export declare const " <> tplName <> ":"
, " damlTypes.Template<" <> tplName <> ", " <> keyTy <> ", '" <> templateId <> "'> & {"
[ ifaceDefTempl tplName (Just keyTy) tplImplements' tplChoices'
, [ "export declare const " <> tplName <> ":"
, " damlTypes.Template<" <> tplName <> ", " <> keyTy <> ", '" <> templateId <> "'> & " <> tplName <> "Interface;"
]
, [ " " <> chcName' <> ": damlTypes.Choice<" <>
tplName <> ", " <>
fst (genType chcArgTy) <> ", " <>
fst (genType chcRetTy) <> ", " <>
keyTy <> ">;" | ChoiceDef{..} <- tplChoices' ]
, [ "};" ]
]
in (jsSource, tsDecl)
where (keyTy, keyDec) = case tplKeyDecoder of
Expand All @@ -396,6 +427,58 @@ renderTemplateDef TemplateDef{..} =
T.intercalate "." (unModuleName tplModule) <> ":" <>
tplName

data InterfaceDef = InterfaceDef
{ ifName :: T.Text
, ifModule :: ModuleName
, ifPkgId :: PackageId
, ifChoices :: [ChoiceDef]
}

renderInterfaceDef :: InterfaceDef -> (T.Text, T.Text)
renderInterfaceDef InterfaceDef{ifName, ifChoices, ifModule, ifPkgId} = (jsSource, tsDecl)
where
jsSource = ""
tsDecl = T.unlines $ concat
[ifaceDefIface ifName Nothing ifChoices
, ["export declare const " <> ifName <> ": damlTypes.Template<object, undefined, '" <> ifaceId <> "'> & " <> ifName <> "Interface<object>;"]
]
ifaceId =
unPackageId ifPkgId <> ":" <>
T.intercalate "." (unModuleName ifModule) <> ":" <>
ifName

ifaceDefTempl :: T.Text -> Maybe T.Text -> [T.Text] -> [ChoiceDef] -> [T.Text]
ifaceDefTempl name mbKeyTy impls choices =
concat
[ ["export declare interface " <> name <> "Interface " <> extension <> "{"]
, [ " " <> chcName' <> ": damlTypes.Choice<" <>
name <> ", " <>
fst (genType chcArgTy Nothing) <> ", " <>
fst (genType chcRetTy (Just (Set.fromList impls, implTy))) <> ", " <>
keyTy <> ">;" | ChoiceDef{..} <- choices ]
, [ "}" ]
]
where
keyTy = fromMaybe "undefined" mbKeyTy
extension
| null impls = ""
| otherwise = "extends " <> implTy
implTy = T.intercalate " & " [impl <> "Interface<" <> name <> ">" | impl <- impls]

ifaceDefIface :: T.Text -> Maybe T.Text -> [ChoiceDef] -> [T.Text]
ifaceDefIface name mbKeyTy choices =
concat
[ ["export declare interface " <> name <> "Interface " <> "<T extends object>{"]
, [ " " <> chcName' <> ": damlTypes.Choice<" <>
"T, " <>
fst (genType chcArgTy Nothing) <> ", " <>
fst (genType chcRetTy (Just (Set.singleton name, name <> "Interface<T>"))) <> ", " <>
keyTy <> ">;" | ChoiceDef{..} <- choices ]
, [ "}" ]
]
where
keyTy = fromMaybe "undefined" mbKeyTy

data ChoiceDef = ChoiceDef
{ chcName' :: T.Text
, chcArgTy :: TypeRef
Expand Down Expand Up @@ -522,7 +605,7 @@ renderDecoder = \case
T.concat (map (\(name, d) -> name <> ": " <> renderDecoder d <> ", ") fields) <>
"})"
DecoderConstant c -> "jtv.constant(" <> renderDecoderConstant c <> ")"
DecoderRef t -> snd (genType t) <> ".decoder"
DecoderRef t -> snd (genType t Nothing) <> ".decoder"
DecoderLazy d -> "damlTypes.lazyMemo(function () { return " <> renderDecoder d <> "; })"

data Encode
Expand All @@ -534,13 +617,13 @@ data Encode

renderEncode :: Encode -> T.Text
renderEncode = \case
EncodeRef ref -> let (_, companion) = genType ref in
EncodeRef ref -> let (_, companion) = genType ref Nothing in
"function (__typed__) { return " <> companion <> ".encode(__typed__); }"
EncodeVariant typ alts -> T.unlines $ concat
[ [ "function (__typed__) {" -- Note: switch uses ===
, " switch(__typed__.tag) {" ]
, [ " case '" <> name <> "': return {tag: __typed__.tag, value: " <> companion <> ".encode(__typed__.value)};"
| (name, tr) <- alts, let (_, companion) = genType tr ]
| (name, tr) <- alts, let (_, companion) = genType tr Nothing]
, [ " default: throw 'unrecognized type tag: ' + __typed__.tag + ' while serializing a value of type " <> typ <> "';"
, " }"
, "}" ] ]
Expand All @@ -549,7 +632,7 @@ renderEncode = \case
[ [ "function (__typed__) {"
, " return {" ]
, [ " " <> name <> ": " <> companion <> ".encode(__typed__." <> name <> "),"
| (name, tr) <- fields, let (_, companion) = genType tr ]
| (name, tr) <- fields, let (_, companion) = genType tr Nothing]
, [ " };"
, "}" ] ]
EncodeThrow -> "function () { throw 'EncodeError'; }"
Expand All @@ -563,12 +646,12 @@ renderTypeDef :: TypeDef -> T.Text
renderTypeDef = \case
UnionDef t args bs -> T.unlines $ concat
[ [ "type " <> ty t args <> " =" ]
, [ " | { tag: '" <> k <> "'; value: " <> fst (genType t) <> " }" | (k, t) <- bs ]
, [ " | { tag: '" <> k <> "'; value: " <> fst (genType t Nothing) <> " }" | (k, t) <- bs ]
, [ ";" ]
]
ObjectDef t args fs -> T.unlines $ concat
[ [ "type " <> ty t args <> " = {" ]
, [ " " <> k <> ": " <> fst (genType t) <> ";" | (k, t) <- fs ]
, [ " " <> k <> ": " <> fst (genType t Nothing) <> ";" | (k, t) <- fs ]
, [ "};" ]
]
EnumDef t args fs -> T.unlines $ concat
Expand Down Expand Up @@ -624,8 +707,7 @@ genSerializableDef curPkgId conName mod def =
, serEncode = EncodeRecord $ zip fieldNames fieldTypes
, serNested = []
}
-- TODO https://github.com/digital-asset/daml/issues/10810
DataInterface -> error "interafces are not implemented"
DataInterface -> error "interfaces are not serializable"
where
paramNames = map (unTypeVarName . fst) (dataParams def)
genDecBranch (VariantConName cons, t) =
Expand Down Expand Up @@ -661,8 +743,7 @@ genTypeDef conName mod def =
conName
paramNames
[ (n, TypeRef (moduleName mod) ty) | (FieldName n, ty) <- fields ]
-- TODO https://github.com/digital-asset/daml/issues/10810
DataInterface -> error "interafces are not implemented"
DataInterface -> error "interfaces are not implemented"
where
paramNames = map (unTypeVarName . fst) (dataParams def)

Expand Down Expand Up @@ -705,6 +786,7 @@ genDefDataType curPkgId conName mod tpls def =
( Just $ DecoderRef typeRef
, EncodeRef typeRef
, Set.setOf typeModuleRef keyType)
impls = [tycon | impl <- NM.names $ tplImplements tpl, let (tycon, _) = genTypeCon (moduleName mod) impl]
dict = TemplateDef
{ tplName = conName
, tplPkgId = curPkgId
Expand All @@ -714,6 +796,7 @@ genDefDataType curPkgId conName mod tpls def =
, tplKeyDecoder = keyDecoder
, tplKeyEncode = keyEncode
, tplChoices' = chcs
, tplImplements' = impls
}
associatedTypes = TemplateNamespace
{ tnsName = conName
Expand All @@ -723,17 +806,16 @@ genDefDataType curPkgId conName mod tpls def =
refs = Set.unions (fieldRefs ++ keyRefs : chcRefs)
in
([DeclTypeDef typeDesc, DeclTemplateDef dict, DeclTemplateNamespace associatedTypes, DeclTemplateRegistration registrations], refs)
-- TODO https://github.com/digital-asset/daml/issues/10810
DataInterface -> error "interafces are not implemented"
DataInterface -> ([], Set.empty)

infixr 6 <.> -- This is the same fixity as '<>'.
(<.>) :: T.Text -> T.Text -> T.Text
(<.>) u v = u <> "." <> v

-- | Returns a pair of the type and a reference to the
-- companion object/function.
genType :: TypeRef -> (T.Text, T.Text)
genType (TypeRef curModName t) = go t
genType :: TypeRef -> Maybe (Set.Set T.Text, T.Text) -> (T.Text, T.Text)
genType (TypeRef curModName t) mbSubst = go t
where
go = \case
TVar v -> dupe (unTypeVarName v)
Expand Down Expand Up @@ -773,7 +855,9 @@ genType (TypeRef curModName t) = go t
in
("damlTypes.ContractId<" <> t' <> ">", "damlTypes.ContractId(" <> ser <> ")")
TConApp con ts ->
let (con', ser) = genTypeCon curModName con
let (con', ser)
| Just (impls, subst) <- mbSubst, (fst $ genTypeCon curModName con) `Set.member` impls = (subst, "")
| _otherwise <- mbSubst = genTypeCon curModName con
(ts', sers) = unzip (map go ts)
in
if null ts
Expand Down
Loading

0 comments on commit 7c47918

Please sign in to comment.