forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
day11: add diff command to compare snapshots
day11 diff --profile <name> compares the two most recent snapshots,
showing version changes, added/removed packages, and solve status
changes. Specific snapshots can be compared with --from/--to keys.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+178
+163
day11/bin/cmd_diff.ml
+163
day11/bin/cmd_diff.ml
···
1
+
(** diff command: compare two snapshots within a profile *)
2
+
3
+
open Cmdliner
4
+
5
+
(* Load all solutions from a snapshot dir, returning (pkg, solve_result) list *)
6
+
let 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 *)
24
+
let 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
+
36
+
let 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
+
150
+
let 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
+
154
+
let 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
+
158
+
let 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)
+14
day11/bin/common.ml
+14
day11/bin/common.ml
···
123
123
| (p, _) :: _ -> Some p
124
124
| [] -> None
125
125
126
+
let snapshot_dirs_by_recency (paths : paths) =
127
+
match Bos.OS.Dir.contents paths.snapshots_base with
128
+
| Error _ -> []
129
+
| Ok entries ->
130
+
entries
131
+
|> List.filter (fun p -> Bos.OS.Dir.exists p |> Result.get_ok)
132
+
|> List.filter_map (fun p ->
133
+
try
134
+
let stat = Unix.stat (Fpath.to_string p) in
135
+
Some (p, stat.Unix.st_mtime)
136
+
with Unix.Unix_error _ -> None)
137
+
|> List.sort (fun (_, t1) (_, t2) -> compare t2 t1)
138
+
|> List.map fst
139
+
126
140
let read_pins_from_dir dir =
127
141
let opam_files = Sys.readdir dir |> Array.to_list
128
142
|> List.filter (fun f -> Filename.check_suffix f ".opam") in