Merge pull request #295 from ahrefs/mj-abstract

Interpret 'abstract' as "any data" by default

CHANGES.md

@@ -11,6 +11,10 @@ Next release
 * atdcat: add command-line option to choose the version of JSON Schema
   to target. Options are the latest version "Draft 2020-12" and the
   previous version "Draft 2019-09" (#294).
+* ATD language: the `abstract` built-in can now be used like any
+  other type to hold untyped data, if the implementation supports it.
+  The supported targets so far are OCaml/JSON (atdgen), Python
+  (atdpy), TypeScript (atdts), JSON Schema (atdcat) (#295).
 
 2.6.0 (2022-05-03)
 ------------------

atd/src/json.ml

@@ -50,6 +50,7 @@ type json_sum = {
    into (json_repr * json_adapter).
 *)
 type json_repr =
+  | Abstract
   | Bool
   | Cell
   | Def

atd/src/json.mli

@@ -45,6 +45,7 @@ type json_sum = {
 
 (** The different kinds of ATD nodes with their json-specific options. *)
 type json_repr =
+  | Abstract
   | Bool
   | Cell
   | Def

atd/src/jsonschema.ml

@@ -40,6 +40,7 @@ type type_expr =
   | Union of type_expr list
   | Nullable of type_expr
   | Const of json * opt_descr
+  | Any
 
 and object_ = {
   properties: property list;
@@ -160,6 +161,7 @@ let trans_type_expr ~xprop (x : Ast.type_expr) : type_expr =
          | "int" -> Integer
          | "float" -> Number
          | "string" -> String
+         | "abstract" -> Any
          | _ -> Ref (make_id name)
         )
   in
@@ -257,6 +259,8 @@ let rec type_expr_to_assoc ?(is_nullable = false) ~version (x : type_expr)
       [ make_type_property ~is_nullable "number" ]
   | String ->
       [ make_type_property ~is_nullable "string" ]
+  | Any ->
+      []
   | Array x ->
       [
         make_type_property ~is_nullable "array";

atdcat/test/data.json

@@ -10,5 +10,6 @@
   "assoc2": { "c": 3, "d": 4 },
   "options": [ [ "Some", 10 ], "None", [ "Some", 88 ] ],
   "nullables": [ 13, 71, null ],
+  "untyped_things": [123, [[""]], {}],
   "extra": "ignore me please"
 }

atdcat/test/schema-draft-2019-09.expected.json

@@ -59,7 +59,8 @@
     "nullables": {
       "type": "array",
       "items": { "type": [ "integer", "null" ] }
-    }
+    },
+    "untyped_things": { "type": "array", "items": {} }
   },
   "definitions": {
     "different_kinds_of_things": {

atdcat/test/schema-no-xprop.expected.json

@@ -60,7 +60,8 @@
     "nullables": {
       "type": "array",
       "items": { "type": [ "integer", "null" ] }
-    }
+    },
+    "untyped_things": { "type": "array", "items": {} }
   },
   "definitions": {
     "different_kinds_of_things": {

atdcat/test/schema.atd

@@ -35,6 +35,7 @@ type root
   assoc2: (string * int) list <json repr="object">;
   ~options: int option list;
   ~nullables: int nullable list;
+  ~untyped_things: abstract list;
 }
 
 type alias = int list

atdcat/test/schema.expected.json

@@ -59,7 +59,8 @@
     "nullables": {
       "type": "array",
       "items": { "type": [ "integer", "null" ] }
-    }
+    },
+    "untyped_things": { "type": "array", "items": {} }
   },
   "definitions": {
     "different_kinds_of_things": {

atdgen-runtime/src/oj_run.ml

@@ -158,6 +158,10 @@ let read_string p lb =
   Yojson.Safe.read_space p lb;
   Yojson.Safe.read_string p lb
 
+let read_json p lb =
+  Yojson.Safe.read_space p lb;
+  Yojson.Safe.read_json p lb
+
 let read_list read_item p lb =
   Yojson.Safe.read_space p lb;
   Yojson.Safe.read_list read_item p lb

atdgen-runtime/src/oj_run.mli

@@ -27,6 +27,7 @@ val read_int8 : char read
 val read_int32 : int32 read
 val read_int64 : int64 read
 val read_string : string read
+val read_json : Yojson.Safe.t read
 val read_array : 'a read -> 'a array read
 val read_assoc_list : 'a read -> 'b read -> ('a * 'b) list read
 val read_assoc_array : 'a read -> 'b read -> ('a * 'b) array read

atdgen/src/mapping.ml

@@ -11,6 +11,7 @@ type ('a, 'b) mapping =
   | Int of loc * 'a * 'b
   | Float of loc * 'a * 'b
   | String of loc * 'a * 'b
+  | Abstract of loc * 'a * 'b
   | Sum of loc * ('a, 'b) variant_mapping array * 'a * 'b
   | Record of loc * ('a, 'b) field_mapping array * 'a * 'b
   | Tuple of loc * ('a, 'b) cell_mapping array * 'a * 'b
@@ -55,7 +56,6 @@ type ('a, 'b) def = {
   def_brepr : 'b;
 }
 
-
 let as_abstract = function
     Atd.Ast.Name (_, (loc, "abstract", l), a) ->
       if l <> [] then
@@ -66,14 +66,14 @@ let as_abstract = function
 
 let is_abstract x = as_abstract x <> None
 
-
 let loc_of_mapping x =
   match (x : (_, _) mapping) with
     | Unit (loc, _, _)
     | Bool (loc, _, _)
     | Int (loc, _, _)
     | Float (loc, _, _)
     | String (loc, _, _)
+    | Abstract (loc, _, _)
     | Sum (loc, _, _, _)
     | Record (loc, _, _, _)
     | Tuple (loc, _, _, _)
@@ -94,7 +94,8 @@ let rec subst env (x : (_, _) mapping) =
   | Bool (_, _, _)
   | Int (_, _, _)
   | Float (_, _, _)
-  | String (_, _, _) -> x
+  | String (_, _, _)
+  | Abstract (_, _, _) -> x
   | Sum (loc, ar, a, b) ->
       Sum (loc, Array.map (subst_variant env) ar, a, b)
   | Record (loc, ar, a, b) ->

atdgen/src/mapping.mli

@@ -17,6 +17,7 @@ type ('a, 'b) mapping =
   | Int of loc * 'a * 'b
   | Float of loc * 'a * 'b
   | String of loc * 'a * 'b
+  | Abstract of loc * 'a * 'b
   | Sum of loc * ('a, 'b) variant_mapping array * 'a * 'b
   | Record of loc * ('a, 'b) field_mapping array * 'a * 'b
   | Tuple of loc * ('a, 'b) cell_mapping array * 'a * 'b

atdgen/src/ocaml.ml

@@ -63,6 +63,7 @@ module Repr = struct
     | Int of atd_ocaml_int
     | Float
     | String
+    | Abstract
     | Sum of atd_ocaml_sum
     | Record of atd_ocaml_record
     | Tuple
@@ -86,6 +87,7 @@ end
 
 type target = Default | Biniou | Json | Validate | Bucklescript
 
+let all_targets = [ Default; Biniou; Json; Validate; Bucklescript ]
 
 let ocaml_int_of_string s : atd_ocaml_int option =
   match s with
@@ -198,6 +200,7 @@ let get_ocaml_type_path target atd_name an =
       | "int" -> `Int (get_ocaml_int target an)
       | "float" -> `Float
       | "string" -> `String
+      | "abstract" -> `Abstract
       | s -> `Name s
   in
   match x with
@@ -206,6 +209,7 @@ let get_ocaml_type_path target atd_name an =
     | `Int x -> string_of_ocaml_int x
     | `Float -> "float"
     | `String -> "string"
+    | `Abstract -> "Yojson.Safe.t"
     | `Name s -> s
 
 let get_ocaml_sum target an =
@@ -405,6 +409,16 @@ and ocaml_variant =
 and ocaml_field =
     (string * bool (* is mutable? *)) * ocaml_expr * Atd.Doc.doc option
 
+(*
+   OCaml type definition:
+
+     type foo = Baz_t.foo = bar list [@@what ever]
+          ^^^   ^^^^^^^^^   ^^^^^^^^ ^^^^^^^^^^^^^
+          name  alias       expr     ppx attrs
+
+  A useful definition in the context of ATD would have at least an expr
+  or an alias.
+*)
 type ocaml_def = {
   o_def_name : (string * ocaml_type_param);
   o_def_alias : (string * ocaml_type_param) option;
@@ -496,15 +510,64 @@ and map_field target ocaml_field_prefix (x : field) : ocaml_field =
       let is_mutable = get_ocaml_mutable target an in
       ((fname, is_mutable), map_expr target [] x, Atd.Doc.get_doc loc an)
 
+
+(* hack to deal with legacy behavior *)
+let lhs_has_possibly_relevant_annotation
+    ((loc, (name, param, an1), x) : type_def) =
+  List.exists
+    (fun target -> get_ocaml_module_and_t target name an1 <> None)
+    all_targets
+
+(* hack to deal with legacy behavior *)
+let rhs_is_just_abstract ((loc, (name, param, an1), x) : type_def) =
+  match x with
+  | Atd.Ast.Name (_, (loc, "abstract", type_params), an2) ->
+      if type_params <> [] then
+        Error.error loc "\"abstract\" takes no type parameters";
+      true
+  | _ ->
+      false
+
+(*
+   This is an ATD definition of the form
+
+     type foo <...> = abstract
+
+   e.g.
+
+     type foo <ocaml from="Foo"> = abstract
+
+   where the right-hand side is exactly 'abstract' and is ignored.
+   This is weird and will be deprecated as soon as we implement
+   a clean module system allowing us to import whole modules without
+   special annotations.
+
+   The annotation <...> on the left-hand side specifies the type name and
+   readers/writers to be used. They are placed there rather than
+   directly on 'abstract' for "historical reasons". We preserve the legacy
+   behavior unless there's no suitable left-hand side annotation.
+
+   The following is valid and follows the more recent convention that
+   'abstract' means "untyped data". It is NOT considered an abstract
+   definition:
+
+     type foo = abstract
+                ^^^^^^^^
+                JSON or biniou AST representing raw data
+*)
+let is_abstract_def (x : type_def) =
+  lhs_has_possibly_relevant_annotation x
+  && rhs_is_just_abstract x
+
 let map_def
     ~(target : target)
     ~(type_aliases : string option)
-    ((loc, (s, param, an1), x) : type_def) : ocaml_def option =
+    ((loc, (s, param, an1), x) as def : type_def) : ocaml_def option =
   if is_ocaml_keyword s then
     Error.error loc
       ("\"" ^ s ^ "\" cannot be used as type name (reserved OCaml keyword)");
   let is_predef = get_ocaml_predef target an1 in
-  let is_abstract = Mapping.is_abstract x in
+  let is_abstract = is_abstract_def def in
   let define_alias =
     if is_predef || is_abstract || type_aliases <> None then
       match get_ocaml_module_and_t target s an1, type_aliases with
@@ -524,9 +587,19 @@ let map_def
     let alias, x =
       match define_alias with
           None ->
+            (* Ordinary type definitions or aliases:
+                 type foo = string * int
+                 type foo = bar
+                 type foo = { hello: string }
+            *)
             if is_abstract then (None, None)
             else (None, Some (map_expr target param x))
         | Some (module_path, ext_name) ->
+            (*
+                 type foo = Bar_t.foo = { hello: string }
+               or
+                 type foo = Bar_t.foo = Alpha | Beta of int
+            *)
             let alias = Some (module_path ^ "." ^ ext_name, param) in
             let x =
               match map_expr target param x with

atdgen/src/ocaml.mli

@@ -42,6 +42,7 @@ module Repr : sig
     | Int of atd_ocaml_int
     | Float
     | String
+    | Abstract
     | Sum of atd_ocaml_sum
     | Record of atd_ocaml_record
     | Tuple

atdgen/src/oj_emit.ml

@@ -153,6 +153,9 @@ let rec get_writer_name
   | String (_, String, String) ->
       "Yojson.Safe.write_string"
 
+  | Abstract (_, Abstract, Abstract) ->
+      "Yojson.Safe.write_json"
+
   | Tvar (_, s) -> "write_" ^ (Ox_emit.name_of_var s)
 
   | Name (_, s, args, None, None) ->
@@ -170,7 +173,9 @@ let rec get_writer_name
       if paren && l <> [] then "(" ^ s ^ ")"
       else s
 
-  | _ -> assert false
+  | Unit _ | Bool _ | Int _ | Float _ | String _ | Abstract _
+  | Sum _ | Record _ | Tuple _ | List _ | Option _ | Nullable _
+  | Wrap _ | Name _ | External _ -> assert false
 
 
 let get_left_writer_name p name param =
@@ -204,6 +209,8 @@ let rec get_reader_name
 
   | String (_, String, String) -> "Atdgen_runtime.Oj_run.read_string"
 
+  | Abstract (_, Abstract, Abstract) -> "Atdgen_runtime.Oj_run.read_json"
+
   | Tvar (_, s) -> "read_" ^ Ox_emit.name_of_var s
 
   | Name (_, s, args, None, None) ->
@@ -221,7 +228,9 @@ let rec get_reader_name
       if paren && l <> [] then "(" ^ s ^ ")"
       else s
 
-  | _ -> assert false
+  | Unit _ | Bool _ | Int _ | Float _ | String _ | Abstract _
+  | Sum _ | Record _ | Tuple _ | List _ | Option _ | Nullable _
+  | Wrap _ | Name _ | External _ -> assert false
 
 
 let get_left_reader_name p name param =
@@ -258,6 +267,7 @@ let rec make_writer ?type_constraint p (x : Oj_mapping.t) : Indent.t list =
   | Int _
   | Float _
   | String _
+  | Abstract _
   | Name _
   | External _
   | Tvar _ -> [ Line (get_writer_name p x) ]
@@ -386,7 +396,8 @@ let rec make_writer ?type_constraint p (x : Oj_mapping.t) : Indent.t list =
            ]
       )
 
-  | _ -> assert false
+  | Sum _ | Record _ | Tuple _ | List _ | Option _ | Nullable _ | Wrap _ ->
+      assert false
 
 
 and make_variant_writer p ~tick ~open_enum x : Indent.t list =
@@ -599,6 +610,7 @@ let rec make_reader p type_annot (x : Oj_mapping.t) : Indent.t list =
   | Int _
   | Float _
   | String _
+  | Abstract _
   | Name _
   | External _
   | Tvar _ -> [ Line (get_reader_name p x) ]
@@ -768,7 +780,8 @@ let rec make_reader p type_annot (x : Oj_mapping.t) : Indent.t list =
            ]
       )
 
-  | _ -> assert false
+  | Sum _ | Record _ | Tuple _ | List _ | Option _ | Nullable _ | Wrap _ ->
+      assert false
 
 (*
    Return a pair (optional json constructor, expression) to be converted

atdgen/src/oj_mapping.ml

@@ -100,6 +100,8 @@ let rec mapping_of_expr (x : type_expr) =
            Float (loc, Float, Float j)
        | "string" ->
            String (loc, String, String)
+       | "abstract" ->
+           Abstract (loc, Abstract, Abstract)
        | s ->
            Name (loc, s, List.map mapping_of_expr l, None, None)
       )