return json for comparison of two builds when header has accept json

lib/builder_web.ml

@@ -546,7 +546,20 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
     |> Lwt_result.ok
   in
 
-  let compare_builds req =
+
+  let resolve_artifact id_opt conn =
+    let default_file : Builder_db.file = {
+      filepath = Fpath.v "null";
+      sha256 = "0";
+      size = -1;
+    } in
+    match id_opt with
+    | None -> Lwt.return_ok default_file
+    | Some id -> Model.build_artifact_by_id id conn
+
+  in
+
+  let process_comparison req =
     let build_left = Dream.param req "build_left" in
     let build_right = Dream.param req "build_right" in
     get_uuid build_left >>= fun build_left ->
@@ -566,14 +579,16 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
         Model.build_artifact_data datadir >>= fun build_env_right ->
         Model.build_artifact build_right.Builder_db.Build.uuid (Fpath.v "system-packages") conn >>=
         Model.build_artifact_data datadir >>= fun system_packages_right ->
+        resolve_artifact build_left.Builder_db.Build.main_binary conn >>= fun build_left_file ->
+        resolve_artifact build_right.Builder_db.Build.main_binary conn >>= fun build_right_file ->
         Model.job_name build_left.job_id conn >>= fun job_left ->
         Model.job_name build_right.job_id conn >|= fun job_right ->
-        (job_left, job_right, build_left, build_right,
+        (job_left, job_right, build_left, build_right, build_left_file,
-         switch_left, build_env_left, system_packages_left,
+         build_right_file, switch_left, build_env_left, system_packages_left,
          switch_right, build_env_right, system_packages_right))
     |> if_error "Internal server error"
-    >>= fun (job_left, job_right, build_left, build_right,
+    >>= fun (job_left, job_right, build_left, build_right, build_left_file,
-             switch_left, build_env_left, system_packages_left,
+              build_right_file, switch_left, build_env_left, system_packages_left,
              switch_right, build_env_right, system_packages_right) ->
     let env_diff = Utils.compare_env build_env_left build_env_right
     and pkg_diff = Utils.compare_pkgs system_packages_left system_packages_right
@@ -581,15 +596,50 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
     let switch_left = OpamFile.SwitchExport.read_from_string switch_left
     and switch_right = OpamFile.SwitchExport.read_from_string switch_right in
     let opam_diff = Opamdiff.compare switch_left switch_right in
-    Views.compare_builds
+    (job_left, job_right, build_left, build_right, build_left_file, build_right_file, env_diff, pkg_diff, opam_diff)
-      ~job_left ~job_right
+    |> Lwt.return_ok
-      ~build_left ~build_right
+
-      ~env_diff
-      ~pkg_diff
-      ~opam_diff
-    |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 
+  let compare_builds req =
+    process_comparison req >>= fun
+    (job_left, job_right, build_left, build_right, build_left_file, build_right_file, env_diff, pkg_diff, opam_diff) ->
+      match Dream.header req "Accept" with
+        | Some accept when String.starts_with ~prefix:"application/json" accept ->
+          let json_response =
+            `Assoc [
+              "left", `Assoc [
+                "job", `String job_left;
+                "build", `String (Uuidm.to_string build_left.uuid);
+                "platform", `String build_left.platform;
+                "build_start_time", `String (Ptime.to_rfc3339 build_left.start);
+                "build_finish_time", `String (Ptime.to_rfc3339 build_left.finish);
+                "build_size", `Int (build_left_file.size)
+              ];
+              "right", `Assoc [
+                "job", `String job_right;
+                "build", `String (Uuidm.to_string build_right.uuid);
+                "platform", `String build_right.platform;
+                "build_start_time", `String (Ptime.to_rfc3339 build_right.start);
+                "build_finish_time", `String (Ptime.to_rfc3339 build_right.finish);
+                "build_size", `Int (build_right_file.size)
+              ];
+              "env_diff", Utils.diff_map_to_json env_diff;
+              "package_diff", Utils.diff_map_to_json pkg_diff;
+              "opam_diff", Opamdiff.compare_to_json opam_diff
+            ] |> Yojson.Basic.to_string
+          in
+          Dream.json ~status:`OK json_response |> Lwt_result.ok
+        | _ ->
+          Views.compare_builds
+            ~job_left ~job_right
+            ~build_left ~build_right
+            ~env_diff
+            ~pkg_diff
+            ~opam_diff
+          |> string_of_html |> Dream.html |> Lwt_result.ok
+     in
+
   let upload_binary req =
     let job = Dream.param req "job" in
     let platform = Dream.param req "platform" in

lib/utils.ml

@@ -6,6 +6,27 @@ module String_map = struct
     update key (function None -> Some [ v ] | Some xs -> Some (v :: xs)) t
 end
 
+let diff_map_to_json (left, right, different_versions) =
+  let convert_list lst =
+    `List (List.map (fun (name, version) ->
+      `Assoc [("name", `String name); ("version", `String version)]
+    ) lst)
+  in
+  let convert_diff_versions lst =
+    `List (List.map (fun (name, version1, version2) ->
+      `Assoc [
+        ("name", `String name);
+        ("version_in_left", `String version1);
+        ("version_in_right", `String version2)
+      ]
+    ) lst)
+  in
+  `Assoc [
+    ("left_packages", convert_list left);
+    ("right_packages", convert_list right);
+    ("different_versions", convert_diff_versions different_versions)
+  ]
+
 let diff_map a b =
   let diff a b =
     String_map.fold (fun k v acc ->

opamdiff/opamdiff.ml

@@ -275,3 +275,55 @@ let compare left right =
     | Error _ as e, _ | _, (Error _ as e) -> e
   in
   (opam_diff, version_diff, left_pkgs, right_pkgs, duniverse_ret)
+
+  let compare_to_json
+  (opam_diff, version_diff, left_pkgs, right_pkgs, duniverse_diff) : Yojson.Basic.t =
+    let version_diff_to_json lst =
+      `List (List.map (fun { name; version_left; version_right } ->
+          `Assoc [
+            ("name", `String (OpamPackage.Name.to_string name));
+            ("version_left", `String (OpamPackage.Version.to_string version_left));
+            ("version_right", `String (OpamPackage.Version.to_string version_right))
+          ]
+        ) lst)
+    in
+    let package_set_to_json set =
+      `List (Set.fold (fun p acc ->
+          let json = `Assoc [
+            ("name", `String (OpamPackage.Name.to_string p.OpamPackage.name));
+            ("version", `String (OpamPackage.Version.to_string p.OpamPackage.version))
+          ] in
+          json :: acc
+        ) set [])
+    in
+    let opam_diff_to_json opam_diff =
+      `List (List.map (fun (diff : opam_diff) ->
+        `Assoc [
+
+          ("package_version", `String (OpamPackage.to_string diff.pkg));
+          ("otherwise_equal", `Bool diff.otherwise_equal)
+        ]
+
+        ) opam_diff)
+    in
+    let duniverse_to_json = function
+      | Ok (left, right, detailed_diff) ->
+        `Assoc [
+        ("left", `List (List.map (fun (k, v) -> `Assoc [("name", `String k); ("value", `String v)]) left));
+        ("right", `List (List.map (fun (k, v) -> `Assoc [("name", `String k); ("value", `String v)]) right));
+        ("detailed_diff",`List (List.map (fun (diff : duniverse_diff) ->
+          `Assoc [
+            ("name", `String diff.name);
+          ]) detailed_diff))
+      ]
+
+        | Error (`Msg msg) ->
+          `String msg
+    in
+    `Assoc [
+      ("opam_diff", opam_diff_to_json opam_diff);
+      ("version_diff", version_diff_to_json version_diff);
+      ("only_in_left", package_set_to_json left_pkgs);
+      ("only_in_right", package_set_to_json right_pkgs);
+      ("duniverse_diff", duniverse_to_json duniverse_diff)
+    ]

opamdiff/opamdiff.mli

@@ -33,7 +33,10 @@ val commands_to_strings : OpamTypes.command list * OpamTypes.command list -> str
 val opt_url_to_string : OpamFile.URL.t option * OpamFile.URL.t option -> string * string
 
 
-val compare: OpamFile.SwitchExport.t ->
+val compare : OpamFile.SwitchExport.t ->
   OpamFile.SwitchExport.t ->
   opam_diff list * version_diff list * OpamPackage.Set.t * OpamPackage.Set.t * ((string * string) list * (string * string) list * duniverse_diff list, [> `Msg of string ]) result
 
+
+val compare_to_json : opam_diff list * version_diff list * OpamPackage.Set.t * OpamPackage.Set.t *
+((string * string) list * (string * string) list * duniverse_diff list, [< `Msg of string ]) result -> Yojson.Basic.t