Add support for [@js.dict]

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
@@ -205,6 +208,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

examples/test/test_bindings.mli

@@ -352,3 +352,7 @@ module Variants : sig
   end
 
 end
+
+module Dict : sig
+  type t = { h : ((string * int) list [@js.dict]) }
+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

@@ -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)`*)
@@ -442,6 +443,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) ->
@@ -1087,6 +1093,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 +1351,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 +1577,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