anil.recoil.org
Monorepo management for opam overlays
Add cron-friendly doctor mode and tidy monopam code
Doctor changes:
- Add --quiet flag for cron job usage (only output on issues)
- Add health status computation (Healthy/Warning/Critical)
- Return proper exit codes (0=healthy, 1=warning, 2=critical)
- Add has_issues helper to check if report needs attention
Code tidying:
- doctor.ml: Use Option.value for cleaner URL/Ptime handling
- git.ml: Extract retryable_error_patterns list for readability
- status.ml: Use Option.bind for sources lookup
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+41
-6
bin/main.ml
+41
-6
bin/main.ml
···
949
949
`S "OUTPUT FORMATS";
950
950
`P "By default, outputs human-readable text with colors.";
951
951
`P "Use $(b,--json) for JSON output suitable for tooling.";
952
+
`S "CRON SUPPORT";
953
+
`P
954
+
"The doctor command is designed for use in cron jobs. When used with \
955
+
$(b,--quiet), it only outputs when issues are found. Exit codes:";
956
+
`I ("0", "Healthy - no issues found");
957
+
`I ("1", "Warning - sync needed or behind upstream");
958
+
`I ("2", "Critical - high priority issues or warnings detected");
959
+
`P "Example crontab entry (run every hour, email on issues):";
960
+
`Pre "0 * * * * monopam doctor --quiet --no-sync --json 2>&1";
952
961
`S Manpage.s_examples;
953
962
`P "Run full analysis (syncs first):";
954
963
`Pre "monopam doctor";
···
958
967
`Pre "monopam doctor eio";
959
968
`P "Output as JSON:";
960
969
`Pre "monopam doctor --json";
970
+
`P "Cron-friendly (quiet, exit code based on health):";
971
+
`Pre "monopam doctor --quiet --no-sync";
961
972
]
962
973
in
963
974
let info = Cmd.info "doctor" ~doc ~man in
···
969
980
let doc = "Skip running sync before analysis." in
970
981
Arg.(value & flag & info [ "no-sync" ] ~doc)
971
982
in
972
-
let run package json no_sync () =
983
+
let quiet_arg =
984
+
let doc =
985
+
"Quiet mode for cron jobs. Only output if issues are found. \
986
+
Exit code reflects health status (0=healthy, 1=warning, 2=critical)."
987
+
in
988
+
Arg.(value & flag & info [ "quiet"; "q" ] ~doc)
989
+
in
990
+
let run package json no_sync quiet () =
973
991
Eio_main.run @@ fun env ->
974
992
with_config env @@ fun config ->
975
993
with_verse_config env @@ fun verse_config ->
···
977
995
let proc = Eio.Stdenv.process_mgr env in
978
996
let clock = Eio.Stdenv.clock env in
979
997
(* Run sync before analysis unless --no-sync is specified *)
980
-
if not no_sync then begin
998
+
if not no_sync && not quiet then begin
981
999
Fmt.pr "Syncing workspace before analysis...@.";
982
1000
match Monopam.sync ~proc ~fs ~config ?package () with
983
1001
| Ok _summary -> ()
984
1002
| Error e ->
985
1003
Fmt.pr "Warning: sync failed: %a@." Monopam.pp_error_with_hint e;
986
1004
Fmt.pr "Continuing with analysis...@."
1005
+
end
1006
+
else if not no_sync then begin
1007
+
(* Quiet mode but still sync - just don't print progress *)
1008
+
let _ = Monopam.sync ~proc ~fs ~config ?package () in ()
987
1009
end;
988
1010
let report =
989
1011
Monopam.Doctor.analyze ~proc ~fs ~config ~verse_config ~clock ?package
990
1012
~no_sync ()
991
1013
in
992
-
if json then print_endline (Monopam.Doctor.to_json report)
993
-
else Fmt.pr "%a@." Monopam.Doctor.pp_report report;
994
-
`Ok ()
1014
+
let health = Monopam.Doctor.compute_health report in
1015
+
let exit_code = Monopam.Doctor.health_to_exit_code health in
1016
+
(* In quiet mode, only output if there are issues *)
1017
+
if quiet then begin
1018
+
if Monopam.Doctor.has_issues report then begin
1019
+
if json then print_endline (Monopam.Doctor.to_json report)
1020
+
else Fmt.pr "%a@." Monopam.Doctor.pp_report report
1021
+
end;
1022
+
(* Return appropriate exit code *)
1023
+
exit exit_code
1024
+
end
1025
+
else begin
1026
+
if json then print_endline (Monopam.Doctor.to_json report)
1027
+
else Fmt.pr "%a@." Monopam.Doctor.pp_report report;
1028
+
`Ok ()
1029
+
end
995
1030
in
996
1031
Cmd.v info
997
-
Term.(ret (const run $ package_arg $ json_arg $ no_sync_arg $ logging_term))
1032
+
Term.(ret (const run $ package_arg $ json_arg $ no_sync_arg $ quiet_arg $ logging_term))
998
1033
999
1034
(* Feature commands *)
1000
1035
+45
-4
lib/doctor.ml
+45
-4
lib/doctor.ml
···
371
371
(** Analyze a single remote for a checkout *)
372
372
let analyze_remote ~proc ~fs ~checkout_dir ~remote_name =
373
373
let url =
374
-
match Git.get_remote_url ~proc ~fs ~remote:remote_name checkout_dir with
375
-
| Some u -> u
376
-
| None -> "(unknown)"
374
+
Git.get_remote_url ~proc ~fs ~remote:remote_name checkout_dir
375
+
|> Option.value ~default:"(unknown)"
377
376
in
378
377
(* Try to get ahead/behind for this remote *)
379
378
let ahead, behind =
···
910
909
(* Sync is run at CLI level before calling analyze *)
911
910
let now = Eio.Time.now clock in
912
911
let now_ptime =
913
-
match Ptime.of_float_s now with Some t -> t | None -> Ptime.v (0, 0L)
912
+
Ptime.of_float_s now |> Option.value ~default:(Ptime.v (0, 0L))
914
913
in
915
914
let timestamp = Ptime.to_rfc3339 now_ptime ~tz_offset_s:0 in
916
915
let workspace = Fpath.to_string (Verse_config.root verse_config) in
···
1127
1126
with
1128
1127
| Ok s -> s
1129
1128
| Error e -> failwith (Printf.sprintf "Failed to encode report: %s" e)
1129
+
1130
+
(** {1 Health Status} *)
1131
+
1132
+
(** Health status for cron-job style exit codes *)
1133
+
type health = Healthy | Warning | Critical
1134
+
1135
+
let health_to_exit_code = function
1136
+
| Healthy -> 0
1137
+
| Warning -> 1
1138
+
| Critical -> 2
1139
+
1140
+
(** Compute overall health status from a report.
1141
+
- Critical: has critical/high priority issues or warnings
1142
+
- Warning: has medium priority issues, sync needed, or behind upstream
1143
+
- Healthy: no issues found *)
1144
+
let compute_health report =
1145
+
(* Check for critical/high priority recommendations *)
1146
+
let has_critical =
1147
+
List.exists
1148
+
(fun a ->
1149
+
match a.action_priority with Critical | High -> true | _ -> false)
1150
+
report.recommendations
1151
+
in
1152
+
(* Check for warnings *)
1153
+
let has_warnings = report.warnings <> [] in
1154
+
(* Check for sync issues or upstream drift *)
1155
+
let has_sync_issues =
1156
+
report.report_summary.repos_need_sync > 0
1157
+
|| report.report_summary.repos_behind_upstream > 0
1158
+
|| report.report_summary.verse_divergences > 0
1159
+
in
1160
+
if has_critical || has_warnings then Critical
1161
+
else if has_sync_issues then Warning
1162
+
else Healthy
1163
+
1164
+
(** Check if the report has any issues worth reporting *)
1165
+
let has_issues report =
1166
+
report.report_summary.repos_need_sync > 0
1167
+
|| report.report_summary.repos_behind_upstream > 0
1168
+
|| report.report_summary.verse_divergences > 0
1169
+
|| report.warnings <> []
1170
+
|| report.recommendations <> []
+21
lib/doctor.mli
+21
lib/doctor.mli
···
170
170
@param clock Eio clock for time operations
171
171
@param package Optional specific package to analyze
172
172
@param no_sync If true, skip the initial sync (default: false) *)
173
+
174
+
(** {1 Health Status (for cron jobs)} *)
175
+
176
+
(** Health status for exit code determination *)
177
+
type health = Healthy | Warning | Critical
178
+
179
+
val health_to_exit_code : health -> int
180
+
(** [health_to_exit_code h] returns the exit code for the given health status:
181
+
- Healthy = 0
182
+
- Warning = 1
183
+
- Critical = 2 *)
184
+
185
+
val compute_health : report -> health
186
+
(** [compute_health report] computes the overall health status from a report.
187
+
- Critical: has critical/high priority issues or warnings
188
+
- Warning: has medium priority issues, sync needed, or behind upstream
189
+
- Healthy: no issues found *)
190
+
191
+
val has_issues : report -> bool
192
+
(** [has_issues report] returns true if the report has any issues worth
193
+
reporting (sync needed, behind upstream, warnings, or recommendations). *)
+17
-26
lib/git.ml
+17
-26
lib/git.ml
···
64
64
in
65
65
check 0
66
66
67
+
(** Patterns indicating retryable HTTP 5xx or network errors *)
68
+
let retryable_error_patterns =
69
+
[
70
+
(* HTTP 5xx errors *)
71
+
"500"; "502"; "503"; "504"; "HTTP 5"; "http 5";
72
+
"Internal Server Error"; "Bad Gateway"; "Service Unavailable"; "Gateway Timeout";
73
+
(* RPC failures (common git smart HTTP errors) *)
74
+
"RPC failed"; "curl"; "unexpected disconnect";
75
+
"the remote end hung up"; "early EOF";
76
+
(* Connection errors *)
77
+
"Connection refused"; "Connection reset"; "Connection timed out";
78
+
"Could not resolve host"; "Failed to connect";
79
+
"Network is unreachable"; "Temporary failure";
80
+
]
81
+
67
82
(** Check if an error is a retryable HTTP server error (5xx) or network error *)
68
83
let is_retryable_error result =
69
84
let stderr = result.stderr in
70
-
(* Common patterns for HTTP 5xx errors in git output *)
71
-
String.length stderr > 0 &&
72
-
(string_contains ~needle:"500" stderr ||
73
-
string_contains ~needle:"502" stderr ||
74
-
string_contains ~needle:"503" stderr ||
75
-
string_contains ~needle:"504" stderr ||
76
-
string_contains ~needle:"HTTP 5" stderr ||
77
-
string_contains ~needle:"http 5" stderr ||
78
-
string_contains ~needle:"Internal Server Error" stderr ||
79
-
string_contains ~needle:"Bad Gateway" stderr ||
80
-
string_contains ~needle:"Service Unavailable" stderr ||
81
-
string_contains ~needle:"Gateway Timeout" stderr ||
82
-
(* RPC failures (common git smart HTTP errors) *)
83
-
string_contains ~needle:"RPC failed" stderr ||
84
-
string_contains ~needle:"curl" stderr ||
85
-
string_contains ~needle:"unexpected disconnect" stderr ||
86
-
string_contains ~needle:"the remote end hung up" stderr ||
87
-
string_contains ~needle:"early EOF" stderr ||
88
-
(* Connection errors *)
89
-
string_contains ~needle:"Connection refused" stderr ||
90
-
string_contains ~needle:"Connection reset" stderr ||
91
-
string_contains ~needle:"Connection timed out" stderr ||
92
-
string_contains ~needle:"Could not resolve host" stderr ||
93
-
string_contains ~needle:"Failed to connect" stderr ||
94
-
string_contains ~needle:"Network is unreachable" stderr ||
95
-
string_contains ~needle:"Temporary failure" stderr)
85
+
String.length stderr > 0
86
+
&& List.exists (fun needle -> string_contains ~needle stderr) retryable_error_patterns
96
87
97
88
(** Run a git command with retry logic for network errors.
98
89
Retries up to [max_retries] times with exponential backoff starting at [initial_delay_ms]. *)
+1
-4
lib/status.ml
+1
-4
lib/status.ml
···
203
203
let pp_compact ?sources ppf t =
204
204
let name = Package.name t.package in
205
205
let subtree = Package.subtree_prefix t.package in
206
-
let entry = match sources with
207
-
| Some s -> Sources_registry.find s ~subtree
208
-
| None -> None
209
-
in
206
+
let entry = Option.bind sources (fun s -> Sources_registry.find s ~subtree) in
210
207
(* Helper to print remote sync info *)
211
208
let pp_remote ab =
212
209
if ab.Git.ahead > 0 && ab.behind > 0 then