atddiff: Add an option to output JSON (#370)

* Prepare for JSON output

* Make JSON output more amenable to future format changes

* Output JSON with '--output-format json'

* Update changelog

---------

Co-authored-by: Martin Jambon <[email protected]>

Author: mjambon

CHANGES.md

@@ -7,6 +7,8 @@ Unreleased
 * atddiff now supports options for filtering the findings based on the 
   direction of the incompatibility (`--backward`, `--forward`) or based on the  
   name of the affected types (`--types`) (#365)
+* atddiff: new option `--output-format json` for exporting the results to
+  JSON (#360)
 
 2.13.0 (2023-10-15)
 -------------------

atddiff/Makefile

@@ -13,3 +13,9 @@ build:
 .PHONY: test
 test:
 	$(MAKE) -C test
+
+# Update the output format of atddiff by running 'make types'.
+# This requires an external installation of the atdgen command.
+.PHONY: types
+types:
+	$(MAKE) -C src/lib types

atddiff/src/bin/Atddiff_main.ml

@@ -12,6 +12,7 @@ type conf = {
   filter: Atddiff.filter;
   json_defaults_old: bool;
   json_defaults_new: bool;
+  output_format: Atddiff.output_format;
   exit_success: bool;
   version: bool;
 }
@@ -42,6 +43,7 @@ let run conf =
         ~filter:conf.filter
         ~json_defaults_old:conf.json_defaults_old
         ~json_defaults_new:conf.json_defaults_new
+        ~output_format:conf.output_format
         conf.old_file conf.new_file in
     let exit_code, data =
       match out_data with
@@ -151,6 +153,19 @@ let json_defaults_new_term : bool Term.t =
   in
   Arg.value (Arg.flag info)
 
+let output_format_term : Atddiff.output_format Term.t =
+  let info =
+    Arg.info ["output-format"; "f"]
+      ~doc:(
+        "Output JSON instead of text. The format is specified by the file \
+         Atddiff_output.atd that's included in the source distribution of \
+         ATD. At the time of writing, its location is \
+         https://github.com/ahrefs/atd/blob/master/atddiff/src/lib/Atddiff_output.atd")
+  in
+  Arg.value (Arg.opt (Arg.enum ["text", Atddiff.Text;
+                                "json", Atddiff.JSON])
+               Atddiff.Text info)
+
 let exit_success_term : bool Term.t =
   let info =
     Arg.info ["exit-success"]
@@ -213,6 +228,7 @@ let cmdline_term run =
       old_file new_file out_file
       backward forward types
       json_defaults json_defaults_old json_defaults_new
+      output_format
       exit_success version =
     let filter =
       let module A = Atddiff in
@@ -239,6 +255,7 @@ let cmdline_term run =
       filter;
       json_defaults_old;
       json_defaults_new;
+      output_format;
       exit_success;
       version;
     }
@@ -253,6 +270,7 @@ let cmdline_term run =
         $ json_defaults_term
         $ json_defaults_old_term
         $ json_defaults_new_term
+        $ output_format_term
         $ exit_success_term
         $ version_term
        )

atddiff/src/lib/Atddiff.ml

@@ -2,6 +2,8 @@
     Internal Atddiff library used by the 'atddiff' command.
 *)
 
+module T = Atddiff_output_t
+
 type simple_filter =
   | Affected_type_name of string
   | Backward
@@ -17,10 +19,7 @@ type output_format = Text | JSON
 
 let version = Version.version
 
-let format_json res : string =
-  failwith "JSON output: not implemented"
-
-let rec select_finding filter (x : Types.finding * string list) =
+let rec select_finding filter (x : T.full_finding) =
   match filter with
   | Or filters ->
       List.exists (fun filter -> select_finding filter x) filters
@@ -29,17 +28,14 @@ let rec select_finding filter (x : Types.finding * string list) =
   | Not filter ->
       not (select_finding filter x)
   | Filter (Affected_type_name name) ->
-      let _, names = x in
-      List.mem name names
+      List.mem name x.affected_types
   | Filter Backward ->
-      let finding, _ = x in
-      (match finding.direction with
+      (match x.finding.direction with
        | Backward | Both -> true
        | Forward -> false
       )
   | Filter Forward ->
-      let finding, _ = x in
-      (match finding.direction with
+      (match x.finding.direction with
        | Forward | Both -> true
        | Backward -> false
       )
@@ -67,12 +63,13 @@ let compare_files
     } in
     Compare.asts options ast1 ast2
   in
-  match res with
+  match res.findings with
   | [] -> Ok ()
-  | res ->
-      let res = List.filter (select_finding filter) res in
+  | findings ->
+      let res : T.result =
+        { findings = List.filter (select_finding filter) findings } in
       Error (
         match output_format with
         | Text -> Format_text.to_string res
-        | JSON -> format_json res
+        | JSON -> Format_JSON.to_string res ^ "\n"
       )

atddiff/src/lib/Types.ml atddiff/src/lib/Atddiff_output.atd

@@ -1,17 +1,46 @@
 (*
    Type definitions used to build comparison results
+
+   We don't derive OCaml serializers from this file with atdgen due to
+   circular dependencies but we derive the OCaml types by calling atdgen
+   and keeping the result under source control:
+
+     atdgen -t Atddiff_output.atd
+
+   This provides an ATD specification to users who consume the JSON
+   output of the atddiff.
 *)
 
-type direction = Backward | Forward | Both
+type position = {
+  path: string;
+  line: int;
+  column: int;
+}
+
+type location = {
+  start: position;
+  end <ocaml name="end_">: position;
+}
+
+type direction = [ Backward | Forward | Both ] <ocaml repr="classic">
 
-type incompatibility_kind =
-  | Missing_field of { field_name: string }
-  | Missing_variant of { variant_name: string }
-  | Missing_variant_argument of { variant_name: string }
-  | Default_required of { field_name: string }
+type field_info = {
+  field_name: string
+}
+
+type variant_info = {
+  variant_name: string
+}
+
+type incompatibility_kind = [
+  | Missing_field of field_info
+  | Missing_variant of variant_info
+  | Missing_variant_argument of variant_info
+  | Default_required of field_info
   | Incompatible_type
   | Deleted_type
   | Added_type
+] <ocaml repr="classic">
 
 (*
    Important things we want to report:
@@ -49,20 +78,22 @@ type incompatibility_kind =
 type finding = {
   direction: direction;
   kind: incompatibility_kind;
-  location_old: Atd.Ast.loc option;
-  location_new: Atd.Ast.loc option;
+  location_old: location option;
+  location_new: location option;
 
   (* The description should not mention the affected root type definition
      so as to allow the deduplication of findings. *)
   description: string;
 }
 
-(*
-   A result is a list of unique findings and the list of root types
-   affected by the finding.
+type full_finding = {
+  finding: finding;
+  affected_types: string list;
+}
 
-   For now, we don't try to identify root type renames so each finding is
-   associated to just one root type name which exists in one or both versions
-   of the file.
+(*
+   A result is a list of unique findings.
 *)
-type result = (finding * string list) list
+type result = {
+  findings: full_finding list;
+}

atddiff/src/lib/Atddiff_output_t.ml

@@ -0,0 +1,34 @@
+(* Auto-generated from "Atddiff_output.atd" *)
+[@@@ocaml.warning "-27-32-33-35-39"]
+
+type variant_info = { variant_name: string }
+
+type position = { path: string; line: int; column: int }
+
+type location = { start: position; end_ (*atd end *): position }
+
+type field_info = { field_name: string }
+
+type incompatibility_kind = 
+    Missing_field of field_info
+  | Missing_variant of variant_info
+  | Missing_variant_argument of variant_info
+  | Default_required of field_info
+  | Incompatible_type
+  | Deleted_type
+  | Added_type
+
+
+type direction =  Backward | Forward | Both 
+
+type finding = {
+  direction: direction;
+  kind: incompatibility_kind;
+  location_old: location option;
+  location_new: location option;
+  description: string
+}
+
+type full_finding = { finding: finding; affected_types: string list }
+
+type result = { findings: full_finding list }

atddiff/src/lib/Atddiff_output_t.mli

@@ -0,0 +1,34 @@
+(* Auto-generated from "Atddiff_output.atd" *)
+[@@@ocaml.warning "-27-32-33-35-39"]
+
+type variant_info = { variant_name: string }
+
+type position = { path: string; line: int; column: int }
+
+type location = { start: position; end_ (*atd end *): position }
+
+type field_info = { field_name: string }
+
+type incompatibility_kind = 
+    Missing_field of field_info
+  | Missing_variant of variant_info
+  | Missing_variant_argument of variant_info
+  | Default_required of field_info
+  | Incompatible_type
+  | Deleted_type
+  | Added_type
+
+
+type direction =  Backward | Forward | Both 
+
+type finding = {
+  direction: direction;
+  kind: incompatibility_kind;
+  location_old: location option;
+  location_new: location option;
+  description: string
+}
+
+type full_finding = { finding: finding; affected_types: string list }
+
+type result = { findings: full_finding list }