Add [@js.dict], [@@@js.require], [@@js.capitalize]

TYPES.md

@@ -16,6 +16,9 @@ The following types are supported out-of-the-box:
  - Sequences of JS-able types: `array` and `list`, both mapped to JS
    arrays (which are assumed to be indexed by integers 0..length-1).
 
+ - Dictionaries of JS-able types: `(string * 'a) list` mapped to
+   a JS object.
+
  - Options on JS-able types.  They are mapped to the same type as
    their parameter: `None` is mapped to JS `null` value, and both
    `null` and `undefined` are mapped back to `None`.  This encoding
@@ -178,14 +181,18 @@ implementation).  Mutually recursive type declarations are supported.
   be mutable (but conversions still create copies).
   Polymorphic fields are not yet supported.
 
-  OCaml record values of this type are mapped to JS objects (one
-  property per field).  By default, property names are equal to OCaml
-  labels, but this can be changed manually with a `[@js]` attribute.
+  OCaml record values of this type are mapped to JS objects (one property per
+  field).  By default, property names are equal to the OCaml labels converted to
+  camelCase, but this can be changed manually with a `[@js]` attribute.
 
   ```ocaml
   type myType = { x : int; y : int [@js "Y"]}
   ```
 
+  If one needs the JS labels to be capitalized (ie `CamelCase` instead of
+  `camelCase`) this can be achieved by adding the `[@js.capitalize]` attribute
+  to a record label or `[@@js.capitalize]` to the whole record type declaration.
+
 - Parametrized Type:
 
   It is allowed to parametrize types processed by gen_js_api as long as
@@ -205,6 +212,20 @@ implementation).  Mutually recursive type declarations are supported.
 
 - Sum type declaration with non constant constructors, mapped to records with a discriminator field (see Sum types section).
 
+
+- Association lists, mapped to JS objects
+
+  It is possible to annotate an OCaml type declaration of the form
+  ```
+  (string * ty) list
+  ```
+  (where `ty` is any JS-able type) with `[@js.dict]`. When this is done, values
+  of this type will be mapped to JS objects in the obvious way.
+
+  ```ocaml
+  type t = { headers: ((string * string) list [@js.dict]) }
+  ```
+
 - Arbitrary type with custom mappings
 
   If you want to use a type that is not supported by gen_js_api, you can make it JS-able by providing
@@ -475,4 +496,3 @@ end
 You can also create safe bindings manually with the low level functions
 provided by `Ojs` module. See the [section on manually created bindings](LOW_LEVEL_BINDING.md)
 for more information.
-

VALUES.md

@@ -363,6 +363,28 @@ For instance, the following annotated modules will generate the same code:
   end [@js.scope "inner"] [@js.scope "outer"]
 ```
 
+Require
+-------
+
+The signature attribute `[@@@js.require "name"]` is equivalent to making the
+current global object the result of `require("name")`. This is useful to bind
+Node libraries. For instance,
+
+```ocaml
+module C: sig
+  [@@@js.require "crypto"]
+  type hash
+  val create_hash: unit -> hash [@@js.global]
+end
+```
+
+will bind the `createHash` function of the Node library `crypto`, somewhat as if
+we had written
+```
+const { createHash } = require("crypto")
+```
+in Node.
+
 First-class modules
 -------------------
 

examples/test/main.ml

@@ -341,3 +341,9 @@ let () =
   | hd :: tl -> Cons (hd, of_list tl)
   in
   Console3.log ([%js.of: int t] (of_list [1;2;3]))
+
+include [%js:
+  [@@@js.require "elephant"]
+  val x : int [@@js.global]
+  val y : string [@@js.global]
+       ]

examples/test/test_bindings.mli

@@ -352,3 +352,15 @@ module Variants : sig
   end
 
 end
+
+module Dict : sig
+  type t = { item_chosen : ((string * int) list [@js.dict]) } [@@js.capitalize]
+  type s = { foo: int [@js.capitalize]; bar: string }
+end
+
+module X : sig
+  [@@@js.require "foo"]
+
+  val x : int -> int [@@js.global]
+  val y : string [@@js.global]
+end

lib/ojs.ml

@@ -121,6 +121,16 @@ external iter_properties_untyped : t -> t -> unit = "caml_ojs_iterate_properties
 let iter_properties x f =
   iter_properties_untyped x (fun_to_js 1 (fun x -> f (string_of_js x)))
 
+let dict_of_js f t =
+  let l = ref [] in
+  iter_properties t (fun k -> l := (k, f (get_prop_ascii t k)) :: !l);
+  !l
+
+let dict_to_js f x =
+  let t = empty_obj () in
+  List.iter (fun (k, v) -> set_prop_ascii t k (f v)) x;
+  t
+
 let apply_arr o arr = call o "apply" [| null; arr |]
 let call_arr o s arr = call (get_prop o (string_to_js s)) "apply" [| o; arr |]
 

lib/ojs.mli

@@ -42,6 +42,8 @@ val option_to_js: ('a -> t) -> 'a option -> t
 val unit_of_js: t -> unit
 val unit_to_js: unit -> t
 
+val dict_of_js: (t -> 'a) -> t -> (string * 'a) list
+val dict_to_js: ('a -> t) -> (string * 'a) list -> t
 
 (** {2 Wrap OCaml functions as JS functions} *)
 

ppx-lib/gen_js_api_ppx.ml

@@ -208,7 +208,7 @@ let js_name ~global_attrs ?(capitalize = false) name =
   else
     let n = String.length name in
     let buf = Buffer.create n in
-    let capitalize = ref capitalize in
+    let capitalize = ref (has_attribute "js.capitalize" global_attrs || capitalize) in
     for i = 0 to n-1 do
       let c = name.[i] in
       if c = '_' then capitalize := true
@@ -247,6 +247,7 @@ type typ =
                  global_attrs:attributes;
                  attributes:attributes;
                  constrs:constructor list }
+  | Dict of typ
   | Tuple of typ list
   | Typ_var of string
   | Packaged_type of { local_name:  string; (* `a` specified by `(type a)`*)
@@ -375,12 +376,41 @@ type decl =
   | Open of Parsetree.open_description
   | Include of Parsetree.module_expr Parsetree.include_infos
 
+(** Utilities for code generation *)
+
+let longident_parse x = Longident.parse x [@@ocaml.alert "-deprecated"]
+
+let var x = Exp.ident (mknoloc (longident_parse x))
+let str s = Exp.constant (Pconst_string (s, Location.none, None))
+let int_of_repr n = Exp.constant (Pconst_integer (n, None))
+let int n = int_of_repr (string_of_int n)
+let float_of_repr f = Exp.constant (Pconst_float (f, None))
+let bool b = Exp.construct (mknoloc (longident_parse (if b then "true" else "false"))) None
+let pat_int n = Pat.constant (Pconst_integer (n, None))
+let pat_float f = Pat.constant (Pconst_float (f, None))
+let pat_str s = Pat.constant (Pconst_string (s, Location.none, None))
+let pat_bool b = Pat.construct (mknoloc (longident_parse (if b then "true" else "false"))) None
+
+let attr s e = (Attr.mk (mknoloc s) (PStr [Str.eval e]))
+
+let nolabel args = List.map (function x -> Nolabel, x) args
+
+let ojs_typ = Typ.constr (mknoloc (Ldot (Lident "Ojs", "t"))) []
+
+let ojs_var s = Exp.ident (mknoloc (Ldot (Lident "Ojs", s)))
+
+let ojs s args = Exp.apply (ojs_var s) (nolabel args)
+
+let ojs_null = ojs_var "null"
+
+let node_require e =
+  ojs "apply" [ojs "variable" [str "require"]; Exp.array [ojs "string_to_js" [e]]]
+
 (** Parsing *)
 
 let local_type_of_type_var label =
   "__"^label
 
-
 let neg_variance = function
   | -1 -> 1
   | 0 | 1 -> -1
@@ -442,6 +472,11 @@ and parse_typ ~variance ctx ~global_attrs ty =
       begin match String.concat "." (Longident.flatten_exn lid), tl with
       | "unit", [] -> Unit ty.ptyp_loc
       | "Ojs.t", [] -> Js
+      | "list", [{ptyp_desc =
+                  Ptyp_tuple
+                    [{ptyp_desc = Ptyp_constr ({txt = Lident "string"; _}, []); _}; t];
+                  _}] when has_attribute "js.dict" ty.ptyp_attributes ->
+          Dict (parse_typ ~variance ctx ~global_attrs t)
       | s, tl -> Name (s, List.map (parse_typ ~variance ctx ~global_attrs) tl)
       end
   | Ptyp_variant (rows, Closed, None) ->
@@ -665,6 +700,12 @@ let rec parse_sig_item ~global_attrs rest s =
       RecModule (List.map mapper mds) :: rest ~global_attrs
   | Psig_class cs -> Class (List.map (parse_class_decl ~global_attrs) cs) :: rest ~global_attrs
   | Psig_attribute ({attr_payload = PStr str; _} as attribute) when filter_attr_name "js.implem" attribute -> Implem str :: rest ~global_attrs
+  | Psig_attribute ({attr_payload =
+                       PStr [{pstr_desc = Pstr_eval (e, _); _}]; _} as attribute) when filter_attr_name "js.require" attribute ->
+      let name = "__require" in
+      (* There can be only one in scope at any given time, so no possibility of shadowing. *)
+      let global_attrs = attr "js.scope" (Exp.ident (mknoloc (Lident name))) :: global_attrs in
+      Implem [Str.value Nonrecursive [Vb.mk (Pat.var (mknoloc name)) (node_require e)]] :: rest ~global_attrs
   | Psig_attribute attribute ->
       let global_attrs = attribute :: global_attrs in
       rest ~global_attrs
@@ -776,21 +817,6 @@ and parse_class_field ~global_attrs = function
 
 (** Code generation *)
 
-let longident_parse x = Longident.parse x [@@ocaml.alert "-deprecated"]
-
-let var x = Exp.ident (mknoloc (longident_parse x))
-let str s = Exp.constant (Pconst_string (s, Location.none, None))
-let int_of_repr n = Exp.constant (Pconst_integer (n, None))
-let int n = int_of_repr (string_of_int n)
-let float_of_repr f = Exp.constant (Pconst_float (f, None))
-let bool b = Exp.construct (mknoloc (longident_parse (if b then "true" else "false"))) None
-let pat_int n = Pat.constant (Pconst_integer (n, None))
-let pat_float f = Pat.constant (Pconst_float (f, None))
-let pat_str s = Pat.constant (Pconst_string (s, Location.none, None))
-let pat_bool b = Pat.construct (mknoloc (longident_parse (if b then "true" else "false"))) None
-
-let attr s e = (Attr.mk (mknoloc s) (PStr [Str.eval e]))
-
 let disable_warnings = Str.attribute (attr "ocaml.warning" (str "-7-32-39"))
 (*  7: method overridden.
     32: unused value declarations (when *_of_js, *_to_js are not needed)
@@ -802,16 +828,6 @@ let incl = function
   | [x] -> x
   | str -> Str.include_ (Incl.mk (Mod.structure str))
 
-let nolabel args = List.map (function x -> Nolabel, x) args
-
-let ojs_typ = Typ.constr (mknoloc (longident_parse "Ojs.t")) []
-
-let ojs_var s = Exp.ident (mknoloc (Ldot (Lident "Ojs", s)))
-
-let ojs s args = Exp.apply (ojs_var s) (nolabel args)
-
-let ojs_null = ojs_var "null"
-
 let list_iter f x =
   Exp.apply (Exp.ident (mknoloc (longident_parse "List.iter"))) (nolabel [f; x])
 
@@ -1087,6 +1103,8 @@ let rec js2ml ty exp =
       app (var ("Obj.magic")) (nolabel ([exp])) false
   | Packaged_type { module_name; _ } ->
       app (var (module_name ^ ".t_of_js")) (nolabel [exp]) false
+  | Dict typ ->
+      app (var "Ojs.dict_of_js") (nolabel [js2ml_fun ~eta:true typ; exp]) false
 
 and js2ml_of_variant ~variant loc ~global_attrs attrs constrs exp =
   let variant_kind = get_variant_kind loc attrs in
@@ -1343,6 +1361,8 @@ and ml2js ty exp =
       app (var ("Obj.magic")) (nolabel ([exp])) false
   | Packaged_type { module_name; _ } ->
       app (var (module_name ^ ".t_to_js")) (nolabel [exp]) false
+  | Dict typ ->
+      app (var "Ojs.dict_to_js") (nolabel [ml2js_fun ~eta:true typ; exp]) false
 
 and ml2js_discriminator ~global_attrs mlconstr attributes =
   match get_js_constr ~global_attrs mlconstr attributes with
@@ -1567,6 +1587,9 @@ and gen_typ ?(packaged_type_as_type_var = false) = function
   | Packaged_type { local_name; _ } ->
     if packaged_type_as_type_var then Typ.var local_name
     else Typ.constr (mknoloc (Lident local_name)) []
+  | Dict typ ->
+      Typ.constr (mknoloc (Lident "list"))
+        [gen_typ ~packaged_type_as_type_var (Tuple [Name ("string", []); typ])]
 
 and mkfun ?typ ?eta f =
   let s = fresh () in
@@ -1584,15 +1607,14 @@ let process_fields ctx ~global_attrs l =
   let typ = l.pld_type in
   let jsname =
     match get_string_attribute "js" attrs with
-    | None -> js_name ~global_attrs mlname
+    | None -> js_name ~global_attrs ~capitalize:(has_attribute "js.capitalize" attrs) mlname
     | Some s -> s
   in
   loc,
   mknoloc (Lident mlname), (* OCaml label *)
   jsname, (* JS name *)
   parse_typ ctx ~global_attrs typ
 
-
 let global_object ~global_attrs =
   let rec traverse = function
     | [] -> ojs_global