Skip to content

Commit

Permalink
support variant payload
Browse files Browse the repository at this point in the history
  • Loading branch information
Khady committed Sep 25, 2024
1 parent 6ba0aa9 commit 9eec6a7
Show file tree
Hide file tree
Showing 4 changed files with 449 additions and 57 deletions.
65 changes: 44 additions & 21 deletions src/ppx_deriving_jsonschema.ml
Original file line number Diff line number Diff line change
Expand Up @@ -103,6 +103,9 @@ let variant_as_array ~loc values = Schema.array_ ~loc ~min_items:1 ~max_items:1

let variant_as_string ~loc values = Schema.enum_string ~loc values

let variant_with_payload ~loc constrs =
Schema.oneOf ~loc (List.map (fun (name, typs) -> Schema.tuple ~loc (Schema.const ~loc name :: typs)) constrs)

let variant ~loc ~config values =
match config.variant_as_array with
| true -> variant_as_array ~loc values
Expand Down Expand Up @@ -140,20 +143,34 @@ let rec type_of_core ~loc ~config core_type =
let ts = List.map (type_of_core ~loc ~config) types in
Schema.tuple ~loc ts
| Ptyp_variant (row_fields, _, _) ->
let constr_names =
let constrs =
List.map
(fun row_field ->
let name_overwrite = Attribute.get jsonschema_polymorphic_variant_name row_field in
match name_overwrite with
| Some name -> name
| None ->
match row_field with
| { prf_desc = Rtag (name, _, _); _ } -> name.txt
| { prf_desc = Rinherit _core_type; _ } ->
Format.asprintf "unsupported polymorphic variant type: %a" Astlib.Pprintast.core_type core_type (* todo: *))
| { prf_desc = Rtag (name, _, typs); _ } ->
let name =
match Attribute.get jsonschema_polymorphic_variant_name row_field with
| Some name -> name
| None -> name.txt
in
let typs = List.map (type_of_core ~loc ~config) typs in
name, typs
| { prf_desc = Rinherit core_type; _ } ->
(* let typs = [ type_of_core ~loc ~config core_type ] in *)
let name =
Format.asprintf "unsupported polymorphic variant inheritance: %a" Astlib.Pprintast.core_type
core_type (* todo: *)
in
name, [])
row_fields
in
variant ~loc ~config constr_names
(* todo: raise an error if encoding is as string and constructor has a payload *)
let v =
match config.variant_as_array with
| true -> variant_with_payload ~loc constrs
| false -> variant_as_string ~loc (List.map fst constrs)
in
v
| _ ->
(* Format.printf "unsuported core type: %a\n------\n" Astlib.Pprintast.core_type core_type; *)
[%expr
Expand Down Expand Up @@ -199,21 +216,27 @@ let derive_jsonschema ~ctxt ast variant_as_array =
let variants =
List.map
(fun ({ pcd_args; pcd_name = { txt = name; _ }; _ } as var) ->
let name_overwrite = Attribute.get jsonschema_variant_name var in
match name_overwrite with
| Some name -> name
| None ->
let name =
match Attribute.get jsonschema_variant_name var with
| Some name -> name
| None -> name
in
match pcd_args with
| Pcstr_record _ | Pcstr_tuple (_ :: _) ->
(* todo: emit an error when a type can't be turned into a valid json schema *)
Format.asprintf "unsuported variant constructor with a payload: %a"
Format.(pp_print_list Astlib.Pprintast.type_declaration)
(snd ast)
| Pcstr_tuple [] -> name)
| Pcstr_record label_declarations ->
let typs = [ object_ ~loc ~config label_declarations ] in
name, typs
| Pcstr_tuple typs ->
let types = List.map (type_of_core ~loc ~config) typs in
name, types)
variants
in
(* let names = List.map (fun { pcd_name = { txt = value; _ }; _ } -> value) variants in *)
let jsonschema_expr = create_value ~loc type_name (variant ~loc ~config variants) in
let v =
(* todo: raise an error if encoding is as string and constructor has a payload *)
match variant_as_array with
| true -> variant_with_payload ~loc variants
| false -> variant_as_string ~loc (List.map fst variants)
in
let jsonschema_expr = create_value ~loc type_name v in
[ jsonschema_expr ]
| _, [ { ptype_name = { txt = type_name; _ }; ptype_kind = Ptype_record label_declarations; _ } ] ->
let jsonschema_expr = create_value ~loc type_name (object_ ~loc ~config label_declarations) in
Expand Down
225 changes: 202 additions & 23 deletions test/test.expected.ml
Original file line number Diff line number Diff line change
Expand Up @@ -68,14 +68,29 @@ include
struct
let kind_as_array_jsonschema =
`Assoc
[("type", (`String "array"));
("items",
(`Assoc
[("type", (`String "string"));
("enum",
(`List [`String "Success"; `String "Error"; `String "skipped"]))]));
("minItems", (`Int 1));
("maxItems", (`Int 1))][@@warning "-32-39"]
[("oneOf",
(`List
[`Assoc
[("type", (`String "array"));
("prefixItems",
(`List [`Assoc [("const", (`String "Success"))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 1));
("maxItems", (`Int 1))];
`Assoc
[("type", (`String "array"));
("prefixItems",
(`List [`Assoc [("const", (`String "Error"))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 1));
("maxItems", (`Int 1))];
`Assoc
[("type", (`String "array"));
("prefixItems",
(`List [`Assoc [("const", (`String "skipped"))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 1));
("maxItems", (`Int 1))]]))][@@warning "-32-39"]
end[@@ocaml.doc "@inline"][@@merlin.hide ]
let () = print_schema kind_as_array_jsonschema
type poly_kind = [ `Aaa | `Bbb | `Ccc [@name "ccc"]][@@deriving jsonschema]
Expand All @@ -95,15 +110,88 @@ include
struct
let poly_kind_as_array_jsonschema =
`Assoc
[("type", (`String "array"));
("items",
(`Assoc
[("type", (`String "string"));
("enum", (`List [`String "Aaa"; `String "Bbb"; `String "ccc"]))]));
("minItems", (`Int 1));
("maxItems", (`Int 1))][@@warning "-32-39"]
[("oneOf",
(`List
[`Assoc
[("type", (`String "array"));
("prefixItems",
(`List [`Assoc [("const", (`String "Aaa"))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 1));
("maxItems", (`Int 1))];
`Assoc
[("type", (`String "array"));
("prefixItems",
(`List [`Assoc [("const", (`String "Bbb"))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 1));
("maxItems", (`Int 1))];
`Assoc
[("type", (`String "array"));
("prefixItems",
(`List [`Assoc [("const", (`String "ccc"))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 1));
("maxItems", (`Int 1))]]))][@@warning "-32-39"]
end[@@ocaml.doc "@inline"][@@merlin.hide ]
let () = print_schema poly_kind_as_array_jsonschema
type poly_kind_with_payload =
[ `Aaa of int | `Bbb | `Ccc of (string * bool) [@name "ccc"]][@@deriving
jsonschema]
include
struct
let poly_kind_with_payload_jsonschema =
`Assoc
[("type", (`String "string"));
("enum", (`List [`String "Aaa"; `String "Bbb"; `String "ccc"]))]
[@@warning "-32-39"]
end[@@ocaml.doc "@inline"][@@merlin.hide ]
let () = print_schema poly_kind_with_payload_jsonschema
type poly_kind_with_payload_as_array =
[ `Aaa of int | `Bbb | `Ccc of (string * bool) [@name "ccc"]][@@deriving
jsonschema
~variant_as_array]
include
struct
let poly_kind_with_payload_as_array_jsonschema =
`Assoc
[("oneOf",
(`List
[`Assoc
[("type", (`String "array"));
("prefixItems",
(`List
[`Assoc [("const", (`String "Aaa"))];
`Assoc [("type", (`String "integer"))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 2));
("maxItems", (`Int 2))];
`Assoc
[("type", (`String "array"));
("prefixItems",
(`List [`Assoc [("const", (`String "Bbb"))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 1));
("maxItems", (`Int 1))];
`Assoc
[("type", (`String "array"));
("prefixItems",
(`List
[`Assoc [("const", (`String "ccc"))];
`Assoc
[("type", (`String "array"));
("prefixItems",
(`List
[`Assoc [("type", (`String "string"))];
`Assoc [("type", (`String "boolean"))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 2));
("maxItems", (`Int 2))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 2));
("maxItems", (`Int 2))]]))][@@warning "-32-39"]
end[@@ocaml.doc "@inline"][@@merlin.hide ]
let () = print_schema poly_kind_with_payload_as_array_jsonschema
type poly_inherit = [ `New_one | poly_kind][@@deriving jsonschema]
include
struct
Expand All @@ -113,8 +201,7 @@ include
("enum",
(`List
[`String "New_one";
`String
"unsupported polymorphic variant type: [ `New_one | poly_kind]"]))]
`String "unsupported polymorphic variant inheritance: poly_kind"]))]
[@@warning "-32-39"]
end[@@ocaml.doc "@inline"][@@merlin.hide ]
let () = print_schema poly_inherit_jsonschema
Expand Down Expand Up @@ -292,12 +379,7 @@ type 'param2 poly2 =
include
struct
let poly2_jsonschema =
`Assoc
[("type", (`String "string"));
("enum",
(`List
[`String
"unsuported variant constructor with a payload: \n| C of 'param2\n"]))]
`Assoc [("type", (`String "string")); ("enum", (`List [`String "C"]))]
[@@warning "-32-39"]
end[@@ocaml.doc "@inline"][@@merlin.hide ]
let () = print_schema poly2_jsonschema
Expand Down Expand Up @@ -424,3 +506,100 @@ include
("maxLength", (`Int 1))][@@warning "-32-39"]
end[@@ocaml.doc "@inline"][@@merlin.hide ]
let () = print_schema c_jsonschema
type variant_inline_record =
| A of {
a: int }
| B of {
b: string } [@@deriving jsonschema ~variant_as_array]
include
struct
let variant_inline_record_jsonschema =
`Assoc
[("oneOf",
(`List
[`Assoc
[("type", (`String "array"));
("prefixItems",
(`List
[`Assoc [("const", (`String "A"))];
`Assoc
[("type", (`String "object"));
("properties",
(`Assoc
[("a", (`Assoc [("type", (`String "integer"))]))]));
("required", (`List [`String "a"]))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 2));
("maxItems", (`Int 2))];
`Assoc
[("type", (`String "array"));
("prefixItems",
(`List
[`Assoc [("const", (`String "B"))];
`Assoc
[("type", (`String "object"));
("properties",
(`Assoc
[("b", (`Assoc [("type", (`String "string"))]))]));
("required", (`List [`String "b"]))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 2));
("maxItems", (`Int 2))]]))][@@warning "-32-39"]
end[@@ocaml.doc "@inline"][@@merlin.hide ]
let () = print_schema variant_inline_record_jsonschema
type variant_with_payload =
| A of int
| B
| C of int * string
| D of (int * string * bool) [@@deriving jsonschema ~variant_as_array]
include
struct
let variant_with_payload_jsonschema =
`Assoc
[("oneOf",
(`List
[`Assoc
[("type", (`String "array"));
("prefixItems",
(`List
[`Assoc [("const", (`String "A"))];
`Assoc [("type", (`String "integer"))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 2));
("maxItems", (`Int 2))];
`Assoc
[("type", (`String "array"));
("prefixItems", (`List [`Assoc [("const", (`String "B"))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 1));
("maxItems", (`Int 1))];
`Assoc
[("type", (`String "array"));
("prefixItems",
(`List
[`Assoc [("const", (`String "C"))];
`Assoc [("type", (`String "integer"))];
`Assoc [("type", (`String "string"))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 3));
("maxItems", (`Int 3))];
`Assoc
[("type", (`String "array"));
("prefixItems",
(`List
[`Assoc [("const", (`String "D"))];
`Assoc
[("type", (`String "array"));
("prefixItems",
(`List
[`Assoc [("type", (`String "integer"))];
`Assoc [("type", (`String "string"))];
`Assoc [("type", (`String "boolean"))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 3));
("maxItems", (`Int 3))]]));
("unevaluatedItems", (`Bool false));
("minItems", (`Int 2));
("maxItems", (`Int 2))]]))][@@warning "-32-39"]
end[@@ocaml.doc "@inline"][@@merlin.hide ]
let () = print_schema variant_with_payload_jsonschema
34 changes: 34 additions & 0 deletions test/test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -61,6 +61,24 @@ type poly_kind_as_array =

let () = print_schema poly_kind_as_array_jsonschema

type poly_kind_with_payload =
[ `Aaa of int
| `Bbb
| `Ccc of string * bool [@name "ccc"]
]
[@@deriving jsonschema]

let () = print_schema poly_kind_with_payload_jsonschema

type poly_kind_with_payload_as_array =
[ `Aaa of int
| `Bbb
| `Ccc of string * bool [@name "ccc"]
]
[@@deriving jsonschema ~variant_as_array]

let () = print_schema poly_kind_with_payload_as_array_jsonschema

type poly_inherit =
[ `New_one
| poly_kind
Expand Down Expand Up @@ -194,3 +212,19 @@ let () = print_schema ~definitions:[ "shared_address", address_jsonschema ] tt_j
type c = char [@@deriving jsonschema]

let () = print_schema c_jsonschema

type variant_inline_record =
| A of { a : int }
| B of { b : string }
[@@deriving jsonschema ~variant_as_array]

let () = print_schema variant_inline_record_jsonschema

type variant_with_payload =
| A of int
| B
| C of int * string
| D of (int * string * bool)
[@@deriving jsonschema ~variant_as_array]

let () = print_schema variant_with_payload_jsonschema
Loading

0 comments on commit 9eec6a7

Please sign in to comment.