From 8b34166970fb24f146004cb164137a6197c44825 Mon Sep 17 00:00:00 2001 From: Seb Mondet Date: Mon, 25 Nov 2024 13:04:34 -0500 Subject: [PATCH] Add options `--skip-doc` and `--protect-against-duplicates` --- bin/main.ml | 14 +++++--- lib/generator.ml | 92 ++++++++++++++++++++++++++++-------------------- 2 files changed, 64 insertions(+), 42 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 66f1e12..52df737 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -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 = @@ -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 diff --git a/lib/generator.ml b/lib/generator.ml index 9982db8..ebbd08a 100644 --- a/lib/generator.ml +++ b/lib/generator.ml @@ -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 |} cleaned_field_name str -let doc_annotation text = sprintf {||} text +let doc_annotation state text = if state.with_doc then sprintf {||} 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" @@ -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" @@ -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; _ }, _ -> @@ -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] " variants -and process_string_enums enums = +and process_string_enums _state enums = let enums = List.map (function @@ -244,7 +260,7 @@ 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 = @@ -252,7 +268,7 @@ let process_schemas (schemas : (string * schema or_ref) list) = | 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 @@ -264,7 +280,7 @@ type int64 = int |} from -let make_atd_of_schemas schemas = +let make_atd_of_schemas state schemas = input_toplevel_schemas := List.filter_map (function @@ -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"