this repo has no description
1(** diff command: compare two snapshots within a profile *)
2
3open Cmdliner
4
5(* Load all solutions from a snapshot dir, returning (pkg, solve_result) list *)
6let load_solutions snap_dir =
7 let sol_dir = Day11_batch.Snapshot.solutions_dir snap_dir in
8 match Bos.OS.Dir.contents sol_dir with
9 | Error _ -> []
10 | Ok files ->
11 List.filter_map (fun path ->
12 if not (Fpath.has_ext ".json" path) then None
13 else if Fpath.basename path = "repos.json" then None
14 else
15 match Day11_batch.Incremental_solver.load path with
16 | Ok (Day11_batch.Incremental_solver.Cached_solution { package; result }) ->
17 Some (package, Some result)
18 | Ok (Day11_batch.Incremental_solver.Cached_failure { package; _ }) ->
19 Some (package, None)
20 | Error _ -> None
21 ) files
22
23(* Extract package -> version map from solutions *)
24let version_map solutions =
25 List.fold_left (fun acc (pkg, result) ->
26 let name = OpamPackage.Name.to_string (OpamPackage.name pkg) in
27 let ver = OpamPackage.Version.to_string (OpamPackage.version pkg) in
28 let solved = result <> None in
29 let deps = match result with
30 | Some r -> OpamPackage.Map.cardinal r.Day11_solution.Solve_result.build_deps
31 | None -> 0
32 in
33 (name, (ver, solved, deps)) :: acc
34 ) [] solutions
35
36let run profile_name profile_dir snap1_key snap2_key =
37 match Common.load_profile ~profile_dir ~name:profile_name with
38 | Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
39 | Ok (_profile, paths) ->
40 let all_snaps = Common.snapshot_dirs_by_recency paths in
41 if List.length all_snaps < 2 && snap1_key = None then begin
42 Printf.printf "Need at least 2 snapshots to diff (have %d)\n%!"
43 (List.length all_snaps);
44 1
45 end else
46 (* Resolve snapshot dirs *)
47 let find_snap key =
48 List.find_opt (fun p ->
49 String.equal (Fpath.basename p) key
50 ) all_snaps
51 in
52 let snap1_dir, snap2_dir = match snap1_key, snap2_key with
53 | Some k1, Some k2 ->
54 (match find_snap k1, find_snap k2 with
55 | Some d1, Some d2 -> (d1, d2)
56 | None, _ -> Printf.eprintf "Snapshot %s not found\n" k1; exit 1
57 | _, None -> Printf.eprintf "Snapshot %s not found\n" k2; exit 1)
58 | _ ->
59 (* Default: compare two most recent *)
60 (match all_snaps with
61 | d1 :: d2 :: _ -> (d2, d1) (* older first *)
62 | _ -> Printf.eprintf "Not enough snapshots\n"; exit 1)
63 in
64 let key1 = Fpath.basename snap1_dir in
65 let key2 = Fpath.basename snap2_dir in
66 (* Load snapshot metadata *)
67 let snap1 = Day11_batch.Snapshot.load snap1_dir in
68 let snap2 = Day11_batch.Snapshot.load snap2_dir in
69 Printf.printf "Comparing snapshots:\n";
70 Printf.printf " Old: %s" key1;
71 (match snap1 with
72 | Ok s -> Printf.printf " (%s)" s.created | _ -> ());
73 Printf.printf "\n";
74 Printf.printf " New: %s" key2;
75 (match snap2 with
76 | Ok s -> Printf.printf " (%s)" s.created | _ -> ());
77 Printf.printf "\n\n";
78 (* Load solutions *)
79 let sols1 = version_map (load_solutions snap1_dir) in
80 let sols2 = version_map (load_solutions snap2_dir) in
81 let tbl1 = Hashtbl.create (List.length sols1) in
82 List.iter (fun (name, v) -> Hashtbl.replace tbl1 name v) sols1;
83 let tbl2 = Hashtbl.create (List.length sols2) in
84 List.iter (fun (name, v) -> Hashtbl.replace tbl2 name v) sols2;
85 (* Collect all package names *)
86 let all_names = Hashtbl.create 64 in
87 Hashtbl.iter (fun k _ -> Hashtbl.replace all_names k ()) tbl1;
88 Hashtbl.iter (fun k _ -> Hashtbl.replace all_names k ()) tbl2;
89 let names = Hashtbl.fold (fun k () acc -> k :: acc) all_names []
90 |> List.sort String.compare in
91 (* Categorize changes *)
92 let added = ref [] in
93 let removed = ref [] in
94 let version_changed = ref [] in
95 let solve_changed = ref [] in
96 let unchanged = ref 0 in
97 List.iter (fun name ->
98 match Hashtbl.find_opt tbl1 name, Hashtbl.find_opt tbl2 name with
99 | None, Some (ver, solved, _) ->
100 added := (name, ver, solved) :: !added
101 | Some (ver, solved, _), None ->
102 removed := (name, ver, solved) :: !removed
103 | Some (v1, s1, _), Some (v2, s2, _) ->
104 if v1 <> v2 then
105 version_changed := (name, v1, v2) :: !version_changed
106 else if s1 <> s2 then
107 solve_changed := (name, s1, s2) :: !solve_changed
108 else
109 incr unchanged
110 | None, None -> ()
111 ) names;
112 (* Print results *)
113 if !version_changed <> [] then begin
114 Printf.printf "Version changes:\n";
115 List.iter (fun (name, v1, v2) ->
116 Printf.printf " %s: %s -> %s\n" name v1 v2
117 ) (List.rev !version_changed);
118 Printf.printf "\n"
119 end;
120 if !added <> [] then begin
121 Printf.printf "Added:\n";
122 List.iter (fun (name, ver, solved) ->
123 Printf.printf " %s.%s%s\n" name ver
124 (if solved then "" else " (solve failed)")
125 ) (List.rev !added);
126 Printf.printf "\n"
127 end;
128 if !removed <> [] then begin
129 Printf.printf "Removed:\n";
130 List.iter (fun (name, ver, solved) ->
131 Printf.printf " %s.%s%s\n" name ver
132 (if solved then "" else " (was failing)")
133 ) (List.rev !removed);
134 Printf.printf "\n"
135 end;
136 if !solve_changed <> [] then begin
137 Printf.printf "Solve status changed:\n";
138 List.iter (fun (name, was_ok, now_ok) ->
139 let status = if now_ok then "now solves" else "now fails" in
140 ignore was_ok;
141 Printf.printf " %s: %s\n" name status
142 ) (List.rev !solve_changed);
143 Printf.printf "\n"
144 end;
145 Printf.printf "Summary: %d unchanged, %d version changes, %d added, %d removed, %d solve changes\n"
146 !unchanged (List.length !version_changed)
147 (List.length !added) (List.length !removed) (List.length !solve_changed);
148 0
149
150let snap1_term =
151 let doc = "First snapshot key (default: second most recent)" in
152 Arg.(value & opt (some string) None & info [ "from" ] ~docv:"KEY" ~doc)
153
154let snap2_term =
155 let doc = "Second snapshot key (default: most recent)" in
156 Arg.(value & opt (some string) None & info [ "to" ] ~docv:"KEY" ~doc)
157
158let cmd =
159 let doc = "Compare two snapshots within a profile" in
160 let info = Cmd.info "diff" ~doc in
161 Cmd.v info
162 Term.(const run $ Common.profile_term $ Common.profile_dir_term
163 $ snap1_term $ snap2_term)