jon.recoil.org
A fork of mtelver's day10 project
Add CLI `day10 status` command to display build status overview
Reads status.json from the cache directory and displays current build
state including run info, blessed/non-blessed totals, changes, and new
packages. Supports both text and JSON output formats via --format flag.
Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
+48
-1
bin/main.ml
+48
-1
bin/main.ml
···
1765
1765
let doc = "Path to a pre-computed blessing map JSON file (from batch mode)" in
1766
1766
Arg.(value & opt (some string) None & info [ "blessed-map" ] ~docv:"FILE" ~doc)
1767
1767
1768
+
let format_term =
1769
+
let doc = "Output format: text or json (default: text)" in
1770
+
Arg.(value & opt string "text" & info [ "format" ] ~docv:"FORMAT" ~doc)
1771
+
1768
1772
let find_opam_files dir =
1769
1773
try
1770
1774
Sys.readdir dir |> Array.to_list |> List.filter_map (fun name -> if Filename.check_suffix name ".opam" then Some (Filename.remove_extension name) else None)
···
1941
1945
let batch_info = Cmd.info "batch" ~doc:"Solve all targets, compute blessings, then build with pre-computed blessing maps" in
1942
1946
Cmd.v batch_info batch_term
1943
1947
1948
+
let run_status ~cache_dir ~format ~arch ~os_distribution ~os_version =
1949
+
let os_key = Printf.sprintf "%s-%s-%s" os_distribution os_version arch in
1950
+
let os_dir = Path.(cache_dir / os_key) in
1951
+
match Day10_lib.Status_index.read ~dir:os_dir with
1952
+
| None ->
1953
+
Printf.eprintf "No status index found. Run a batch build first.\n%!";
1954
+
1
1955
+
| Some status ->
1956
+
if format = "json" then begin
1957
+
print_string (Yojson.Safe.pretty_to_string (Day10_lib.Status_index.to_json status));
1958
+
print_newline ();
1959
+
0
1960
+
end else begin
1961
+
Printf.printf "Run: %s (generated %s)\n" status.run_id status.generated;
1962
+
Printf.printf "Blessed: %s\n"
1963
+
(String.concat ", " (List.map (fun (k, v) -> Printf.sprintf "%d %s" v k) status.blessed_totals));
1964
+
Printf.printf "Non-blessed: %s\n"
1965
+
(String.concat ", " (List.map (fun (k, v) -> Printf.sprintf "%d %s" v k) status.non_blessed_totals));
1966
+
if status.changes <> [] then begin
1967
+
Printf.printf "Changes (blessed):\n";
1968
+
List.iter (fun (c : Day10_lib.Status_index.change) ->
1969
+
if c.blessed then
1970
+
Printf.printf " %s %-40s %s → %s\n"
1971
+
(if c.to_status = "success" then "+" else "-")
1972
+
c.package c.from_status c.to_status
1973
+
) status.changes
1974
+
end;
1975
+
if status.new_packages <> [] then
1976
+
Printf.printf "New packages: %d\n" (List.length status.new_packages);
1977
+
0
1978
+
end
1979
+
1980
+
let status_cmd =
1981
+
let status_term =
1982
+
Term.(const (fun cache_dir format arch _os os_distribution os_version ->
1983
+
let code = run_status ~cache_dir ~format ~arch ~os_distribution ~os_version in
1984
+
if code <> 0 then Stdlib.exit code)
1985
+
$ cache_dir_term $ format_term $ arch_term $ os_term $ os_distribution_term $ os_version_term)
1986
+
in
1987
+
let status_info = Cmd.info "status" ~doc:"Show current build status overview" in
1988
+
Cmd.v status_info status_term
1989
+
1944
1990
let main_info =
1945
1991
let doc = "A tool for running CI and health checks" in
1946
1992
let man =
···
1954
2000
`P "Use '$(mname) list' list packages in opam repository.";
1955
2001
`P "Use '$(mname) sync-docs DESTINATION' to sync documentation to a destination.";
1956
2002
`P "Use '$(mname) combine-docs MOUNT_POINT' to combine all doc layers into an overlay mount.";
2003
+
`P "Use '$(mname) status' to show current build status overview.";
1957
2004
`P "Add --md flag to output results in markdown format.";
1958
2005
`S Manpage.s_examples;
1959
2006
`P "$(mname) ci --cache-dir /tmp/cache --opam-repository /tmp/opam-repository /path/to/project";
···
1969
2016
1970
2017
let () =
1971
2018
let default_term = Term.(ret (const (`Help (`Pager, None)))) in
1972
-
let cmd = Cmd.group ~default:default_term main_info [ ci_cmd; health_check_cmd; batch_cmd; list_cmd; sync_docs_cmd; combine_docs_cmd ] 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
1973
2020
exit (Cmd.eval cmd)