Upgrade gen_js_api to 1.0.9

Author: cannorin

dist_jsoo/ts2ocaml-jsoo-stdlib.opam

@@ -13,7 +13,7 @@ bug-reports: "https://github.com/ocsigen/ts2ocaml/issues"
 depends: [
   "dune" {>= "2.7"}
   "ocaml" {>= "4.08"}
-  "ojs" {>= "1.0.8"}
+  "ojs" {>= "1.0.9"}
   "odoc" {with-doc}
 ]
 build: [

docs/development.md

@@ -37,13 +37,12 @@ Modules with **\[\<AutoOpen\>\]** does not require `open` to use.
 
 - [.NET SDK 5.0](https://dotnet.microsoft.com/download/dotnet/5.0)
   - [FAKE](https://fake.build/) and [Fable](https://fable.io/) are required to build this tool.
-    - Run `dotnet tool restore` in the root directory of this repo to install them.
+  - Run `dotnet tool restore` in the root directory of this repo to install them.
 
 - OCaml 4.08 or higher
   - [js_of_ocaml](https://github.com/ocsigen/js_of_ocaml) should be installed to your opam switch.
-  - The latest [gen_js_api](https://github.com/LexiFi/gen_js_api) should also be installed to your opam switch.
-    - As of Oct 2021, most of the required features have not been present in the latest version in opam.
-    - You should install the latest version by `opam pin add gen_js_api https://github.com/LexiFi/gen_js_api.git`
+  - [gen_js_api](https://github.com/LexiFi/gen_js_api) `>= 1.0.9` should also be installed to your opam switch.
+  - Run `opam install . --deps-only` to install all the dependencies.
 
 - Node 14.0 or higher
   - [yarn](https://yarnpkg.com/) is required.

docs/js_of_ocaml.md

@@ -15,14 +15,7 @@ The documentation for the `ts2ocaml` command and its options comes after the wal
 
 `ts2ocaml` for `js_of_ocaml` generates `.mli` files, which should then be processed with [`LexiFi/gen_js_api`](https://github.com/LexiFi/gen_js_api).
 
-You should use the latest `gen_js_api` as `ts2ocaml` uses the latest features of `gen_js_api`.
-As of Oct 2021, most of the required features have not been present in the latest version in opam.
-So you would have to either do
-
-* `opam pin add gen_js_api https://github.com/LexiFi/gen_js_api.git` **(recommended)**, or
-* `git submodule` [their repository](https://github.com/LexiFi/gen_js_api) to the `lib` directory of your OCaml project.
-  - Note that if you use `gen_js_api` via a submodule, it might conflict with [`ts2ocaml-jsoo-stdlib`](#using-ts2ocaml-jsoo-stdlib-package) which is installed via `ocaml pin add`.
-  - Therefore, this would work only if you are going to do [`ts2ocaml jsoo --create-minimal-stdlib`](#using---create-minimal-stdlib--create-minimal-stdlib).
+You should use `gen_js_api` version 1.0.9 or higher, as `ts2ocaml` uses the latest features of `gen_js_api`.
 
 ## Adding the standard library
 
@@ -40,8 +33,7 @@ To fulfill both needs, we've made two ways to add the standard library.
 
 This package contains the full bindings for JS, DOM, and Web Worker API, generated with the [`full` preset](#choosing-a-preset).
 
-As described in [Requirements](#requirements), `ts2ocaml` needs the latest `gen_js_api`, which is still not present in OPAM repository.
-So, `ts2ocaml-jsoo-stdlib` is currently **not in OPAM repository**.
+`ts2ocaml-jsoo-stdlib` is currently **not in OPAM repository**.
 
 To install it to your OPAM switch, we recommend you to use [`opam pin`](https://opam.ocaml.org/doc/Usage.html#opam-pin).
 

src/Targets/JsOfOCaml/Writer.fs

@@ -98,6 +98,17 @@ let anonymousInterfaceToIdentifier (ctx: Context) (c: Class) : text =
   | None, None -> failwithf "the anonymous interface '%A' is not found in the context" c
   | _, Some n -> failwithf "the class or interface '%s' is not anonymous" n
 
+let enumCaseToIdentifier (e: Enum) (c: EnumCase) =
+  let duplicateCases =
+    e.cases |> List.filter (fun c' -> c.value = c'.value)
+  match duplicateCases with
+  | [] -> failwith "impossible_enumCaseToIdentifier"
+  | [c'] ->
+    assert (c = c')
+    Naming.constructorName [c.name]
+  | cs ->
+    cs |> List.map (fun c -> c.name) |> Naming.constructorName
+
 type Variance = Covariant | Contravariant | Invariant with
   static member (~-) (v: Variance) =
     match v with
@@ -149,13 +160,21 @@ module OverrideFunc =
 let rec emitTypeImpl (flags: EmitTypeFlags) (overrideFunc: OverrideFunc) (ctx: Context) (ty: Type) : text =
   let forceSkipAttr text =
     if flags.forceSkipAttributes then empty else text
-  let treatEnum (flags: EmitTypeFlags) ctx (cases: Set<Choice<EnumCase, Literal>>) =
+  let treatEnum (flags: EmitTypeFlags) ctx (cases: Set<Choice<Enum * EnumCase, Literal>>) =
+    let usedValues =
+      cases
+      |> Seq.choose (function Choice1Of2 (_, { value = v }) -> v | _ -> None)
+      |> Set.ofSeq
+    let cases =
+      cases
+      // Remove literal cases (e.g. `42`) when it is a duplicate of some enum case (e.g. `Case = 42`).
+      |> Set.filter (function Choice2Of2 l when usedValues |> Set.contains l -> false | _ -> true)
+      // Convert to identifiers while merging duplicate enum cases
+      |> Set.map (function
+        | Choice1Of2 (e, c) -> enumCaseToIdentifier e c |> str, c.value
+        | Choice2Of2 l -> "L_" @+ literalToIdentifier ctx l, Some l)
     between "[" "]" (concat (str " | ") [
-      for c in Set.toSeq cases do
-        let name, value =
-          match c with
-          | Choice1Of2 e -> str (Naming.constructorName [e.name]), e.value
-          | Choice2Of2 l -> "L_" @+ literalToIdentifier ctx l, Some l
+      for name, value in Set.toSeq cases do
         let attr =
           match value with
           | _ when flags.forceSkipAttributes -> empty
@@ -333,7 +352,7 @@ let rec emitTypeImpl (flags: EmitTypeFlags) (overrideFunc: OverrideFunc) (ctx: C
             failwith "impossible_emitResolvedUnion_treatOther_go"
           else
             otherTypes |> Set.toList |> List.map (emitTypeImpl flags overrideFunc ctx) |> safe_union_t
-        let treatEnumOr (cases: Set<Choice<EnumCase, Literal>>) t =
+        let treatEnumOr (cases: Set<Choice<Enum * EnumCase, Literal>>) t =
           if Set.isEmpty cases then t
           else Type.enum_or (treatEnum flags ctx cases) t
         let treatDUMany du =
@@ -795,16 +814,19 @@ module GetSelfTyText =
       else fallback
     | None -> fallback
 
-  let enumCases (cases: EnumCase list) =
+  let enumCases (e: Enum) (cases: EnumCase list) =
+    let cases =
+      cases
+      |> List.map (fun c -> enumCaseToIdentifier e c, c.value)
+      |> Set.ofList
     between "[" "]" (concat (str " | ") [
-      for c in cases do
-        let name, value = str (Naming.constructorName [c.name]), c.value
+      for name, value in cases |> Set.toSeq do
         let attr =
           match value with
           | Some v -> Attr.js (Term.literal v)
           | None -> empty
-        yield pv_head @+ name + attr
-      ]) +@ " [@js.enum]"
+        yield pv_head @+ name @+ attr
+    ]) +@ " [@js.enum]"
 
 let getExportFromStatement (ctx: Context) (name: string) (kind: Kind list) (kindString: string) (s: Statement) : ExportWithKind option =
   let fn = ctx |> Context.getFullName [name]
@@ -1107,15 +1129,15 @@ let createStructuredText (rootCtx: Context) (stmts: Statement list) : Structured
     | EnumDef e ->
       let module' =
         let ctx = ctx |> Context.ofChildNamespace e.name
-        let items = emitTypeAliases emitTypeFlags OverrideFunc.noOverride ctx [] (GetSelfTyText.enumCases e.cases)
+        let items = emitTypeAliases emitTypeFlags OverrideFunc.noOverride ctx [] (GetSelfTyText.enumCases e e.cases)
         let node = {| StructuredTextNode.empty with items = items; docCommentLines = comments; knownTypes = knownTypes () |}
         let module' =
           getModule e.name |> Trie.setOrUpdate node StructuredTextNode.union
         e.cases |> List.fold (fun state c ->
           let ctx = ctx |> Context.ofChildNamespace c.name
           let comments = List.map emitCommentBody c.comments
           let items =
-            emitTypeAliases emitTypeFlags OverrideFunc.noOverride ctx [] (GetSelfTyText.enumCases [c])
+            emitTypeAliases emitTypeFlags OverrideFunc.noOverride ctx [] (GetSelfTyText.enumCases e [c])
           let node = {| StructuredTextNode.empty with items = items; docCommentLines = comments; knownTypes = knownTypes () |}
           state |> Trie.addOrUpdate [c.name] node StructuredTextNode.union
         ) module'
@@ -1365,9 +1387,9 @@ let emitFlattenedDefinitions (ctx: Context) (stmts: Statement list) : text list
     | EnumDef e ->
       let fn = List.rev (e.name :: ctx.currentNamespace)
       [
-        yield tprintf "%s %s = " prefix (Naming.flattenedTypeName fn) + GetSelfTyText.enumCases e.cases
+        yield tprintf "%s %s = " prefix (Naming.flattenedTypeName fn) + GetSelfTyText.enumCases e e.cases
         for c in e.cases do
-          yield tprintf "and %s = " (Naming.flattenedTypeName (fn @ [c.name])) + GetSelfTyText.enumCases [c]
+          yield tprintf "and %s = " (Naming.flattenedTypeName (fn @ [c.name])) + GetSelfTyText.enumCases e [c]
       ]
     | ClassDef c ->
       match c.name with

src/Typer.fs

@@ -1318,7 +1318,7 @@ type ResolvedUnion = {
   caseUndefined: bool
   typeofableTypes: Set<TypeofableType>
   caseArray: Set<Type> option
-  caseEnum: Set<Choice<EnumCase, Literal>>
+  caseEnum: Set<Choice<Enum * EnumCase, Literal>>
   discriminatedUnions: Map<string, Map<Literal, Type>>
   otherTypes: Set<Type>
 }
@@ -1347,8 +1347,8 @@ module ResolvedUnion =
           ru.caseEnum
           |> Set.toSeq
           |> Seq.map (function
-            | Choice1Of2 { name = name; value = Some value } -> sprintf "%s=%s" name (Literal.toString value)
-            | Choice1Of2 { name = name; value = None } -> sprintf "%s=?" name
+            | Choice1Of2 ({ name = ty }, { name = name; value = Some value }) -> sprintf "%s.%s=%s" ty name (Literal.toString value)
+            | Choice1Of2 ({ name = ty }, { name = name; value = None }) -> sprintf "%s.%s=?" ty name
             | Choice2Of2 l -> Literal.toString l)
         yield sprintf "enum<%s>" (cases |> String.concat " | ")
       for k, m in ru.discriminatedUnions |> Map.toSeq do
@@ -1357,7 +1357,7 @@ module ResolvedUnion =
     ]
     cases |> String.concat " | "
 
-  let rec private getEnumFromUnion ctx (u: UnionType) : Set<Choice<EnumCase, Literal>> * UnionType =
+  let rec private getEnumFromUnion ctx (u: UnionType) : Set<Choice<Enum * EnumCase, Literal>> * UnionType =
     let (|Dummy|) _ = []
 
     let rec go t =
@@ -1373,10 +1373,10 @@ module ResolvedUnion =
               let bindings = Type.createBindings fn loc a.typeParams tyargs
               yield! go (a.target |> Type.substTypeVar bindings ())
             | EnumName e ->
-              for c in e.cases do yield Choice1Of2 (Choice1Of2 c)
+              for c in e.cases do yield Choice1Of2 (Choice1Of2 (e, c))
             | EnumCaseName (name, e) ->
               match e.cases |> List.tryFind (fun c -> c.name = name) with
-              | Some c -> yield Choice1Of2 (Choice1Of2 c)
+              | Some c -> yield Choice1Of2 (Choice1Of2 (e, c))
               | None -> yield Choice2Of2 t
             | ClassName _ -> yield Choice2Of2 t
             | _ -> ()

ts2ocaml.opam

@@ -10,10 +10,7 @@ bug-reports: "https://github.com/ocsigen/ts2ocaml/issues"
 depends: [
   "dune" {>= "2.9"}
   "ocaml" {>= "4.08"}
-  "gen_js_api"
+  "gen_js_api" {>= "1.0.9"}
   "js_of_ocaml-compiler"
 ]
-pin-depends: [
-  [ "gen_js_api.dev" "git+https://github.com/LexiFi/gen_js_api.git" ]
-]
 dev-repo: "git+https://github.com/ocsigen/ts2ocaml.git"