opam-switch diff

lib/builder_web.ml

@@ -255,6 +255,33 @@ let routes t =
       |> Lwt.return
   in
 
+  let compare_opam req =
+    let build_left = Router.param req "build_left" in
+    let build_right = Router.param req "build_right" in
+    match Uuidm.of_string build_left, Uuidm.of_string build_right with
+    | None, _ | _, None ->
+      Response.of_plain_text "Bad request" ~status:`Bad_request
+      |> Lwt.return
+    | Some build_left, Some build_right ->
+      let+ switch_left =
+        Caqti_lwt.Pool.use (Model.build_artifact build_left (Fpath.v "opam-switch"))
+          t.pool
+      and+ switch_right =
+        Caqti_lwt.Pool.use (Model.build_artifact build_right (Fpath.v "opam-switch"))
+          t.pool
+      in
+      match switch_left, switch_right with
+      | Error e, _ | _, Error e ->
+         Log.warn (fun m -> m "Database error: %a" pp_error e);
+         Response.of_plain_text "Internal server error\n" ~status:`Internal_server_error
+      | Ok (switch_left, _sha256_left), Ok (switch_right, _sha256_right) ->
+        let switch_left = OpamFile.SwitchExport.read_from_string switch_left
+        and switch_right = OpamFile.SwitchExport.read_from_string switch_right in
+        Opamdiff.compare (Opamdiff.packages switch_left) (Opamdiff.packages switch_right)
+        |> Views.compare_opam build_left build_right
+        |> Response.of_html
+  in
+
   [
     App.get "/" builder;
     App.get "/job/:job/" job;
@@ -262,6 +289,7 @@ let routes t =
     App.get "/job/:job/build/:build/f/**" job_build_file;
     App.post "/upload" (authorized t upload);
     App.get "/hash" hash;
+    App.get "/compare/:build_left/:build_right/opam-switch" compare_opam;
   ]
 
 let add_routes t (app : App.t) =

lib/dune

@@ -1,3 +1,3 @@
 (library
  (name builder_web)
- (libraries builder builder_db opium tyxml bos rresult duration hex caqti-lwt))
+ (libraries builder builder_db opium tyxml bos rresult duration hex caqti-lwt opamdiff))

lib/views.ml

@@ -211,3 +211,58 @@ let job_build
                 (List.rev console));
         ];
     ]
+
+let packages packages =
+  OpamPackage.Set.elements packages
+  |> List.concat_map (fun p -> [
+        txtf "%a" Opamdiff.pp_opampackage p;
+        br ();
+      ])
+
+let package_diffs diffs =
+  List.concat_map (fun pd -> [
+        txtf "%a" Opamdiff.pp_version_diff pd;
+        br ();
+      ])
+    diffs
+
+let compare_opam build_left build_right (same, version_diff, left, right) =
+  layout ~title:(Fmt.strf "Comparing opam switches between builds %a and %a"
+                   Uuidm.pp build_left Uuidm.pp build_right)
+    [
+      h1 [txt "Comparing opam switches"];
+      h2 [
+        txtf "Builds %a and %a"
+          Uuidm.pp build_left Uuidm.pp build_right
+      ];
+      ul [
+        li [
+          a ~a:[a_href "packages-removed"]
+            [txtf "%d packages removed" (OpamPackage.Set.cardinal left)]
+        ];
+        li [
+          a ~a:[a_href "packages-installed"]
+            [txtf "%d new packages installed" (OpamPackage.Set.cardinal right)]
+        ];
+        li [
+          a ~a:[a_href "packages-diff"]
+            [txtf "%d packages with version changes" (List.length version_diff)]
+        ];
+        li [
+          a ~a:[a_href "packages-unchanged"]
+            [txtf "%d packages unchanged" (OpamPackage.Set.cardinal same)]
+        ];
+      ];
+      h3 ~a:[a_id "packages-removed"]
+        [txt "Packages removed"];
+      code (packages left);
+      h3 ~a:[a_id "packages-installed"]
+        [txt "New packages installed"];
+      code (packages right);
+      h3 ~a:[a_id "packages-diff"]
+        [txt "Packages with version changes"];
+      code (package_diffs version_diff);
+      h3 ~a:[a_id "packages-unchanged"]
+        [txt "Unchanged packages"];
+      code (packages same);
+    ]

opamdiff/dune

@@ -0,0 +1,3 @@
+(library
+ (name opamdiff)
+ (libraries opam-core opam-format))

opamdiff/opamdiff.ml

@@ -0,0 +1,51 @@
+module Set = OpamPackage.Set
+
+type package = OpamPackage.t
+
+let packages (switch : OpamFile.SwitchExport.t) =
+  assert (Set.cardinal switch.selections.sel_pinned = 0);
+  assert (Set.cardinal switch.selections.sel_compiler = 0);
+  assert (Set.subset switch.selections.sel_roots switch.selections.sel_installed);
+  switch.selections.sel_installed
+
+type version_diff = {
+  name : OpamPackage.Name.t;
+  version_left : OpamPackage.Version.t;
+  version_right : OpamPackage.Version.t;
+}
+
+let pp_opampackage ppf p =
+  Format.fprintf ppf "%s" (OpamPackage.to_string p)
+
+let pp_version_diff ppf { name; version_left; version_right } =
+  Format.fprintf ppf "%s.%s->%s"
+    (OpamPackage.Name.to_string name)
+    (OpamPackage.Version.to_string version_left)
+    (OpamPackage.Version.to_string version_right)
+
+let compare left right =
+  let module Set = OpamPackage.Set in
+  let equal_name p1 p2 = OpamPackage.Name.equal p1.OpamPackage.name p2.OpamPackage.name in
+  let diff l r =
+    Set.filter (fun p1 ->
+        not (Set.exists (equal_name p1) r))
+      l
+  in
+  let same = Set.inter left right
+  and version_diff =
+    List.filter_map (fun p1 ->
+        match Set.find_opt (equal_name p1) right with
+        | Some p2 ->
+          if OpamPackage.Version.equal p1.version p2.version
+          then None
+          else
+            Some { name = p1.OpamPackage.name;
+                   version_left = p1.OpamPackage.version;
+                   version_right = p2.OpamPackage.version }
+        | None ->
+          None)
+      (Set.elements left)
+  and left = diff left right
+  and right = diff right left
+  in
+  (same, version_diff, left, right)