manual support of references

runtime/ppx_deriving_jsonschema_runtime.ml

@@ -1,5 +1,25 @@
 let schema_version = "https://json-schema.org/draft/2020-12/schema"
 
-let json_schema typ =
-  match typ with
-  | `Assoc l -> `Assoc (("$schema", `String schema_version) :: l)
+let json_schema ?id ?title ?description ?definitions types =
+  match types with
+  | `Assoc types ->
+    let metadata =
+      List.filter_map
+        (fun x -> x)
+        [
+          Some ("$schema", `String schema_version);
+          (match id with
+          | None -> None
+          | Some id -> Some ("$id", `String id));
+          (match title with
+          | None -> None
+          | Some title -> Some ("title", `String title));
+          (match description with
+          | None -> None
+          | Some description -> Some ("description", `String description));
+          (match definitions with
+          | None -> None
+          | Some defs -> Some ("$defs", `Assoc defs));
+        ]
+    in
+    `Assoc (metadata @ types)

src/ppx_deriving_jsonschema.ml

@@ -8,6 +8,11 @@ let jsonschema_key =
     Ast_pattern.(pstr (pstr_eval (estring __) nil ^:: nil))
     (fun x -> x)
 
+let jsonschema_ref =
+  Attribute.declare "jsonschema.ref" Attribute.Context.label_declaration
+    Ast_pattern.(pstr (pstr_eval (estring __) nil ^:: nil))
+    (fun x -> x)
+
 let jsonschema_variant_name =
   Attribute.declare "jsonschema.name" Attribute.Context.constructor_declaration
     Ast_pattern.(pstr (pstr_eval (estring __) nil ^:: nil))
@@ -18,14 +23,13 @@ let jsonschema_polymorphic_variant_name =
     Ast_pattern.(pstr (pstr_eval (estring __) nil ^:: nil))
     (fun x -> x)
 
-(* let default_attribute =
-     Attribute.declare "ppx_deriving_yojson.of_yojson.default" Attribute.Context.label_declaration
-       Ast_pattern.(single_expr_payload __)
-       (fun expr -> expr)
-*)
-
 let attributes =
-  [ Attribute.T jsonschema_key; Attribute.T jsonschema_variant_name; Attribute.T jsonschema_polymorphic_variant_name ]
+  [
+    Attribute.T jsonschema_key;
+    Attribute.T jsonschema_ref;
+    Attribute.T jsonschema_variant_name;
+    Attribute.T jsonschema_polymorphic_variant_name;
+  ]
 
 let args () = Deriving.Args.(empty)
 (* let args () = Deriving.Args.(empty +> arg "option1" (eint __) +> flag "flag") *)
@@ -36,7 +40,7 @@ let predefined_types = [ "string"; "int"; "float"; "bool" ]
 let is_predefined_type type_name = List.mem type_name predefined_types
 
 let type_ref ~loc type_name =
-  let name = estring ~loc ("#/definitions/" ^ type_name) in
+  let name = estring ~loc ("#/defs/" ^ type_name) in
   [%expr `Assoc [ "$ref", `String [%e name] ]]
 
 let type_def ~loc type_name =
@@ -119,7 +123,11 @@ let object_ ~loc fields =
           | Some name -> name
           | None -> name
         in
-        let type_def = type_of_core ~loc pld_type in
+        let type_def =
+          match Attribute.get jsonschema_ref field with
+          | Some def -> type_ref ~loc def
+          | None -> type_of_core ~loc pld_type
+        in
         ( [%expr [%e estring ~loc name], [%e type_def]] :: fields,
           if is_optional_type pld_type then required else name :: required ))
       ([], []) fields

test/test.expected.ml

@@ -1,6 +1,8 @@
 [@@@ocaml.warning "-37-69"]
-let print_schema s =
-  let s = Ppx_deriving_jsonschema_runtime.json_schema s in
+let print_schema ?definitions  ?id  ?title  ?description  s =
+  let s =
+    Ppx_deriving_jsonschema_runtime.json_schema ?definitions ?id ?title
+      ?description s in
   let () = print_endline (Yojson.Basic.pretty_to_string s) in ()
 module Mod1 =
   struct
@@ -258,3 +260,23 @@ include
       [@@warning "-32-39"]
   end[@@ocaml.doc "@inline"][@@merlin.hide ]
 let () = print_schema tuple_with_variant_jsonschema
+type player_scores =
+  {
+  player: string ;
+  scores: numbers [@ref "numbers"][@key "scores_ref"]}[@@deriving jsonschema]
+include
+  struct
+    let player_scores_jsonschema =
+      `Assoc
+        [("type", (`String "object"));
+        ("properties",
+          (`Assoc
+             [("scores_ref", (`Assoc [("$ref", (`String "#/defs/numbers"))]));
+             ("player", (`Assoc [("type", (`String "string"))]))]));
+        ("required", (`List [`String "scores_ref"; `String "player"]))]
+      [@@warning "-32-39"]
+  end[@@ocaml.doc "@inline"][@@merlin.hide ]
+let () =
+  print_schema ~id:"https://ahrefs.com/schemas/player_scores"
+    ~title:"Player scores" ~description:"Object representing player scores"
+    ~definitions:[("numbers", numbers_jsonschema)] player_scores_jsonschema

test/test.ml

@@ -1,7 +1,7 @@
 [@@@ocaml.warning "-37-69"]
 
-let print_schema s =
-  let s = Ppx_deriving_jsonschema_runtime.json_schema s in
+let print_schema ?definitions ?id ?title ?description s =
+  let s = Ppx_deriving_jsonschema_runtime.json_schema ?definitions ?id ?title ?description s in
   let () = print_endline (Yojson.Basic.pretty_to_string s) in
   ()
 
@@ -127,3 +127,15 @@ let () = print_schema poly2_jsonschema
 type tuple_with_variant = int * [ `A | `B [@name "second_cstr"] ] [@@deriving jsonschema]
 
 let () = print_schema tuple_with_variant_jsonschema
+
+type player_scores = {
+  player : string;
+  scores : numbers; [@ref "numbers"] [@key "scores_ref"]
+}
+[@@deriving jsonschema]
+
+let () =
+  print_schema ~id:"https://ahrefs.com/schemas/player_scores" ~title:"Player scores"
+    ~description:"Object representing player scores"
+    ~definitions:[ "numbers", numbers_jsonschema ]
+    player_scores_jsonschema

test/test_schemas.expected.json

@@ -216,3 +216,16 @@
     { "type": "string", "enum": [ "A", "second_cstr" ] }
   ]
 }
+{
+  "$schema": "https://json-schema.org/draft/2020-12/schema",
+  "$id": "https://ahrefs.com/schemas/player_scores",
+  "title": "Player scores",
+  "description": "Object representing player scores",
+  "$defs": { "numbers": { "type": "array", "items": { "type": "integer" } } },
+  "type": "object",
+  "properties": {
+    "scores_ref": { "$ref": "#/defs/numbers" },
+    "player": { "type": "string" }
+  },
+  "required": [ "scores_ref", "player" ]
+}