inline all types

ahrefs · Sep 21, 2024 · cc86ae1 · cc86ae1
1 parent 7fb8f78
commit cc86ae1
Show file tree

Hide file tree

Showing 5 changed files with 224 additions and 127 deletions.
diff --git a/src/ppx_deriving_jsonschema.ml b/src/ppx_deriving_jsonschema.ml
@@ -43,7 +43,7 @@ let tuple ~loc elements = [%expr `Assoc [ "type", `String "array"; "items", `Lis
 let value_name_pattern ~loc type_name = ppat_var ~loc { txt = type_name ^ "_jsonschema"; loc }
 
 let create_value ~loc name value =
-  [%stri let[@warning "-32"] ([%p value_name_pattern ~loc name] : [< `Assoc of _ ]) = [%e value]]
+  [%stri let[@warning "-32-39"] (* rec *) [%p value_name_pattern ~loc name (* : [< `Assoc of _ list ] *)] = [%e value]]
 
 let is_optional_type core_type =
   match core_type with
@@ -62,7 +62,7 @@ let rec type_of_core ~loc core_type =
     array_ ~loc t
   | _ ->
   match core_type.ptyp_desc with
-  | Ptyp_constr ({ txt = Lident type_name; _ }, []) -> type_ref ~loc type_name
+  | Ptyp_constr (id, []) -> type_constr_conv ~loc id ~f:(fun s -> s ^ "_jsonschema") [] (* type_ref ~loc type_name *)
   | Ptyp_tuple types ->
     let ts = List.map (type_of_core ~loc) types in
     tuple ~loc ts

diff --git a/test/.ocamlformat-ignore b/test/.ocamlformat-ignore
@@ -0,0 +1 @@
+test.expected.ml
diff --git a/test/test.expected.ml b/test/test.expected.ml
@@ -2,31 +2,60 @@
 let print_schema s =
   let s = Ppx_deriving_jsonschema_runtime.json_schema s in
   let () = print_endline (Yojson.Basic.pretty_to_string s) in ()
-module M =
+module Mod1 =
   struct
     type m_1 =
       | A 
       | B [@@deriving jsonschema]
     include
       struct
-        let (m_1_jsonschema : [< `Assoc of _ ]) =
+        let m_1_jsonschema =
           `Assoc
             [("type", (`String "string"));
-            ("enum", (`List [`String "A"; `String "B"]))][@@warning "-32"]
+            ("enum", (`List [`String "A"; `String "B"]))][@@warning "-32-39"]
       end[@@ocaml.doc "@inline"][@@merlin.hide ]
+    module Mod2 =
+      struct
+        type m_2 =
+          | C 
+          | D [@@deriving jsonschema]
+        include
+          struct
+            let m_2_jsonschema =
+              `Assoc
+                [("type", (`String "string"));
+                ("enum", (`List [`String "C"; `String "D"]))][@@warning
+                                                               "-32-39"]
+          end[@@ocaml.doc "@inline"][@@merlin.hide ]
+      end
   end
+type with_modules = {
+  m: Mod1.m_1 ;
+  m2: Mod1.Mod2.m_2 }[@@deriving jsonschema]
+include
+  struct
+    let with_modules_jsonschema =
+      `Assoc
+        [("type", (`String "object"));
+        ("properties",
+          (`Assoc
+             [("m2", Mod1.Mod2.m_2_jsonschema); ("m", Mod1.m_1_jsonschema)]));
+        ("required", (`List [`String "m2"; `String "m"]))][@@warning
+                                                            "-32-39"]
+  end[@@ocaml.doc "@inline"][@@merlin.hide ]
+let () = print_schema with_modules_jsonschema
 type kind =
   | Success 
   | Error 
   | Skipped [@@deriving jsonschema]
 include
   struct
-    let (kind_jsonschema : [< `Assoc of _ ]) =
+    let kind_jsonschema =
       `Assoc
         [("type", (`String "string"));
         ("enum",
           (`List [`String "Success"; `String "Error"; `String "Skipped"]))]
-      [@@warning "-32"]
+      [@@warning "-32-39"]
   end[@@ocaml.doc "@inline"][@@merlin.hide ]
 let () = print_schema kind_jsonschema
 type event =
@@ -40,7 +69,7 @@ type event =
   t: [ `Foo  | `Bar  | `Baz ] }[@@deriving jsonschema]
 include
   struct
-    let (event_jsonschema : [< `Assoc of _ ]) =
+    let event_jsonschema =
       `Assoc
         [("type", (`String "object"));
         ("properties",
@@ -58,7 +87,7 @@ include
                   ("items", (`Assoc [("type", (`String "number"))]))]));
              ("opt", (`Assoc [("type", (`String "integer"))]));
              ("comment", (`Assoc [("type", (`String "string"))]));
-             ("kind_f", (`Assoc [("$ref", (`String "#/definitions/kind"))]));
+             ("kind_f", kind_jsonschema);
              ("date", (`Assoc [("type", (`String "number"))]))]));
         ("required",
           (`List
@@ -67,167 +96,122 @@ include
              `String "a";
              `String "comment";
              `String "kind_f";
-             `String "date"]))][@@warning "-32"]
+             `String "date"]))][@@warning "-32-39"]
   end[@@ocaml.doc "@inline"][@@merlin.hide ]
 let () = print_schema event_jsonschema
-type recursive_record = {
-  a: int ;
-  b: recursive_record list }[@@deriving jsonschema]
-include
-  struct
-    let (recursive_record_jsonschema : [< `Assoc of _ ]) =
-      `Assoc
-        [("type", (`String "object"));
-        ("properties",
-          (`Assoc
-             [("b",
-                (`Assoc
-                   [("type", (`String "array"));
-                   ("items",
-                     (`Assoc
-                        [("$ref", (`String "#/definitions/recursive_record"))]))]));
-             ("a", (`Assoc [("type", (`String "integer"))]))]));
-        ("required", (`List [`String "b"; `String "a"]))][@@warning "-32"]
-  end[@@ocaml.doc "@inline"][@@merlin.hide ]
-let () = print_schema recursive_record_jsonschema
-type recursive_variant =
-  | A of recursive_variant 
-  | B [@@deriving jsonschema]
-include
-  struct
-    let (recursive_variant_jsonschema : [< `Assoc of _ ]) =
-      `Assoc
-        [("type", (`String "string"));
-        ("enum",
-          (`List
-             [`String
-                "unsuported variant constructor with a payload: \n| A of recursive_variant \n| B\n";
-             `String "B"]))][@@warning "-32"]
-  end[@@ocaml.doc "@inline"][@@merlin.hide ]
-let () = print_schema recursive_variant_jsonschema
 type events = event list[@@deriving jsonschema]
 include
   struct
-    let (events_jsonschema : [< `Assoc of _ ]) =
-      `Assoc
-        [("type", (`String "array"));
-        ("items", (`Assoc [("$ref", (`String "#/definitions/event"))]))]
-      [@@warning "-32"]
+    let events_jsonschema =
+      `Assoc [("type", (`String "array")); ("items", event_jsonschema)]
+      [@@warning "-32-39"]
   end[@@ocaml.doc "@inline"][@@merlin.hide ]
 let () = print_schema events_jsonschema
 type eventss = event list list[@@deriving jsonschema]
 include
   struct
-    let (eventss_jsonschema : [< `Assoc of _ ]) =
+    let eventss_jsonschema =
       `Assoc
         [("type", (`String "array"));
         ("items",
-          (`Assoc
-             [("type", (`String "array"));
-             ("items", (`Assoc [("$ref", (`String "#/definitions/event"))]))]))]
-      [@@warning "-32"]
+          (`Assoc [("type", (`String "array")); ("items", event_jsonschema)]))]
+      [@@warning "-32-39"]
   end[@@ocaml.doc "@inline"][@@merlin.hide ]
 let () = print_schema eventss_jsonschema
 type event_comment = (event * string)[@@deriving jsonschema]
 include
   struct
-    let (event_comment_jsonschema : [< `Assoc of _ ]) =
+    let event_comment_jsonschema =
       `Assoc
         [("type", (`String "array"));
         ("items",
-          (`List
-             [`Assoc [("$ref", (`String "#/definitions/event"))];
-             `Assoc [("type", (`String "string"))]]))][@@warning "-32"]
+          (`List [event_jsonschema; `Assoc [("type", (`String "string"))]]))]
+      [@@warning "-32-39"]
   end[@@ocaml.doc "@inline"][@@merlin.hide ]
 let () = print_schema event_comment_jsonschema
 type event_comments' = event_comment list[@@deriving jsonschema]
 include
   struct
-    let (event_comments'_jsonschema : [< `Assoc of _ ]) =
+    let event_comments'_jsonschema =
       `Assoc
-        [("type", (`String "array"));
-        ("items",
-          (`Assoc [("$ref", (`String "#/definitions/event_comment"))]))]
-      [@@warning "-32"]
+        [("type", (`String "array")); ("items", event_comment_jsonschema)]
+      [@@warning "-32-39"]
   end[@@ocaml.doc "@inline"][@@merlin.hide ]
 let () = print_schema event_comments'_jsonschema
 type event_n = (event * int) list[@@deriving jsonschema]
 include
   struct
-    let (event_n_jsonschema : [< `Assoc of _ ]) =
+    let event_n_jsonschema =
       `Assoc
         [("type", (`String "array"));
         ("items",
           (`Assoc
              [("type", (`String "array"));
              ("items",
                (`List
-                  [`Assoc [("$ref", (`String "#/definitions/event"))];
-                  `Assoc [("type", (`String "integer"))]]))]))][@@warning
-                                                                 "-32"]
+                  [event_jsonschema; `Assoc [("type", (`String "integer"))]]))]))]
+      [@@warning "-32-39"]
   end[@@ocaml.doc "@inline"][@@merlin.hide ]
 let () = print_schema event_n_jsonschema
 type events_array = events array[@@deriving jsonschema]
 include
   struct
-    let (events_array_jsonschema : [< `Assoc of _ ]) =
-      `Assoc
-        [("type", (`String "array"));
-        ("items", (`Assoc [("$ref", (`String "#/definitions/events"))]))]
-      [@@warning "-32"]
+    let events_array_jsonschema =
+      `Assoc [("type", (`String "array")); ("items", events_jsonschema)]
+      [@@warning "-32-39"]
   end[@@ocaml.doc "@inline"][@@merlin.hide ]
 let () = print_schema events_array_jsonschema
 type numbers = int list[@@deriving jsonschema]
 include
   struct
-    let (numbers_jsonschema : [< `Assoc of _ ]) =
+    let numbers_jsonschema =
       `Assoc
         [("type", (`String "array"));
-        ("items", (`Assoc [("type", (`String "integer"))]))][@@warning "-32"]
+        ("items", (`Assoc [("type", (`String "integer"))]))][@@warning
+                                                              "-32-39"]
   end[@@ocaml.doc "@inline"][@@merlin.hide ]
 let () = print_schema numbers_jsonschema
 type opt = int option[@@deriving jsonschema]
 include
   struct
-    let (opt_jsonschema : [< `Assoc of _ ]) =
-      `Assoc [("type", (`String "integer"))][@@warning "-32"]
+    let opt_jsonschema = `Assoc [("type", (`String "integer"))][@@warning
+                                                                 "-32-39"]
   end[@@ocaml.doc "@inline"][@@merlin.hide ]
 let () = print_schema opt_jsonschema
 type using_m = {
-  m: M.m_1 }[@@deriving jsonschema]
+  m: Mod1.m_1 }[@@deriving jsonschema]
 include
   struct
-    let (using_m_jsonschema : [< `Assoc of _ ]) =
+    let using_m_jsonschema =
       `Assoc
         [("type", (`String "object"));
-        ("properties",
-          (`Assoc [("m", (`Assoc [("unsuported type", (`String "M.m_1"))]))]));
-        ("required", (`List [`String "m"]))][@@warning "-32"]
+        ("properties", (`Assoc [("m", Mod1.m_1_jsonschema)]));
+        ("required", (`List [`String "m"]))][@@warning "-32-39"]
   end[@@ocaml.doc "@inline"][@@merlin.hide ]
 let () = print_schema using_m_jsonschema
 type 'param poly = {
   f: 'param }[@@deriving jsonschema]
 include
   struct
-    let (poly_jsonschema : [< `Assoc of _ ]) =
+    let poly_jsonschema =
       `Assoc
         [("type", (`String "object"));
         ("properties",
           (`Assoc [("f", (`Assoc [("unsuported type", (`String "'param"))]))]));
-        ("required", (`List [`String "f"]))][@@warning "-32"]
+        ("required", (`List [`String "f"]))][@@warning "-32-39"]
   end[@@ocaml.doc "@inline"][@@merlin.hide ]
 let () = print_schema poly_jsonschema
 type 'param2 poly2 =
   | C of 'param2 [@@deriving jsonschema]
 include
   struct
-    let (poly2_jsonschema : [< `Assoc of _ ]) =
+    let poly2_jsonschema =
       `Assoc
         [("type", (`String "string"));
         ("enum",
           (`List
              [`String
                 "unsuported variant constructor with a payload: \n| C of 'param2\n"]))]
-      [@@warning "-32"]
+      [@@warning "-32-39"]
   end[@@ocaml.doc "@inline"][@@merlin.hide ]
 let () = print_schema poly2_jsonschema
diff --git a/test/test.ml b/test/test.ml
@@ -5,13 +5,28 @@ let print_schema s =
   let () = print_endline (Yojson.Basic.pretty_to_string s) in
   ()
 
-module M = struct
+module Mod1 = struct
   type m_1 =
     | A
     | B
   [@@deriving jsonschema]
+
+  module Mod2 = struct
+    type m_2 =
+      | C
+      | D
+    [@@deriving jsonschema]
+  end
 end
 
+type with_modules = {
+  m : Mod1.m_1;
+  m2 : Mod1.Mod2.m_2;
+}
+[@@deriving jsonschema]
+
+let () = print_schema with_modules_jsonschema
+
 type kind =
   | Success
   | Error
@@ -33,20 +48,20 @@ type event = {
 
 let () = print_schema event_jsonschema
 
-type recursive_record = {
-  a : int;
-  b : recursive_record list;
-}
-[@@deriving jsonschema]
+(* type recursive_record = {
+     a : int;
+     b : recursive_record list;
+   }
+   [@@deriving jsonschema]
 
-let () = print_schema recursive_record_jsonschema
+   let () = print_schema recursive_record_jsonschema
 
-type recursive_variant =
-  | A of recursive_variant
-  | B
-[@@deriving jsonschema]
+   type recursive_variant =
+     | A of recursive_variant
+     | B
+   [@@deriving jsonschema]
 
-let () = print_schema recursive_variant_jsonschema
+   let () = print_schema recursive_variant_jsonschema *)
 
 type events = event list [@@deriving jsonschema]
 
@@ -80,7 +95,7 @@ type opt = int option [@@deriving jsonschema]
 
 let () = print_schema opt_jsonschema
 
-type using_m = { m : M.m_1 } [@@deriving jsonschema]
+type using_m = { m : Mod1.m_1 } [@@deriving jsonschema]
 
 let () = print_schema using_m_jsonschema