diff --git a/TYPES.md b/TYPES.md index 67db38e..4b30235 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 @@ -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. - diff --git a/VALUES.md b/VALUES.md index 37365a6..2b10703 100644 --- a/VALUES.md +++ b/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 ------------------- diff --git a/examples/test/main.ml b/examples/test/main.ml index 55b751e..63615d5 100644 --- a/examples/test/main.ml +++ b/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] + ] diff --git a/examples/test/test_bindings.mli b/examples/test/test_bindings.mli index 210e422..2031b16 100644 --- a/examples/test/test_bindings.mli +++ b/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 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..759f132 100644 --- a/ppx-lib/gen_js_api_ppx.ml +++ b/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,7 +1607,7 @@ 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, @@ -1592,7 +1615,6 @@ let process_fields ctx ~global_attrs l = jsname, (* JS name *) parse_typ ctx ~global_attrs typ - let global_object ~global_attrs = let rec traverse = function | [] -> ojs_global