diff --git a/TYPES.md b/TYPES.md index 67db38e..4ca89c0 100644 --- a/TYPES.md +++ b/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 diff --git a/examples/test/test_bindings.mli b/examples/test/test_bindings.mli index 210e422..6829c68 100644 --- a/examples/test/test_bindings.mli +++ b/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 diff --git a/lib/ojs.ml b/lib/ojs.ml index f9a5b52..139c6e3 100644 --- a/lib/ojs.ml +++ b/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 |] diff --git a/lib/ojs.mli b/lib/ojs.mli index 817d743..ce6473f 100644 --- a/lib/ojs.mli +++ b/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} *) diff --git a/ppx-lib/gen_js_api_ppx.ml b/ppx-lib/gen_js_api_ppx.ml index 877a79c..39f5ba8 100644 --- a/ppx-lib/gen_js_api_ppx.ml +++ b/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