Register "js" as a deriving plugin

node-test/bindings/arrays.mli

@@ -1,8 +1,6 @@
 module JsArray (E:
   sig
-    type t
-    val t_to_js: t -> Ojs.t
-    val t_of_js: Ojs.t -> t
+    type t [@@deriving js]
   end): sig
   type t
   val t_to_js: t -> Ojs.t
@@ -15,8 +13,7 @@ end
 
 module JsString : sig
   type t = string
-  val t_to_js: t -> Ojs.t
-  val t_of_js: Ojs.t -> t
+  [@@deriving js]
 end
 
 module UntypedArray : sig

node-test/bindings/buffer.mli

@@ -1,6 +1,6 @@
 [@@@js.scope "Buffer"]
 
-type t = private Ojs.t [@@js]
+type t = private Ojs.t [@@deriving js]
 
 val alloc: int -> t[@@js.global]
 val from: string -> t[@@js.global]

node-test/bindings/errors.mli

@@ -1,5 +1,5 @@
 module [@js.scope] Error : sig
-  type t [@@js]
+  type t [@@deriving js]
 
   val create: string -> t [@@js.create]
   val stack_trace_limit: int [@@js.global]

node-test/bindings/expected/arrays.ml

@@ -1,7 +1,6 @@
 [@@@js.dummy "!! This code has been generated by gen_js_api !!"]
 [@@@ocaml.warning "-7-32-39"]
-module JsArray(E:sig type t val t_to_js : t -> Ojs.t val t_of_js : Ojs.t -> t
-                 end) =
+module JsArray(E:sig type t[@@deriving js] end) =
   struct
     type t = Ojs.t
     let rec (t_of_js : Ojs.t -> t) = fun x2 -> x2
@@ -16,7 +15,7 @@ module JsArray(E:sig type t val t_to_js : t -> Ojs.t val t_of_js : Ojs.t -> t
   end
 module JsString =
   struct
-    type t = string
+    type t = string[@@deriving js]
     let rec (t_of_js : Ojs.t -> t) = Ojs.string_of_js
     and (t_to_js : t -> Ojs.t) = Ojs.string_to_js
   end

node-test/bindings/expected/buffer.ml

@@ -1,6 +1,6 @@
 [@@@js.dummy "!! This code has been generated by gen_js_api !!"]
 [@@@ocaml.warning "-7-32-39"]
-type t = Ojs.t
+type t = Ojs.t[@@deriving js]
 let rec (t_of_js : Ojs.t -> t) = fun x2 -> x2
 and (t_to_js : t -> Ojs.t) = fun x1 -> x1
 let (alloc : int -> t) =

node-test/bindings/expected/errors.ml

@@ -2,7 +2,7 @@
 [@@@ocaml.warning "-7-32-39"]
 module Error =
   struct
-    type t = Ojs.t
+    type t = Ojs.t[@@deriving js]
     let rec (t_of_js : Ojs.t -> t) = fun x2 -> x2
     and (t_to_js : t -> Ojs.t) = fun x1 -> x1
     let (create : string -> t) =

node-test/bindings/expected/fs.ml

@@ -2,7 +2,7 @@
 [@@@ocaml.warning "-7-32-39"]
 module Dirent =
   struct
-    type t = Ojs.t
+    type t = Ojs.t[@@deriving js]
     let rec (t_of_js : Ojs.t -> t) = fun x2 -> x2
     and (t_to_js : t -> Ojs.t) = fun x1 -> x1
     let (name : t -> string) =
@@ -14,7 +14,7 @@ module Dirent =
   end
 module Dir =
   struct
-    type t = Ojs.t
+    type t = Ojs.t[@@deriving js]
     let rec (t_of_js : Ojs.t -> t) = fun x7 -> x7
     and (t_to_js : t -> Ojs.t) = fun x6 -> x6
     let (path : t -> string) =
@@ -29,7 +29,7 @@ module Dir =
   end
 module FileHandle =
   struct
-    type t = Ojs.t
+    type t = Ojs.t[@@deriving js]
     let rec (t_of_js : Ojs.t -> t) = fun x15 -> x15
     and (t_to_js : t -> Ojs.t) = fun x14 -> x14
     type read = {

node-test/bindings/fs.mli

@@ -1,23 +1,23 @@
 [@@@js.scope Imports.fs_promises]
 
 module Dirent : sig
-  type t = Ojs.t [@@js]
+  type t = Ojs.t [@@deriving js]
 
   val name: t -> string [@@js.get]
   val is_file: t -> bool [@@js.call]
   val is_directory: t -> bool [@@js.call]
 end
 
 module Dir : sig
-  type t = Ojs.t [@@js]
+  type t = Ojs.t [@@deriving js]
 
   val path: t -> string [@@js.get]
   val close: t -> unit Promise.t [@@js.call]
   val read:t -> Dirent.t option Promise.t [@@js.call]
 end
 
 module FileHandle : sig
-  type t = Ojs.t [@@js]
+  type t = Ojs.t [@@deriving js]
 
   type read = {
     bytes_read: int;

node-test/bindings/it.ml

@@ -0,0 +1,58 @@
+module Symbol = [%js:
+  [@@@js.scope "Symbol"]
+  type t = private Ojs.t
+
+  val iterator : t [@@js.global]
+
+  val get: Ojs.t -> t -> Ojs.t
+]
+
+include [%js:
+
+  type next = {
+    value: Ojs.t;
+    is_done: bool; [@js "done"]
+  }
+
+  type t = private Ojs.t
+  val t_of_js: Ojs.t -> t
+  val t_to_js: t -> Ojs.t
+
+  val next: t -> next [@js.call]
+
+]
+
+let iterator o : t option =
+  match
+    [%js.to: (unit -> t) option]
+      (Symbol.get o Symbol.iterator)
+  with
+  | None -> None
+  | Some f -> Some (f ())
+
+let until f it =
+  while
+    let next = next it in
+    not (next.is_done || f next.value)
+  do () done
+
+module Iterable (X : Ojs.T) (K: Ojs.T) = struct
+
+  let until f x =
+    match iterator (X.t_to_js x) with
+    | None -> ()
+    | Some it ->
+      until (fun k -> f (K.t_of_js k)) it
+
+  let iter f x =
+    until (fun k -> f k; false) x
+
+  let fold f x acc =
+    let acc = ref acc in
+    iter
+      (fun k ->
+        acc := f k !acc
+      ) x;
+    !acc
+
+end

node-test/bindings/it.mli

@@ -0,0 +1,13 @@
+type t = private Ojs.t
+val t_to_js: t -> Ojs.t
+val t_of_js: Ojs.t -> t
+
+val iterator: Ojs.t -> t option
+val until: (Ojs.t -> bool) -> t -> unit
+
+module Iterable (X : Ojs.T) (K : Ojs.T):
+  sig
+    val until : (K.t -> bool) -> X.t -> unit
+    val iter : (K.t -> unit) -> X.t -> unit
+    val fold : (K.t -> 'a -> 'a) -> X.t -> 'a -> 'a
+  end

ppx-driver/gen_js_api_ppx_driver.ml

@@ -93,40 +93,31 @@ let () =
       rewriter
     |> Ppxlib.Context_free.Rule.extension
   in
-  let js =
-    Ppxlib.Attribute.declare "js"
-      Ppxlib.Attribute.Context.type_declaration
-      Ppxlib.(Ast_pattern.pstr Ast_pattern.nil) ()
-  in
-  let attr_str_type =
-    let rewriter ~ctxt (rec_flag : Ppxlib.Asttypes.rec_flag) tdl _ =
-      tdl
-      |> List.map (Of_ppxlib.copy_type_declaration)
-      |> Gen_js_api_ppx.type_decl_rewriter
-        ~loc:(Ppxlib.Expansion_context.Deriver.derived_item_loc ctxt)
-        (Of_ppxlib.copy_rec_flag rec_flag)
-      |> To_ppxlib.copy_structure
-    in
-    Ppxlib.Context_free.Rule.attr_str_type_decl
-      js
-      rewriter
-  in
-  let attr_sig_type =
-    let rewriter ~ctxt (_ : Ppxlib.Asttypes.rec_flag) tdl _ =
-      tdl
-      |> List.map (Of_ppxlib.copy_type_declaration)
-      |> Gen_js_api_ppx.type_decl_sig_rewriter
-        ~loc:(Ppxlib.Expansion_context.Deriver.derived_item_loc ctxt)
-      |> To_ppxlib.copy_signature
-    in
-    Ppxlib.Context_free.Rule.attr_sig_type_decl
-      js
-      rewriter
-  in
   Ppxlib.Driver.register_transformation
     "gen_js_api"
-    ~rules:[module_expr_ext; ext_of; ext_to; attr_str_type; attr_sig_type ]
+    ~rules:[module_expr_ext; ext_of; ext_to]
     ~impl:(fun str_ ->
         mapper_for_str.structure mapper_for_str str_)
     ~intf:(fun sig_ ->
         mapper_for_sig.signature mapper_for_sig sig_)
+
+let deriver =
+  let generate_intf ~ctxt (_, tdl) =
+      tdl
+      |> List.map (Of_ppxlib.copy_type_declaration)
+      |> Gen_js_api_ppx.type_decl_sig_rewriter
+        ~loc:(Ppxlib.Expansion_context.Deriver.derived_item_loc ctxt)
+      |> To_ppxlib.copy_signature
+  in
+  let generate_impl ~ctxt (rec_flag, tdl) =
+    tdl
+    |> List.map (Of_ppxlib.copy_type_declaration)
+    |> Gen_js_api_ppx.type_decl_rewriter
+      ~loc:(Ppxlib.Expansion_context.Deriver.derived_item_loc ctxt)
+      (Of_ppxlib.copy_rec_flag rec_flag)
+    |> To_ppxlib.copy_structure
+  in
+  let open Ppxlib in
+  let str_type_decl = Deriving.Generator.V2.make_noarg generate_impl in
+  let sig_type_decl = Deriving.Generator.V2.make_noarg generate_intf in
+  Deriving.add ~str_type_decl ~sig_type_decl "js"

ppx-lib/gen_js_api_ppx.ml

@@ -1848,7 +1848,6 @@ let type_decl_sig_rewriter ~loc l : Parsetree.signature =
   let itm = with_default_loc {loc with loc_ghost = true}
       (fun () ->
          let funs = List.flatten (List.map gen_fun_types l) in
-         Sig.attribute disable_warnings ::
          List.map (Sig.value ~loc:loc) funs
       )
   in

ppx-test/dune

@@ -22,6 +22,19 @@
  (action
   (diff expected/issues.ml issues.ml.result)))
 
+(rule
+ (targets types.ml.result)
+ (deps types.ml)
+ (action
+  (run ppx/main.exe --impl %{deps} -o %{targets})))
+
+(rule
+ (alias runtest)
+ (package gen_js_api)
+ (action
+  (diff expected/types.ml types.ml.result)))
+
+
 (rule
  (targets binding_automatic.ml)
  (deps binding_automatic.mli)
@@ -91,7 +104,7 @@
  (libraries ojs)
  (preprocess (pps gen_js_api))
  (modes byte)
- (modules binding_automatic binding_manual extension issues))
+ (modules binding_automatic binding_manual extension issues types))
 
 (rule
  (alias runtest)

ppx-test/expected/issues.ml

@@ -2,26 +2,35 @@ module Issue116 =
   struct
     type t
     type s = int[@@js ]
-    [@@@ocaml.warning "-7-32-39"]
-    let rec (s_of_js : Ojs.t -> s) = Ojs.int_of_js
-    and (s_to_js : s -> Ojs.t) = Ojs.int_to_js
     module M :
       sig
         type t
-        type s[@@js ]
-        [@@@ocaml.warning "-7-32-39"]
-        val s_of_js : Ojs.t -> s
-        val s_to_js : s -> Ojs.t
+        type s[@@deriving js]
+        include
+          sig
+            [@@@ocaml.warning "-32"]
+            val s_of_js : Ojs.t -> s
+            val s_to_js : s -> Ojs.t
+          end[@@ocaml.doc "@inline"][@@merlin.hide ]
       end =
       ((struct
           [@@@js.dummy "!! This code has been generated by gen_js_api !!"]
           [@@@ocaml.warning "-7-32-39"]
           type t = Ojs.t
-          let rec (t_of_js : Ojs.t -> t) = fun x4 -> x4
-          and (t_to_js : t -> Ojs.t) = fun x3 -> x3
-          type s = Ojs.t
-          let rec (s_of_js : Ojs.t -> s) = fun x6 -> x6
-          and (s_to_js : s -> Ojs.t) = fun x5 -> x5
+          let rec (t_of_js : Ojs.t -> t) = fun x2 -> x2
+          and (t_to_js : t -> Ojs.t) = fun x1 -> x1
+          type s = Ojs.t[@@deriving js]
+          include
+            struct
+              let _ = fun (_ : s) -> ()
+              [@@@ocaml.warning "-7-32-39"]
+              let rec (s_of_js : Ojs.t -> s) = fun x6 -> x6
+              and (s_to_js : s -> Ojs.t) = fun x5 -> x5
+              let _ = s_of_js
+              and _ = s_to_js
+            end[@@ocaml.doc "@inline"][@@merlin.hide ]
+          let rec (s_of_js : Ojs.t -> s) = fun x4 -> x4
+          and (s_to_js : s -> Ojs.t) = fun x3 -> x3
         end)[@merlin.hide ]) 
   end
 module Issue117 :