Merge pull request #301 from metanivek/abstract_validation

atdgen: update `abstract` type validation to accept all input by default

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)

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 =

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)) ->

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
   {

atdgen/test/dune

@@ -319,15 +319,22 @@
  (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)
  (action
    (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)
    )
  )
 )

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)
+)

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}. *)
+

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)
 )

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}. *)