Add bindings to Promise.allSettled

CHANGELOG.md

@@ -19,6 +19,7 @@
 #### :bug: Bug Fix
 
 - Make "rescript format" work with node 10 again and set minimum required node version to 10 in package.json. https://github.com/rescript-lang/rescript-compiler/pull/6186
+- GenType: add support for custom `@tag` in variant type declaration. https://github.com/rescript-lang/rescript-compiler/pull/6137/files
 
 # 11.0.0-alpha.4
 

jscomp/gentype/Annotation.ml

@@ -22,6 +22,8 @@ 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"
@@ -123,6 +125,11 @@ let getAsString attributes =
   | Some (_, StringPayload s) -> Some s
   | _ -> None
 
+let getTag attributes =
+  match attributes |> getAttributePayload tagIsTag with
+  | Some (_, StringPayload s) -> Some s
+  | _ -> None
+
 let getAsInt attributes =
   match attributes |> getAttributePayload tagIsAs with
   | Some (_, IntPayload s) -> (

jscomp/gentype/EmitType.ml

@@ -170,7 +170,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; unboxed; customTag} ->
     let inheritsRendered =
       inherits
       |> List.map (fun type_ ->
@@ -196,15 +196,15 @@ let rec renderType ~(config : Config.t) ?(indent = None) ~typeNameIsInterface
              in
              let tagField =
                case |> labelJSToString
-               |> field ~name:(Runtime.jsVariantTag ~polymorphic:false)
+               |> field ~name:(Runtime.jsVariantTag ~customTag)
              in
              match (unboxed, type_) with
              | true, type_ -> type_ |> render
              | false, type_ when polymorphic ->
                (* poly variant *)
                [
                  case |> labelJSToString
-                 |> field ~name:(Runtime.jsVariantTag ~polymorphic);
+                 |> field ~name:Runtime.jsPolymorphicVariantTag;
                  type_ |> render
                  |> field ~name:(Runtime.jsVariantValue ~polymorphic);
                ]

jscomp/gentype/GenTypeCommon.ml

@@ -90,6 +90,7 @@ and variant = {
   payloads: payload list;
   polymorphic: bool; (* If true, this is a polymorphic variant *)
   unboxed: bool;
+  customTag: string option;
 }
 
 and payload = {case: case; t: type_}
@@ -158,8 +159,9 @@ 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 ~unboxed
+    ~customTag =
+  Variant {inherits; noPayloads; payloads; polymorphic; unboxed; customTag}
 
 let ident ?(builtin = true) ?(typeArgs = []) name =
   Ident {builtin; name; typeArgs}

jscomp/gentype/Runtime.ml

@@ -24,10 +24,11 @@ let rec emitModuleAccessPath ~config moduleAccessPath =
   | Dot (p, moduleItem) ->
     p |> emitModuleAccessPath ~config |> EmitText.fieldAccess ~label:moduleItem
 
-let jsVariantTag ~polymorphic =
-  match polymorphic with
-  | true -> "NAME"
-  | false -> "TAG"
+let jsVariantTag ~customTag =
+  match customTag with
+  | None -> "TAG"
+  | Some tag -> tag
+let jsPolymorphicVariantTag = "NAME"
 
 let jsVariantPayloadTag ~n = "_" ^ string_of_int n
 

jscomp/gentype/Runtime.mli

@@ -15,6 +15,7 @@ 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 : customTag:string option -> string
+val jsPolymorphicVariantTag : string
 val jsVariantPayloadTag : n:int -> string
 val jsVariantValue : polymorphic:bool -> string

jscomp/gentype/TranslateCoreType.ml

@@ -213,7 +213,7 @@ and translateCoreType_ ~config ~typeVarsGen
       let inherits = inheritsTranslations |> List.map (fun {type_} -> type_) in
       let type_ =
         createVariant ~noPayloads ~payloads ~inherits ~polymorphic:true
-          ~unboxed:false
+          ~unboxed:false ~customTag:None
       in
       let dependencies =
         (inheritsTranslations

jscomp/gentype/TranslateTypeDeclarations.ml

@@ -63,6 +63,7 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver
   let unboxedAnnotation =
     typeAttributes |> Annotation.hasAttribute Annotation.tagIsUnboxed
   in
+  let customTag = typeAttributes |> Annotation.getTag in
   let returnTypeDeclaration (typeDeclaration : CodeItem.typeDeclaration) =
     match opaque = Some true with
     | true -> [{typeDeclaration with importTypes = []}]
@@ -197,7 +198,7 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver
           else variant.payloads
         in
         createVariant ~inherits:variant.inherits ~noPayloads ~payloads
-          ~polymorphic:true ~unboxed:false
+          ~polymorphic:true ~unboxed:false ~customTag:None
       | _ -> translation.type_
     in
     {translation with type_} |> handleGeneralDeclaration
@@ -289,7 +290,7 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver
     in
     let variantTyp =
       createVariant ~inherits:[] ~noPayloads ~payloads ~polymorphic:false
-        ~unboxed:unboxedAnnotation
+        ~unboxed:unboxedAnnotation ~customTag
     in
     let resolvedTypeName = typeName |> TypeEnv.addModulePath ~typeEnv in
     let exportFromTypeDeclaration =

jscomp/gentype/TranslateTypeExprFromTypes.ml

@@ -141,7 +141,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 ~unboxed:false ~customTag:None
     in
     {
       dependencies =
@@ -382,7 +382,7 @@ and translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv
       in
       let type_ =
         createVariant ~inherits:[] ~noPayloads ~payloads:[] ~polymorphic:true
-          ~unboxed:false
+          ~unboxed:false ~customTag:None
       in
       {dependencies = []; type_}
     | {noPayloads = []; payloads = [(_label, t)]; unknowns = []} ->
@@ -411,7 +411,7 @@ and translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv
       in
       let type_ =
         createVariant ~inherits:[] ~noPayloads ~payloads ~polymorphic:true
-          ~unboxed:false
+          ~unboxed:false ~customTag:None
       in
       let dependencies =
         payloadTranslations

jscomp/gentype_tests/typescript-react-example/src/TestPromise.gen.tsx

@@ -15,6 +15,14 @@ export type fromPayload = { readonly x: number; readonly s: string };
 // tslint:disable-next-line:interface-over-type-literal
 export type toPayload = { readonly result: string };
 
+// tslint:disable-next-line:interface-over-type-literal
+export type settledResult<a> = 
+    { status: "fulfilled"; readonly value: a }
+  | { status: "rejected"; readonly reason: unknown };
+
+// tslint:disable-next-line:interface-over-type-literal
+export type settled = settledResult<string>;
+
 export const convert: (_1:Promise<fromPayload>) => Promise<toPayload> = TestPromiseBS.convert;
 
 export const barx: (_1:{ readonly x?: Promise<(undefined | string)> }, _2:void) => boolean = TestPromiseBS.barx;

jscomp/gentype_tests/typescript-react-example/src/TestPromise.res

@@ -11,3 +11,11 @@ type fromPayload = {
 @genType let convert = Js.Promise.then_(({s}) => Js.Promise.resolve({result: s}))
 
 @genType let barx = (~x=Js.Promise.resolve(Some("a")), ()) => x == x
+
+@genType
+@tag("status")
+type settledResult<+'a> =
+  | @as("fulfilled") Fulfilled({value: 'a}) | @as("rejected") Rejected({reason: unknown})
+
+@genType
+type settled = settledResult<string>

jscomp/others/js_promise2.res

@@ -1,6 +1,10 @@
 type t<+'a> = promise<'a>
 type error
 
+@tag("status")
+type settledResult<+'a> =
+  | @as("fulfilled") Fulfilled({value: 'a}) | @as("rejected") Rejected({reason: unknown})
+
 /** Type-safe t-first then */
 let then: (promise<'a>, 'a => promise<'b>) => promise<'b> = %raw(`
   function(p, cont) {
@@ -52,6 +56,53 @@ external all6: (
   (promise<'a0>, promise<'a1>, promise<'a2>, promise<'a3>, promise<'a4>, promise<'a5>)
 ) => promise<('a0, 'a1, 'a2, 'a3, 'a4, 'a5)> = "all"
 
+@val @scope("Promise")
+external allSettled: array<promise<'a>> => promise<array<settledResult<'a>>> = "allSettled"
+
+@val @scope("Promise")
+external allSettled2: ((promise<'a0>, promise<'a1>)) => promise<(
+  settledResult<'a0>,
+  settledResult<'a1>,
+)> = "allSettled"
+
+@val @scope("Promise")
+external allSettled3: ((promise<'a0>, promise<'a1>, promise<'a2>)) => promise<(
+  settledResult<'a0>,
+  settledResult<'a1>,
+  settledResult<'a2>,
+)> = "allSettled"
+
+@val @scope("Promise")
+external allSettled4: ((promise<'a0>, promise<'a1>, promise<'a2>, promise<'a3>)) => promise<(
+  settledResult<'a0>,
+  settledResult<'a1>,
+  settledResult<'a2>,
+  settledResult<'a3>,
+)> = "allSettled"
+
+@val @scope("Promise")
+external allSettled5: (
+  (promise<'a0>, promise<'a1>, promise<'a2>, promise<'a3>, promise<'a4>)
+) => promise<(
+  settledResult<'a0>,
+  settledResult<'a1>,
+  settledResult<'a2>,
+  settledResult<'a3>,
+  settledResult<'a4>,
+)> = "allSettled"
+
+@val @scope("Promise")
+external allSettled6: (
+  (promise<'a0>, promise<'a1>, promise<'a2>, promise<'a3>, promise<'a4>, promise<'a5>)
+) => promise<(
+  settledResult<'a0>,
+  settledResult<'a1>,
+  settledResult<'a2>,
+  settledResult<'a3>,
+  settledResult<'a4>,
+  settledResult<'a5>,
+)> = "allSettled"
+
 @val @scope("Promise") external race: array<promise<'a>> => promise<'a> = "race"
 
 external unsafe_async: 'a => promise<'a> = "%identity"

jscomp/runtime/release.ninja

@@ -21,7 +21,7 @@ o runtime/caml_bytes.cmj : cc_cmi runtime/caml_bytes.ml | runtime/caml_bytes.cmi
 o runtime/caml_bytes.cmi : cc runtime/caml_bytes.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
 o runtime/caml_float.cmj : cc_cmi runtime/caml_float.ml | runtime/caml_float.cmi runtime/caml_float_extern.cmj
 o runtime/caml_float.cmi : cc runtime/caml_float.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
-o runtime/caml_format.cmj : cc_cmi runtime/caml_format.ml | runtime/caml.cmj runtime/caml_float.cmj runtime/caml_float_extern.cmj runtime/caml_format.cmi runtime/caml_int64.cmj runtime/caml_int64_extern.cmj runtime/caml_nativeint_extern.cmj runtime/caml_string_extern.cmj
+o runtime/caml_format.cmj : cc_cmi runtime/caml_format.ml | runtime/caml_float.cmj runtime/caml_float_extern.cmj runtime/caml_format.cmi runtime/caml_int64.cmj runtime/caml_int64_extern.cmj runtime/caml_nativeint_extern.cmj runtime/caml_string_extern.cmj
 o runtime/caml_format.cmi : cc runtime/caml_format.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
 o runtime/caml_hash.cmj : cc_cmi runtime/caml_hash.ml | runtime/caml_hash.cmi runtime/caml_hash_primitive.cmj runtime/caml_nativeint_extern.cmj runtime/js.cmj
 o runtime/caml_hash.cmi : cc runtime/caml_hash.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
@@ -37,7 +37,7 @@ o runtime/caml_md5.cmj : cc_cmi runtime/caml_md5.ml | runtime/caml_array_extern.
 o runtime/caml_md5.cmi : cc runtime/caml_md5.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
 o runtime/caml_module.cmj : cc_cmi runtime/caml_module.ml | runtime/caml_array_extern.cmj runtime/caml_module.cmi runtime/caml_obj.cmj
 o runtime/caml_module.cmi : cc runtime/caml_module.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
-o runtime/caml_obj.cmj : cc_cmi runtime/caml_obj.res | runtime/caml.cmj runtime/caml_array_extern.cmj runtime/caml_obj.cmi runtime/caml_option.cmj runtime/js.cmj
+o runtime/caml_obj.cmj : cc_cmi runtime/caml_obj.res | runtime/caml_array_extern.cmj runtime/caml_obj.cmi runtime/caml_option.cmj runtime/js.cmj
 o runtime/caml_obj.cmi : cc runtime/caml_obj.resi | runtime/js.cmj
 o runtime/caml_option.cmj : cc_cmi runtime/caml_option.ml | runtime/caml_option.cmi runtime/caml_undefined_extern.cmj runtime/js.cmj
 o runtime/caml_option.cmi : cc runtime/caml_option.mli | runtime/bs_stdlib_mini.cmi runtime/caml_undefined_extern.cmj runtime/js.cmi runtime/js.cmj
@@ -54,7 +54,7 @@ o runtime/caml_exceptions.cmi runtime/caml_exceptions.cmj : cc runtime/caml_exce
 o runtime/caml_external_polyfill.cmi runtime/caml_external_polyfill.cmj : cc runtime/caml_external_polyfill.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
 o runtime/caml_float_extern.cmi runtime/caml_float_extern.cmj : cc runtime/caml_float_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
 o runtime/caml_int64_extern.cmi runtime/caml_int64_extern.cmj : cc runtime/caml_int64_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
-o runtime/caml_js_exceptions.cmi runtime/caml_js_exceptions.cmj : cc runtime/caml_js_exceptions.ml | runtime/bs_stdlib_mini.cmi runtime/caml_exceptions.cmj runtime/caml_option.cmj runtime/js.cmi runtime/js.cmj
+o runtime/caml_js_exceptions.cmi runtime/caml_js_exceptions.cmj : cc runtime/caml_js_exceptions.ml | runtime/bs_stdlib_mini.cmi runtime/caml_exceptions.cmj runtime/js.cmi runtime/js.cmj
 o runtime/caml_nativeint_extern.cmi runtime/caml_nativeint_extern.cmj : cc runtime/caml_nativeint_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
 o runtime/caml_string_extern.cmi runtime/caml_string_extern.cmj : cc runtime/caml_string_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
 o runtime/caml_undefined_extern.cmi runtime/caml_undefined_extern.cmj : cc runtime/caml_undefined_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj

jscomp/test/test_promise.res

@@ -0,0 +1,9 @@
+let p1 = Js.Promise2.make((~resolve, ~reject) => resolve(1))
+let p2 = Js.Promise2.make((~resolve, ~reject) => resolve("foo"))
+
+switch await Js.Promise2.allSettled2((p1, p2)) {
+| (Fulfilled({value: v1}), Fulfilled({value: v2})) => Js.log2(v1, v2)
+| (Rejected({reason}), Fulfilled(_)) => Js.log2("first rejected", reason)
+| (Fulfilled(_), Rejected({reason})) => Js.log2("second rejected", reason)
+| _ => Js.log("both rejected")
+}