Skip to content

Commit

Permalink
Add options --skip-doc and --protect-against-duplicates
Browse files Browse the repository at this point in the history
  • Loading branch information
@smondet
smondet committed Nov 25, 2024
1 parent b35ddbd commit 8b34166
Show file tree
Hide file tree
Showing 2 changed files with 64 additions and 42 deletions.
14 changes: 10 additions & 4 deletions bin/main.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,11 +12,11 @@ module Input_format = struct
let all = [ JSONSchema; OpenAPI ]
end

let generate_atd input_format paths =
let generate_atd state input_format paths =
let generate =
match input_format with
| Input_format.JSONSchema -> Generator.make_atd_of_jsonschema
| OpenAPI -> Generator.make_atd_of_openapi
| Input_format.JSONSchema -> Generator.make_atd_of_jsonschema ~state
| OpenAPI -> Generator.make_atd_of_openapi ~state
in
print_endline (Generator.base (String.concat " " (List.map Filename.basename paths)));
let root =
Expand Down Expand Up @@ -44,8 +44,14 @@ let input_format_term =

let main =
let doc = "Generate an ATD file from a list of JSON Schema / OpenAPI document" in
let state_term =
Term.(const (fun skip_doc pad ->
Generator.{ with_doc = not skip_doc ; protect_against_duplicates = if pad then Some (ref []) else None })
$ Arg.(value (flag (info ["skip-doc"] ~doc:"Skip documentation annotations.")))
$ Arg.(value (flag (info ["protect-against-duplicates"] ~doc:"Make sure no duplicate types are generated."))))
in
let paths = Arg.(non_empty & pos_all file [] & info [] ~docv:"FILES" ~doc) in
let term = Term.(const generate_atd $ input_format_term $ paths) in
let term = Term.(const generate_atd $ state_term $ input_format_term $ paths) in
let info = Cmd.info "jsonschema2atd" ~doc ~version:(Version.get ()) in
Cmd.v info term

Expand Down
92 changes: 54 additions & 38 deletions lib/generator.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,21 +2,37 @@ open Json_schema_t
open Printf
open Utils

let record_field_name str =
type state = {
with_doc : bool;
protect_against_duplicates: string list ref option;
}
let default_state = {with_doc = true; protect_against_duplicates = None }

let record_field_name _state str =
let cleaned_field_name = Utils.sanitize_name str in
if String.equal str cleaned_field_name then str else sprintf {|%s <json name="%s">|} cleaned_field_name str

let doc_annotation text = sprintf {|<doc text=%S>|} text
let doc_annotation state text = if state.with_doc then sprintf {|<doc text=%S>|} text else ""

let defined_types : string list ref = ref []

let define_type ~doc ~name ~type_ =
let define_type state ~doc ~name ~type_ =
let doc =
match doc with
| None -> ""
| Some doc -> doc_annotation doc
| Some doc -> doc_annotation state doc
in
sprintf "type %s = %s %s\n" (type_name name) type_ doc
let out () = sprintf "type %s = %s %s\n" (type_name name) type_ doc in
begin match state.protect_against_duplicates with
| None -> out ()
| Some defined_types ->
begin match List.exists ((=) name) !defined_types with
| false -> defined_types := name :: !defined_types; out ()
| true -> eprintf "Warning: Ignoring duplicate type %S.\n" name; ""
end
end

let process_int_type schema =
let process_int_type _state schema =
match schema.format with
| None | Some `Int32 | Some `UnixTime | Some `Enum -> "int"
| Some `Int64 -> "int64"
Expand Down Expand Up @@ -134,17 +150,17 @@ let merge_all_of schema =
nullable = schemas |> List.exists (fun schema -> schema.nullable);
}

let rec process_schema_type ~ancestors (schema : schema) =
let rec process_schema_type state ~ancestors (schema : schema) =
let schema = merge_all_of schema in
let maybe_nullable type_ = if schema.nullable then nullable type_ else type_ in
match schema.one_of with
| Some schemas -> process_one_of ~ancestors schemas
| Some schemas -> process_one_of state ~ancestors schemas
| None ->
match schema.enum, schema.typ with
| Some enums, Some String -> process_string_enums enums
| Some enums, Some String -> process_string_enums state enums
| Some _, Some Integer ->
(* this is more lenient than it should *)
maybe_nullable (process_int_type schema)
maybe_nullable (process_int_type state schema)
| Some _, Some Number ->
(* this is more lenient than it should *)
maybe_nullable "float"
Expand All @@ -154,44 +170,44 @@ let rec process_schema_type ~ancestors (schema : schema) =
| Some _, _ -> failwith "only string enums are supported"
| None, _ ->
match schema.typ with
| Some Integer -> maybe_nullable (process_int_type schema)
| Some Integer -> maybe_nullable (process_int_type state schema)
| Some Number -> maybe_nullable "float"
| Some String -> maybe_nullable "string"
| Some Boolean -> maybe_nullable "bool"
| Some Array -> maybe_nullable (process_array_type ~ancestors schema |> String.concat " ")
| Some Object -> process_object_type ~ancestors schema
| Some Array -> maybe_nullable (process_array_type state ~ancestors schema |> String.concat " ")
| Some Object -> process_object_type state ~ancestors schema
| None ->
(* fallback to untyped if schema type is not defined *)
maybe_nullable "json"

and process_array_type ~ancestors schema =
and process_array_type state ~ancestors schema =
match schema.items with
| Some schema_or_ref -> [ make_type_from_schema_or_ref ~ancestors schema_or_ref; "list" ]
| Some schema_or_ref -> [ make_type_from_schema_or_ref state ~ancestors schema_or_ref; "list" ]
| None -> failwith "items is not specified for array"

and process_nested_schema_type ~ancestors schema =
and process_nested_schema_type state ~ancestors schema =
match merge_all_of schema with
| { one_of = Some _; _ } | { typ = Some Object; properties = Some _; _ } | { enum = Some _; _ } ->
let nested_type_name = concat_camelCase (List.rev ancestors) in
let nested =
define_type ~name:nested_type_name ~type_:(process_schema_type ~ancestors schema) ~doc:schema.description
define_type state ~name:nested_type_name ~type_:(process_schema_type state ~ancestors schema) ~doc:schema.description
in
Buffer.add_string output (nested ^ "\n");
type_name nested_type_name
| _ -> process_schema_type ~ancestors schema
| _ -> process_schema_type state ~ancestors schema

and process_object_type ~ancestors schema =
and process_object_type state ~ancestors schema =
let is_required field_name = List.exists (String.equal field_name) schema.required in
let make_record_field (field_name, schema_or_ref) =
let type_ = make_type_from_schema_or_ref ~ancestors:(field_name :: ancestors) schema_or_ref in
let record_field_name = record_field_name field_name in
let type_ = make_type_from_schema_or_ref state ~ancestors:(field_name :: ancestors) schema_or_ref in
let record_field_name = record_field_name state field_name in
let doc =
let content =
match schema_or_ref with
| Ref _ -> None
| Obj schema -> schema.description
in
Option.map doc_annotation content |> Option.value ~default:""
Option.map (doc_annotation state) content |> Option.value ~default:""
in
match schema_or_ref, is_required field_name with
| Obj { default = Some default; enum; _ }, _ ->
Expand All @@ -204,30 +220,30 @@ and process_object_type ~ancestors schema =
| Some properties -> sprintf "{\n%s\n}" (properties |> List.map make_record_field |> String.concat "\n")
| None -> "json"

and make_type_from_schema_or_ref ~ancestors (schema_or_ref : schema or_ref) =
and make_type_from_schema_or_ref state ~ancestors (schema_or_ref : schema or_ref) =
match schema_or_ref, ancestors with
| Obj schema, ([] | [ _ ]) -> process_schema_type ~ancestors schema
| Obj schema, ancestors -> process_nested_schema_type ~ancestors schema
| Obj schema, ([] | [ _ ]) -> process_schema_type state ~ancestors schema
| Obj schema, ancestors -> process_nested_schema_type state ~ancestors schema
| Ref ref_, _ -> type_name (get_ref_name ref_)

and process_one_of ~ancestors (schemas_or_refs : schema or_ref list) =
and process_one_of state ~ancestors (schemas_or_refs : schema or_ref list) =
let determine_variant_name = function
| Ref ref_ -> variant_name (get_ref_name ref_)
| Obj schema ->
match (merge_all_of schema).typ with
| Some Array -> concat_camelCase (process_array_type ~ancestors schema)
| Some Array -> concat_camelCase (process_array_type state ~ancestors schema)
| Some Object -> "Json"
| _ -> variant_name (process_schema_type ~ancestors schema)
| _ -> variant_name (process_schema_type state ~ancestors schema)
in
let make_one_of_variant schema_or_ref =
let variant_name = determine_variant_name schema_or_ref in
sprintf " | %s of %s" variant_name
(make_type_from_schema_or_ref ~ancestors:(variant_name :: ancestors) schema_or_ref)
(make_type_from_schema_or_ref state ~ancestors:(variant_name :: ancestors) schema_or_ref)
in
let variants = List.map make_one_of_variant schemas_or_refs |> String.concat "\n" in
sprintf "[\n%s\n] <json adapter.ocaml=\"Jsonschema2atd_runtime.Adapter.One_of\">" variants

and process_string_enums enums =
and process_string_enums _state enums =
let enums =
List.map
(function
Expand All @@ -244,15 +260,15 @@ and process_string_enums enums =
let variants = List.map make_enum_variant enums |> String.concat "\n" in
sprintf "[\n%s\n]" variants

let process_schemas (schemas : (string * schema or_ref) list) =
let process_schemas state (schemas : (string * schema or_ref) list) =
List.fold_left
(fun acc (name, schema_or_ref) ->
let doc =
match schema_or_ref with
| Ref _ -> None
| Obj schema -> schema.description
in
define_type ~doc ~name ~type_:(make_type_from_schema_or_ref ~ancestors:[ name ] schema_or_ref) :: acc
define_type state ~doc ~name ~type_:(make_type_from_schema_or_ref state ~ancestors:[ name ] schema_or_ref) :: acc
)
[] schemas

Expand All @@ -264,7 +280,7 @@ type int64 = int <ocaml repr="int64">
|}
from

let make_atd_of_schemas schemas =
let make_atd_of_schemas state schemas =
input_toplevel_schemas :=
List.filter_map
(function
Expand All @@ -273,23 +289,23 @@ let make_atd_of_schemas schemas =
)
schemas;
Buffer.clear output;
Buffer.add_string output (String.concat "\n" (process_schemas schemas));
Buffer.add_string output (String.concat "\n" (process_schemas state schemas));
Buffer.contents output

let make_atd_of_jsonschema ?(root = "root") input =
let make_atd_of_jsonschema ?(root = "root") ?(state = default_state) input =
let schema = Json_schema_j.schema_of_string input in
let root_type_name = Option.value ~default:root schema.title in
let defs =
let defs = List.concat_map Utils.list_of_nonempty [ schema.defs; schema.definitions ] in
List.map (fun (name, schema) -> name, Obj schema) defs
in
make_atd_of_schemas ([ root_type_name, Obj schema ] @ defs)
make_atd_of_schemas state ([ root_type_name, Obj schema ] @ defs)

let make_atd_of_openapi ?root:_ input =
let make_atd_of_openapi ?root:_ ?(state = default_state) input =
let root = Openapi_j.root_of_string input in
match root.components with
| None -> failwith "components are empty"
| Some components ->
match components.schemas with
| Some schemas -> make_atd_of_schemas schemas
| Some schemas -> make_atd_of_schemas state schemas
| None -> failwith "components schemas are empty"

0 comments on commit 8b34166

Please sign in to comment.