forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
Add query, failures, changes, and disk commands to day10 CLI
- query: show package build details with optional --history flag
- failures: list failing packages with --blessed and --category filters
- changes: show status transitions since last run
- disk: show disk usage breakdown by layer type
Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
+230
-1
+230
-1
day10/bin/main.ml
+230
-1
day10/bin/main.ml
···
1987
1987
let status_info = Cmd.info "status" ~doc:"Show current build status overview" in
1988
1988
Cmd.v status_info status_term
1989
1989
1990
+
let run_query ~cache_dir ~format ~arch ~os_distribution ~os_version ~history ~package =
1991
+
let os_key = Printf.sprintf "%s-%s-%s" os_distribution os_version arch in
1992
+
let packages_dir = Path.(cache_dir / os_key / "packages") in
1993
+
let pkg_dir = Path.(packages_dir / package) in
1994
+
if not (Sys.file_exists pkg_dir) then begin
1995
+
Printf.eprintf "Package %s not found\n%!" package;
1996
+
Stdlib.exit 1
1997
+
end;
1998
+
if format = "json" then begin
1999
+
let entries = Day10_lib.History.read_latest ~packages_dir ~pkg_str:package in
2000
+
let blessed = Day10_lib.History.read_blessed ~packages_dir ~pkg_str:package in
2001
+
let json = `Assoc [
2002
+
("package", `String package);
2003
+
("blessed", match blessed with Some e -> Day10_lib.History.entry_to_json e | None -> `Null);
2004
+
("builds", `List (List.map Day10_lib.History.entry_to_json entries));
2005
+
] in
2006
+
print_string (Yojson.Safe.pretty_to_string json);
2007
+
print_newline ()
2008
+
end else begin
2009
+
Printf.printf "%s\n" package;
2010
+
(* Show blessed build *)
2011
+
(match Day10_lib.History.read_blessed ~packages_dir ~pkg_str:package with
2012
+
| Some e ->
2013
+
Printf.printf " Blessed: %s (%s) — %s\n" e.build_hash e.compiler e.category
2014
+
| None ->
2015
+
Printf.printf " Blessed: none\n");
2016
+
(* Show other builds *)
2017
+
let entries = Day10_lib.History.read_latest ~packages_dir ~pkg_str:package in
2018
+
let non_blessed = List.filter (fun (e : Day10_lib.History.entry) -> not e.blessed) entries in
2019
+
if non_blessed <> [] then begin
2020
+
Printf.printf " Other builds:\n";
2021
+
List.iter (fun (e : Day10_lib.History.entry) ->
2022
+
Printf.printf " %s (%s) — %s%s\n" e.build_hash e.compiler e.category
2023
+
(match e.error with Some err -> Printf.sprintf " (%s)" err | None -> "")
2024
+
) non_blessed
2025
+
end;
2026
+
if history then begin
2027
+
Printf.printf " History:\n";
2028
+
let all = Day10_lib.History.read ~packages_dir ~pkg_str:package in
2029
+
List.iter (fun (e : Day10_lib.History.entry) ->
2030
+
Printf.printf " %s %s %s %s%s\n" e.ts e.build_hash e.category
2031
+
(if e.blessed then "[blessed]" else "")
2032
+
(match e.error with Some err -> Printf.sprintf " (%s)" err | None -> "")
2033
+
) all
2034
+
end
2035
+
end
2036
+
2037
+
let query_cmd =
2038
+
let package_arg =
2039
+
let doc = "Package name to query" in
2040
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"PACKAGE" ~doc)
2041
+
in
2042
+
let history_term =
2043
+
let doc = "Show full build history" in
2044
+
Arg.(value & flag & info [ "history" ] ~doc)
2045
+
in
2046
+
let query_term =
2047
+
Term.(const (fun cache_dir format arch _os os_distribution os_version history package ->
2048
+
run_query ~cache_dir ~format ~arch ~os_distribution ~os_version ~history ~package)
2049
+
$ cache_dir_term $ format_term $ arch_term $ os_term $ os_distribution_term $ os_version_term $ history_term $ package_arg)
2050
+
in
2051
+
let query_info = Cmd.info "query" ~doc:"Show package build details" in
2052
+
Cmd.v query_info query_term
2053
+
2054
+
let run_failures ~cache_dir ~format ~arch ~os_distribution ~os_version ~blessed_only ~category_filter =
2055
+
let os_key = Printf.sprintf "%s-%s-%s" os_distribution os_version arch in
2056
+
let packages_dir = Path.(cache_dir / os_key / "packages") in
2057
+
if not (Sys.file_exists packages_dir) then begin
2058
+
Printf.eprintf "No packages directory found\n%!";
2059
+
Stdlib.exit 1
2060
+
end;
2061
+
let pkg_dirs = Sys.readdir packages_dir |> Array.to_list in
2062
+
let failures = List.fold_left (fun acc pkg_str ->
2063
+
let entries = Day10_lib.History.read_latest ~packages_dir ~pkg_str in
2064
+
let failing = List.filter (fun (e : Day10_lib.History.entry) ->
2065
+
e.status = "failure"
2066
+
&& (not blessed_only || e.blessed)
2067
+
&& (category_filter = "" || e.category = category_filter)
2068
+
) entries in
2069
+
List.map (fun e -> (pkg_str, e)) failing @ acc
2070
+
) [] pkg_dirs in
2071
+
if format = "json" then begin
2072
+
let json = `List (List.map (fun (pkg, e) ->
2073
+
`Assoc [("package", `String pkg); ("entry", Day10_lib.History.entry_to_json e)]
2074
+
) failures) in
2075
+
print_string (Yojson.Safe.pretty_to_string json);
2076
+
print_newline ()
2077
+
end else begin
2078
+
Printf.printf "Failures: %d\n" (List.length failures);
2079
+
List.iter (fun (pkg, (e : Day10_lib.History.entry)) ->
2080
+
Printf.printf " %-40s %-20s %s%s\n" pkg e.category e.compiler
2081
+
(if e.blessed then " [blessed]" else "")
2082
+
) failures
2083
+
end
2084
+
2085
+
let failures_cmd =
2086
+
let blessed_term =
2087
+
let doc = "Show only blessed package failures" in
2088
+
Arg.(value & flag & info [ "blessed" ] ~doc)
2089
+
in
2090
+
let category_term =
2091
+
let doc = "Filter by category" in
2092
+
Arg.(value & opt string "" & info [ "category" ] ~docv:"CATEGORY" ~doc)
2093
+
in
2094
+
let failures_term =
2095
+
Term.(const (fun cache_dir format arch _os os_distribution os_version blessed_only category_filter ->
2096
+
run_failures ~cache_dir ~format ~arch ~os_distribution ~os_version ~blessed_only ~category_filter)
2097
+
$ cache_dir_term $ format_term $ arch_term $ os_term $ os_distribution_term $ os_version_term $ blessed_term $ category_term)
2098
+
in
2099
+
let failures_info = Cmd.info "failures" ~doc:"List failing packages" in
2100
+
Cmd.v failures_info failures_term
2101
+
2102
+
let run_changes ~cache_dir ~format ~arch ~os_distribution ~os_version =
2103
+
let os_key = Printf.sprintf "%s-%s-%s" os_distribution os_version arch in
2104
+
let os_dir = Path.(cache_dir / os_key) in
2105
+
match Day10_lib.Status_index.read ~dir:os_dir with
2106
+
| None ->
2107
+
Printf.eprintf "No status index found\n%!";
2108
+
Stdlib.exit 1
2109
+
| Some status ->
2110
+
if format = "json" then begin
2111
+
let json = `Assoc [
2112
+
("run_id", `String status.run_id);
2113
+
("changes", `List (List.map (fun (c : Day10_lib.Status_index.change) ->
2114
+
`Assoc [
2115
+
("package", `String c.package);
2116
+
("build_hash", `String c.build_hash);
2117
+
("blessed", `Bool c.blessed);
2118
+
("from", `String c.from_status);
2119
+
("to", `String c.to_status);
2120
+
]) status.changes));
2121
+
("new_packages", `List (List.map (fun s -> `String s) status.new_packages));
2122
+
] in
2123
+
print_string (Yojson.Safe.pretty_to_string json);
2124
+
print_newline ()
2125
+
end else begin
2126
+
Printf.printf "Changes since run %s:\n" status.run_id;
2127
+
if status.changes = [] then
2128
+
Printf.printf " No changes\n"
2129
+
else
2130
+
List.iter (fun (c : Day10_lib.Status_index.change) ->
2131
+
Printf.printf " %s %-40s %s → %s%s\n"
2132
+
(if c.to_status = "success" then "+" else "-")
2133
+
c.package c.from_status c.to_status
2134
+
(if c.blessed then " [blessed]" else "")
2135
+
) status.changes;
2136
+
if status.new_packages <> [] then
2137
+
Printf.printf " New packages: %d\n" (List.length status.new_packages)
2138
+
end
2139
+
2140
+
let changes_cmd =
2141
+
let changes_term =
2142
+
Term.(const (fun cache_dir format arch _os os_distribution os_version ->
2143
+
run_changes ~cache_dir ~format ~arch ~os_distribution ~os_version)
2144
+
$ cache_dir_term $ format_term $ arch_term $ os_term $ os_distribution_term $ os_version_term)
2145
+
in
2146
+
let changes_info = Cmd.info "changes" ~doc:"Show status transitions since last run" in
2147
+
Cmd.v changes_info changes_term
2148
+
2149
+
let run_disk ~cache_dir ~format ~arch ~os_distribution ~os_version =
2150
+
let os_key = Printf.sprintf "%s-%s-%s" os_distribution os_version arch in
2151
+
let os_dir = Path.(cache_dir / os_key) in
2152
+
(* Shell out to du for simplicity *)
2153
+
let du path =
2154
+
if Sys.file_exists path then
2155
+
try
2156
+
let cmd = Printf.sprintf "du -sb %s 2>/dev/null | awk '{print $1}'" path in
2157
+
let ic = Unix.open_process_in cmd in
2158
+
let line = try input_line ic with End_of_file -> "0" in
2159
+
let _ = Unix.close_process_in ic in
2160
+
Int64.of_string (String.trim line)
2161
+
with _ -> 0L
2162
+
else 0L
2163
+
in
2164
+
let base_size = du Path.(os_dir / "base") in
2165
+
let build_cmd = Printf.sprintf "du -sb %s/build-* 2>/dev/null | awk '{s+=$1} END {print s+0}'" os_dir in
2166
+
let build_size = try
2167
+
let ic = Unix.open_process_in build_cmd in
2168
+
let line = try input_line ic with End_of_file -> "0" in
2169
+
let _ = Unix.close_process_in ic in
2170
+
Int64.of_string (String.trim line)
2171
+
with _ -> 0L in
2172
+
let doc_cmd = Printf.sprintf "du -sb %s/doc-* 2>/dev/null | awk '{s+=$1} END {print s+0}'" os_dir in
2173
+
let doc_size = try
2174
+
let ic = Unix.open_process_in doc_cmd in
2175
+
let line = try input_line ic with End_of_file -> "0" in
2176
+
let _ = Unix.close_process_in ic in
2177
+
Int64.of_string (String.trim line)
2178
+
with _ -> 0L in
2179
+
let packages_size = du Path.(os_dir / "packages") in
2180
+
let logs_size = du Path.(cache_dir / "logs") in
2181
+
let solutions_size = du Path.(cache_dir / "solutions") in
2182
+
let total = Int64.add (Int64.add (Int64.add base_size build_size) (Int64.add doc_size packages_size)) (Int64.add logs_size solutions_size) in
2183
+
let gb n = Int64.to_float n /. 1073741824.0 in
2184
+
if format = "json" then begin
2185
+
let json = `Assoc [
2186
+
("base", `Float (gb base_size));
2187
+
("build_layers", `Float (gb build_size));
2188
+
("doc_layers", `Float (gb doc_size));
2189
+
("packages", `Float (gb packages_size));
2190
+
("logs", `Float (gb logs_size));
2191
+
("solutions", `Float (gb solutions_size));
2192
+
("total", `Float (gb total));
2193
+
] in
2194
+
print_string (Yojson.Safe.pretty_to_string json);
2195
+
print_newline ()
2196
+
end else begin
2197
+
Printf.printf "Disk usage (%.1fG total):\n" (gb total);
2198
+
Printf.printf " Base image: %.1fG\n" (gb base_size);
2199
+
Printf.printf " Build layers: %.1fG\n" (gb build_size);
2200
+
Printf.printf " Doc layers: %.1fG\n" (gb doc_size);
2201
+
Printf.printf " Packages: %.1fG\n" (gb packages_size);
2202
+
Printf.printf " Logs: %.1fG\n" (gb logs_size);
2203
+
Printf.printf " Solutions: %.1fG\n" (gb solutions_size)
2204
+
end
2205
+
2206
+
let disk_cmd =
2207
+
let disk_term =
2208
+
Term.(const (fun cache_dir format arch _os os_distribution os_version ->
2209
+
run_disk ~cache_dir ~format ~arch ~os_distribution ~os_version)
2210
+
$ cache_dir_term $ format_term $ arch_term $ os_term $ os_distribution_term $ os_version_term)
2211
+
in
2212
+
let disk_info = Cmd.info "disk" ~doc:"Show disk usage breakdown" in
2213
+
Cmd.v disk_info disk_term
2214
+
1990
2215
let main_info =
1991
2216
let doc = "A tool for running CI and health checks" in
1992
2217
let man =
···
2001
2226
`P "Use '$(mname) sync-docs DESTINATION' to sync documentation to a destination.";
2002
2227
`P "Use '$(mname) combine-docs MOUNT_POINT' to combine all doc layers into an overlay mount.";
2003
2228
`P "Use '$(mname) status' to show current build status overview.";
2229
+
`P "Use '$(mname) query PACKAGE' to show package build details.";
2230
+
`P "Use '$(mname) failures' to list failing packages.";
2231
+
`P "Use '$(mname) changes' to show status transitions since last run.";
2232
+
`P "Use '$(mname) disk' to show disk usage breakdown.";
2004
2233
`P "Add --md flag to output results in markdown format.";
2005
2234
`S Manpage.s_examples;
2006
2235
`P "$(mname) ci --cache-dir /tmp/cache --opam-repository /tmp/opam-repository /path/to/project";
···
2016
2245
2017
2246
let () =
2018
2247
let default_term = Term.(ret (const (`Help (`Pager, None)))) in
2019
-
let cmd = Cmd.group ~default:default_term main_info [ ci_cmd; health_check_cmd; batch_cmd; list_cmd; sync_docs_cmd; combine_docs_cmd; status_cmd ] in
2248
+
let cmd = Cmd.group ~default:default_term main_info [ ci_cmd; health_check_cmd; batch_cmd; list_cmd; sync_docs_cmd; combine_docs_cmd; status_cmd; query_cmd; failures_cmd; changes_cmd; disk_cmd ] in
2020
2249
exit (Cmd.eval cmd)