From 98691451196f4bc83589a27794c1b624ef4c8946 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 12 Oct 2023 07:47:24 +0200 Subject: [PATCH] Gentype: support @tag Fixes https://github.com/rescript-lang/rescript-compiler/issues/6436 --- CHANGELOG.md | 1 + jscomp/gentype/Annotation.ml | 8 ++++++++ jscomp/gentype/EmitType.ml | 7 ++++--- jscomp/gentype/GenTypeCommon.ml | 5 +++-- jscomp/gentype/Runtime.ml | 7 +++++-- jscomp/gentype/Runtime.mli | 2 +- jscomp/gentype/TranslateCoreType.ml | 2 +- jscomp/gentype/TranslateTypeDeclarations.ml | 5 +++-- jscomp/gentype/TranslateTypeExprFromTypes.ml | 6 +++--- .../typescript-react-example/package-lock.json | 2 +- .../typescript-react-example/src/Lib.bs.js | 18 ++++++++++++++++++ .../typescript-react-example/src/Lib.gen.tsx | 8 ++++++++ .../typescript-react-example/src/Lib.res | 6 ++++++ 13 files changed, 62 insertions(+), 15 deletions(-) create mode 100644 jscomp/gentype_tests/typescript-react-example/src/Lib.bs.js create mode 100644 jscomp/gentype_tests/typescript-react-example/src/Lib.gen.tsx create mode 100644 jscomp/gentype_tests/typescript-react-example/src/Lib.res diff --git a/CHANGELOG.md b/CHANGELOG.md index d20a75ac05..6ce684e9bb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,6 +15,7 @@ #### :bug: Bug Fix - Fix issue with Dynamic import of module in nested expressions https://github.com/rescript-lang/rescript-compiler/pull/6431 +- Fix issue where GenType was not supporting `@tag` on ordinary variatns https://github.com/rescript-lang/rescript-compiler/pull/6437 # 11.0.0-rc.4 diff --git a/jscomp/gentype/Annotation.ml b/jscomp/gentype/Annotation.ml index be6560fa7f..0bcb24ea90 100644 --- a/jscomp/gentype/Annotation.ml +++ b/jscomp/gentype/Annotation.ml @@ -22,6 +22,9 @@ let tagIsGenTypeAs s = s = "genType.as" || s = "gentype.as" let tagIsAs s = s = "bs.as" || s = "as" let tagIsInt s = s = "bs.int" || s = "int" let tagIsString s = s = "bs.string" || s = "string" + +let tagIsTag s = s = "tag" + let tagIsUnboxed s = s = "unboxed" || s = "ocaml.unboxed" let tagIsGenTypeImport s = s = "genType.import" || s = "gentype.import" let tagIsGenTypeOpaque s = s = "genType.opaque" || s = "gentype.opaque" @@ -146,6 +149,11 @@ let getAttributeImportRenaming attributes = (Some importString, Some renameString) | _ -> (None, genTypeAsRenaming) +let getTag attributes = + match attributes |> getAttributePayload tagIsTag with + | Some (_, StringPayload s) -> Some s + | _ -> None + let getDocPayload attributes = let docPayload = attributes |> getAttributePayload tagIsDoc in match docPayload with diff --git a/jscomp/gentype/EmitType.ml b/jscomp/gentype/EmitType.ml index c8e6601084..f2788e978f 100644 --- a/jscomp/gentype/EmitType.ml +++ b/jscomp/gentype/EmitType.ml @@ -156,7 +156,7 @@ let rec renderType ~(config : Config.t) ?(indent = None) ~typeNameIsInterface |> String.concat ", ") ^ "]" | TypeVar s -> s - | Variant {inherits; noPayloads; payloads; polymorphic; unboxed} -> + | Variant {inherits; noPayloads; payloads; polymorphic; tag; unboxed} -> let inheritsRendered = inherits |> List.map (fun type_ -> @@ -183,7 +183,8 @@ let rec renderType ~(config : Config.t) ?(indent = None) ~typeNameIsInterface in let tagField = case |> labelJSToString - |> field ~name:(Runtime.jsVariantTag ~polymorphic:false) + |> field + ~name:(Runtime.jsVariantTag ~polymorphic:false ~tag) in match (unboxed, type_) with | true, type_ -> @@ -198,7 +199,7 @@ let rec renderType ~(config : Config.t) ?(indent = None) ~typeNameIsInterface (* poly variant *) [ case |> labelJSToString - |> field ~name:(Runtime.jsVariantTag ~polymorphic); + |> field ~name:(Runtime.jsVariantTag ~polymorphic ~tag); type_ |> render |> field ~name:(Runtime.jsVariantValue ~polymorphic); ] diff --git a/jscomp/gentype/GenTypeCommon.ml b/jscomp/gentype/GenTypeCommon.ml index 42c5e9a377..3264ba7bf0 100644 --- a/jscomp/gentype/GenTypeCommon.ml +++ b/jscomp/gentype/GenTypeCommon.ml @@ -99,6 +99,7 @@ and variant = { noPayloads: case list; payloads: payload list; polymorphic: bool; (* If true, this is a polymorphic variant *) + tag: string option; (* The name of the tag field at runtime *) unboxed: bool; } @@ -168,8 +169,8 @@ let rec depToResolvedName (dep : dep) = | Internal resolvedName -> resolvedName | Dot (p, s) -> ResolvedName.dot s (p |> depToResolvedName) -let createVariant ~inherits ~noPayloads ~payloads ~polymorphic ~unboxed = - Variant {inherits; noPayloads; payloads; polymorphic; unboxed} +let createVariant ~inherits ~noPayloads ~payloads ~polymorphic ~tag ~unboxed = + Variant {inherits; noPayloads; payloads; polymorphic; tag; unboxed} let ident ?(builtin = true) ?(typeArgs = []) name = Ident {builtin; name; typeArgs} diff --git a/jscomp/gentype/Runtime.ml b/jscomp/gentype/Runtime.ml index f3085508c7..a6c45736b2 100644 --- a/jscomp/gentype/Runtime.ml +++ b/jscomp/gentype/Runtime.ml @@ -24,10 +24,13 @@ let rec emitModuleAccessPath ~config moduleAccessPath = | Dot (p, moduleItem) -> p |> emitModuleAccessPath ~config |> EmitText.fieldAccess ~label:moduleItem -let jsVariantTag ~polymorphic = +let jsVariantTag ~polymorphic ~tag = match polymorphic with | true -> "NAME" - | false -> "TAG" + | false -> ( + match tag with + | Some tag -> tag + | None -> "TAG") let jsVariantPayloadTag ~n = "_" ^ string_of_int n diff --git a/jscomp/gentype/Runtime.mli b/jscomp/gentype/Runtime.mli index f0fdf3e90b..a6eca6acd9 100644 --- a/jscomp/gentype/Runtime.mli +++ b/jscomp/gentype/Runtime.mli @@ -14,6 +14,6 @@ val newModuleItem : name:string -> moduleItem val newRecordValue : unboxed:bool -> recordGen -> recordValue val recordGen : unit -> recordGen val recordValueToString : recordValue -> string -val jsVariantTag : polymorphic:bool -> string +val jsVariantTag : polymorphic:bool -> tag:string option -> string val jsVariantPayloadTag : n:int -> string val jsVariantValue : polymorphic:bool -> string diff --git a/jscomp/gentype/TranslateCoreType.ml b/jscomp/gentype/TranslateCoreType.ml index be34ad0392..33ee6cd847 100644 --- a/jscomp/gentype/TranslateCoreType.ml +++ b/jscomp/gentype/TranslateCoreType.ml @@ -212,7 +212,7 @@ and translateCoreType_ ~config ~typeVarsGen let inherits = inheritsTranslations |> List.map (fun {type_} -> type_) in let type_ = createVariant ~noPayloads ~payloads ~inherits ~polymorphic:true - ~unboxed:false + ~tag:None ~unboxed:false in let dependencies = (inheritsTranslations diff --git a/jscomp/gentype/TranslateTypeDeclarations.ml b/jscomp/gentype/TranslateTypeDeclarations.ml index 93d3d61838..a11c066391 100644 --- a/jscomp/gentype/TranslateTypeDeclarations.ml +++ b/jscomp/gentype/TranslateTypeDeclarations.ml @@ -66,6 +66,7 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver let unboxedAnnotation = typeAttributes |> Annotation.hasAttribute Annotation.tagIsUnboxed in + let tagAnnotation = typeAttributes |> Annotation.getTag in let returnTypeDeclaration (typeDeclaration : CodeItem.typeDeclaration) = match opaque = Some true with | true -> [{typeDeclaration with importTypes = []}] @@ -203,7 +204,7 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver else variant.payloads in createVariant ~inherits:variant.inherits ~noPayloads ~payloads - ~polymorphic:true ~unboxed:false + ~polymorphic:true ~tag:None ~unboxed:false | _ -> translation.type_ in {translation with type_} |> handleGeneralDeclaration @@ -295,7 +296,7 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver in let variantTyp = createVariant ~inherits:[] ~noPayloads ~payloads ~polymorphic:false - ~unboxed:unboxedAnnotation + ~tag:tagAnnotation ~unboxed:unboxedAnnotation in let resolvedTypeName = typeName |> TypeEnv.addModulePath ~typeEnv in let exportFromTypeDeclaration = diff --git a/jscomp/gentype/TranslateTypeExprFromTypes.ml b/jscomp/gentype/TranslateTypeExprFromTypes.ml index 486dda1ea7..0902bb9e59 100644 --- a/jscomp/gentype/TranslateTypeExprFromTypes.ml +++ b/jscomp/gentype/TranslateTypeExprFromTypes.ml @@ -147,7 +147,7 @@ let translateConstr ~config ~paramsTranslation ~(path : Path.t) ~typeEnv = case 0 "Ok" paramTranslation1.type_; case 1 "Error" paramTranslation2.type_; ] - ~polymorphic:false ~unboxed:false + ~polymorphic:false ~tag:None ~unboxed:false in { dependencies = @@ -386,7 +386,7 @@ and translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv in let type_ = createVariant ~inherits:[] ~noPayloads ~payloads:[] ~polymorphic:true - ~unboxed:false + ~tag:None ~unboxed:false in {dependencies = []; type_} | {noPayloads = []; payloads = [(_label, t)]; unknowns = []} -> @@ -415,7 +415,7 @@ and translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv in let type_ = createVariant ~inherits:[] ~noPayloads ~payloads ~polymorphic:true - ~unboxed:false + ~tag:None ~unboxed:false in let dependencies = payloadTranslations diff --git a/jscomp/gentype_tests/typescript-react-example/package-lock.json b/jscomp/gentype_tests/typescript-react-example/package-lock.json index 89a23a9fa4..7cdf52a5ad 100644 --- a/jscomp/gentype_tests/typescript-react-example/package-lock.json +++ b/jscomp/gentype_tests/typescript-react-example/package-lock.json @@ -21,7 +21,7 @@ }, "../../..": { "name": "rescript", - "version": "11.0.0-rc.4", + "version": "11.0.0-rc.5", "dev": true, "hasInstallScript": true, "license": "SEE LICENSE IN LICENSE", diff --git a/jscomp/gentype_tests/typescript-react-example/src/Lib.bs.js b/jscomp/gentype_tests/typescript-react-example/src/Lib.bs.js new file mode 100644 index 0000000000..744468f41f --- /dev/null +++ b/jscomp/gentype_tests/typescript-react-example/src/Lib.bs.js @@ -0,0 +1,18 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + + +var a = { + action: "A", + _0: "a" +}; + +var b = { + action: "B", + _0: "b" +}; + +export { + a , + b , +} +/* No side effect */ diff --git a/jscomp/gentype_tests/typescript-react-example/src/Lib.gen.tsx b/jscomp/gentype_tests/typescript-react-example/src/Lib.gen.tsx new file mode 100644 index 0000000000..6e686fb3fa --- /dev/null +++ b/jscomp/gentype_tests/typescript-react-example/src/Lib.gen.tsx @@ -0,0 +1,8 @@ +/* TypeScript file generated from Lib.res by genType. */ +/* eslint-disable import/first */ + + +// tslint:disable-next-line:interface-over-type-literal +export type action = + { action: "A"; _0: string } + | { action: "B"; _0: string }; diff --git a/jscomp/gentype_tests/typescript-react-example/src/Lib.res b/jscomp/gentype_tests/typescript-react-example/src/Lib.res new file mode 100644 index 0000000000..9676ebecc7 --- /dev/null +++ b/jscomp/gentype_tests/typescript-react-example/src/Lib.res @@ -0,0 +1,6 @@ +@gentype +@tag("action") +type action = | A(string) | B(string) + +let a = A("a") +let b = B("b")