diff --git a/CHANGES.md b/CHANGES.md index 6eeec530..7d42fbfc 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,7 @@ -UNRELEASED +Next release ------------------ +* atdgen: update `abstract` type validation to accept all input by default (#301) * atdts: fix reader for case type (#302) 2.8.0 (2022-06-06) diff --git a/atdgen/src/ocaml.ml b/atdgen/src/ocaml.ml index d9f604f0..4cf01ccc 100644 --- a/atdgen/src/ocaml.ml +++ b/atdgen/src/ocaml.ml @@ -661,6 +661,7 @@ let rec ocaml_of_expr_mapping (x : (Repr.t, _) mapping) : ocaml_expr = `Name (s, List.map ocaml_of_expr_mapping l) | Tvar (_, s) -> `Tvar s + | Abstract _ -> `Name ("Yojson.Safe.t", []) | _ -> assert false and ocaml_of_variant_mapping x = diff --git a/atdgen/src/ov_emit.ml b/atdgen/src/ov_emit.ml index 554624da..68374e74 100644 --- a/atdgen/src/ov_emit.ml +++ b/atdgen/src/ov_emit.ml @@ -149,7 +149,8 @@ let rec get_validator_name | Bool (_, Bool, v) | Int (_, Int _, v) | Float (_, Float, v) - | String (_, String, v) -> + | String (_, String, v) + | Abstract (_, Abstract, v) -> (match v with (None, true) -> return_true_paren | (Some s, true) -> s @@ -202,6 +203,7 @@ let rec make_validator (x : ov_mapping) : Indent.t list = | String _ | Name _ | External _ + | Abstract _ | Tvar _ -> [ Line (get_validator_name x) ] | Sum (_, a, Sum x, (v, shallow)) -> diff --git a/atdgen/src/ov_mapping.ml b/atdgen/src/ov_mapping.ml index a6e9eb9b..198dccf2 100644 --- a/atdgen/src/ov_mapping.ml +++ b/atdgen/src/ov_mapping.ml @@ -207,6 +207,8 @@ let rec mapping_of_expr Float (loc, Float, (v an, true)) | "string" -> String (loc, String, (v an, true)) + | "abstract" -> + Abstract (loc, Abstract, (v an, true)) | s -> let validator = match v2 an x0 with @@ -307,13 +309,14 @@ let def_of_atd is_shallow (loc, (name, param, an), x) = let o = match as_abstract x with | Some (_, an2) -> - Ocaml.get_ocaml_module_and_t Validate name an - |> Option.map (fun (types_module, main_module, ext_name) -> - let args = List.map (fun s -> Tvar (loc, s)) param in - External (loc, name, args, - Ocaml.Repr.External (types_module, main_module, ext_name), - (Validate.get_validator an2, false)) - ) + (match Ocaml.get_ocaml_module_and_t Validate name an with + | None -> Some (mapping_of_expr is_shallow x) + | Some (types_module, main_module, ext_name) -> + let args = List.map (fun s -> Tvar (loc, s)) param in + Some (External (loc, name, args, + Ocaml.Repr.External (types_module, main_module, ext_name), + (Validate.get_validator an2, false)))) + | None -> Some (mapping_of_expr is_shallow x) in { diff --git a/atdgen/test/dune b/atdgen/test/dune index 726394d0..c79d5194 100644 --- a/atdgen/test/dune +++ b/atdgen/test/dune @@ -319,6 +319,11 @@ (deps test_abstract.atd) (action (run %{bin:atdgen} -j %{deps}))) +(rule + (targets test_abstract_v.ml test_abstract_v.mli) + (deps test_abstract.atd) + (action (run %{bin:atdgen} -v %{deps}))) + (rule (alias runtest) (package atdgen) @@ -326,8 +331,10 @@ (progn (diff test_abstract_t.expected.mli test_abstract_t.mli) (diff test_abstract_j.expected.mli test_abstract_j.mli) + (diff test_abstract_v.expected.mli test_abstract_v.mli) (diff test_abstract_t.expected.ml test_abstract_t.ml) (diff test_abstract_j.expected.ml test_abstract_j.ml) + (diff test_abstract_v.expected.ml test_abstract_v.ml) ) ) ) diff --git a/atdgen/test/test_abstract_v.expected.ml b/atdgen/test/test_abstract_v.expected.ml new file mode 100644 index 00000000..de39a431 --- /dev/null +++ b/atdgen/test/test_abstract_v.expected.ml @@ -0,0 +1,33 @@ +(* Auto-generated from "test_abstract.atd" *) +[@@@ocaml.warning "-27-32-33-35-39"] + +type int_assoc_list = Testj.int_assoc_list + +type any_items = Test_abstract_t.any_items + +type any = Test_abstract_t.any + +type 'x abs2 = 'x Test.abs2 + +type 'x abs1 = 'x Test_abstract_t.abs1 + +let validate_int_assoc_list = ( + Testj.validate_int_assoc_list +) +let validate__1 = ( + Atdgen_runtime.Ov_run.validate_list ( + (fun _ _ -> None) + ) +) +let validate_any_items = ( + validate__1 +) +let validate_any = ( + (fun _ _ -> None) +) +let validate_abs2 validate__x = ( + Test.validate_abs2 validate__x +) +let validate_abs1 validate__x = ( + (fun _ _ -> None) +) diff --git a/atdgen/test/test_abstract_v.expected.mli b/atdgen/test/test_abstract_v.expected.mli new file mode 100644 index 00000000..083b6cac --- /dev/null +++ b/atdgen/test/test_abstract_v.expected.mli @@ -0,0 +1,35 @@ +(* Auto-generated from "test_abstract.atd" *) +[@@@ocaml.warning "-27-32-33-35-39"] + +type int_assoc_list = Testj.int_assoc_list + +type any_items = Test_abstract_t.any_items + +type any = Test_abstract_t.any + +type 'x abs2 = 'x Test.abs2 + +type 'x abs1 = 'x Test_abstract_t.abs1 + +val validate_int_assoc_list : + Atdgen_runtime.Util.Validation.path -> int_assoc_list -> Atdgen_runtime.Util.Validation.error option + (** Validate a value of type {!type:int_assoc_list}. *) + +val validate_any_items : + Atdgen_runtime.Util.Validation.path -> any_items -> Atdgen_runtime.Util.Validation.error option + (** Validate a value of type {!type:any_items}. *) + +val validate_any : + Atdgen_runtime.Util.Validation.path -> any -> Atdgen_runtime.Util.Validation.error option + (** Validate a value of type {!type:any}. *) + +val validate_abs2 : + (Atdgen_runtime.Util.Validation.path -> 'x -> Atdgen_runtime.Util.Validation.error option) -> + Atdgen_runtime.Util.Validation.path -> 'x abs2 -> Atdgen_runtime.Util.Validation.error option + (** Validate a value of type {!type:abs2}. *) + +val validate_abs1 : + (Atdgen_runtime.Util.Validation.path -> 'x -> Atdgen_runtime.Util.Validation.error option) -> + Atdgen_runtime.Util.Validation.path -> 'x abs1 -> Atdgen_runtime.Util.Validation.error option + (** Validate a value of type {!type:abs1}. *) + diff --git a/atdgen/test/testv.expected.ml b/atdgen/test/testv.expected.ml index bf0171ff..e1e3fa8d 100644 --- a/atdgen/test/testv.expected.ml +++ b/atdgen/test/testv.expected.ml @@ -476,6 +476,9 @@ let validate__27 = ( let validate_even_natural = ( validate__27 ) +let validate_def = ( + (fun _ _ -> None) +) let validate_char = ( (fun _ _ -> None) ) diff --git a/atdgen/test/testv.expected.mli b/atdgen/test/testv.expected.mli index 95617efe..184eb5e8 100644 --- a/atdgen/test/testv.expected.mli +++ b/atdgen/test/testv.expected.mli @@ -404,6 +404,10 @@ val validate_even_natural : Atdgen_runtime.Util.Validation.path -> even_natural -> Atdgen_runtime.Util.Validation.error option (** Validate a value of type {!type:even_natural}. *) +val validate_def : + Atdgen_runtime.Util.Validation.path -> def -> Atdgen_runtime.Util.Validation.error option + (** Validate a value of type {!type:def}. *) + val validate_char : Atdgen_runtime.Util.Validation.path -> char -> Atdgen_runtime.Util.Validation.error option (** Validate a value of type {!type:char}. *)