jon.recoil.org
forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
Add doctor command with Claude-powered analysis
Implements `monopam doctor` for workspace health analysis:
- Checks local sync status (monorepo vs checkouts)
- Checks remote sync status (checkouts vs upstream)
- Analyzes fork relationships with verse members
- Uses Claude AI to categorize and prioritize verse commits
- Generates actionable recommendations
Features:
- Commit categorization: security-fix, bug-fix, feature, refactor, docs, test
- Priority levels: critical, high, medium, low
- Recommendations: merge-now, review-first, skip, needs-discussion
- Conflict risk assessment
Output formats:
- Human-readable text with colors (default)
- JSON output with --json flag
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
anil.recoil.org
+52
-1
bin/main.ml
+52
-1
bin/main.ml
···
717
717
verse_sync_cmd;
718
718
]
719
719
720
+
(* Doctor command *)
721
+
722
+
let doctor_cmd =
723
+
let doc = "Claude-powered workspace health analysis" in
724
+
let man =
725
+
[
726
+
`S Manpage.s_description;
727
+
`P
728
+
"Analyzes your workspace health and provides actionable recommendations. \
729
+
Uses Claude AI to analyze commits from verse collaborators, categorizing \
730
+
them by type, priority, and risk level.";
731
+
`S "WHAT IT DOES";
732
+
`P "The doctor command:";
733
+
`I ("1.", "Checks local sync status (monorepo vs checkouts)");
734
+
`I ("2.", "Checks remote sync status (checkouts vs upstream)");
735
+
`I ("3.", "Analyzes fork relationships with verse members");
736
+
`I ("4.", "Uses Claude to categorize and prioritize their commits");
737
+
`I ("5.", "Generates actionable recommendations");
738
+
`S "OUTPUT FORMATS";
739
+
`P "By default, outputs human-readable text with colors.";
740
+
`P "Use $(b,--json) for JSON output suitable for tooling.";
741
+
`S Manpage.s_examples;
742
+
`P "Run full analysis:";
743
+
`Pre "monopam doctor";
744
+
`P "Analyze a specific repo:";
745
+
`Pre "monopam doctor eio";
746
+
`P "Output as JSON:";
747
+
`Pre "monopam doctor --json";
748
+
]
749
+
in
750
+
let info = Cmd.info "doctor" ~doc ~man in
751
+
let json_arg =
752
+
let doc = "Output as JSON instead of formatted text." in
753
+
Arg.(value & flag & info [ "json" ] ~doc)
754
+
in
755
+
let run package json () =
756
+
Eio_main.run @@ fun env ->
757
+
with_config env @@ fun config ->
758
+
with_verse_config env @@ fun verse_config ->
759
+
let fs = Eio.Stdenv.fs env in
760
+
let proc = Eio.Stdenv.process_mgr env in
761
+
let clock = Eio.Stdenv.clock env in
762
+
let report = Monopam.Doctor.analyze ~proc ~fs ~config ~verse_config ~clock ?package () in
763
+
if json then
764
+
print_endline (Monopam.Doctor.to_json report)
765
+
else
766
+
Fmt.pr "%a@." Monopam.Doctor.pp_report report;
767
+
`Ok ()
768
+
in
769
+
Cmd.v info Term.(ret (const run $ package_arg $ json_arg $ logging_term))
770
+
720
771
(* Main command group *)
721
772
722
773
let main_cmd =
···
812
863
in
813
864
let info = Cmd.info "monopam" ~version:"%%VERSION%%" ~doc ~man in
814
865
Cmd.group info
815
-
[ status_cmd; sync_cmd; changes_cmd; opam_cmd; verse_cmd ]
866
+
[ status_cmd; sync_cmd; changes_cmd; opam_cmd; doctor_cmd; verse_cmd ]
816
867
817
868
let () = exit (Cmd.eval main_cmd)
+639
lib/doctor.ml
+639
lib/doctor.ml
···
1
+
(** Doctor command - Claude-powered workspace health analysis.
2
+
3
+
Analyzes workspace state, verse member commits, and provides
4
+
actionable recommendations for maintaining your monorepo. *)
5
+
6
+
let src = Logs.Src.create "monopam.doctor" ~doc:"Doctor analysis"
7
+
module Log = (val Logs.src_log src : Logs.LOG)
8
+
9
+
(** {1 Types} *)
10
+
11
+
(** Category of a commit change *)
12
+
type change_category =
13
+
| Security_fix
14
+
| Bug_fix
15
+
| Feature
16
+
| Refactor
17
+
| Documentation
18
+
| Test
19
+
| Other
20
+
21
+
(** Priority level for a change *)
22
+
type priority =
23
+
| Critical
24
+
| High
25
+
| Medium
26
+
| Low
27
+
28
+
(** Recommended action for a commit *)
29
+
type recommendation =
30
+
| Merge_now
31
+
| Review_first
32
+
| Skip
33
+
| Needs_discussion
34
+
35
+
(** Risk of conflicts when merging *)
36
+
type conflict_risk =
37
+
| None_risk
38
+
| Low_risk
39
+
| Medium_risk
40
+
| High_risk
41
+
42
+
(** Analysis of a single commit from a verse member *)
43
+
type commit_analysis = {
44
+
hash : string;
45
+
subject : string;
46
+
author : string;
47
+
date : string;
48
+
category : change_category;
49
+
priority : priority;
50
+
recommendation : recommendation;
51
+
conflict_risk : conflict_risk;
52
+
commit_summary : string;
53
+
}
54
+
55
+
(** Analysis of commits from a specific verse member for a repo *)
56
+
type verse_analysis = {
57
+
handle : string;
58
+
commits : commit_analysis list;
59
+
suggested_action : string option;
60
+
}
61
+
62
+
(** Sync status for a single repository *)
63
+
type repo_sync = {
64
+
name : string;
65
+
local_sync : [ `In_sync | `Ahead of int | `Behind of int | `Needs_sync ];
66
+
remote_ahead : int;
67
+
remote_behind : int;
68
+
verse_analyses : verse_analysis list;
69
+
}
70
+
71
+
(** Summary statistics *)
72
+
type report_summary = {
73
+
repos_total : int;
74
+
repos_need_sync : int;
75
+
repos_behind_upstream : int;
76
+
verse_divergences : int;
77
+
}
78
+
79
+
(** Actionable recommendation *)
80
+
type action = {
81
+
action_priority : priority;
82
+
description : string;
83
+
command : string option;
84
+
}
85
+
86
+
(** Full doctor report *)
87
+
type report = {
88
+
timestamp : string;
89
+
workspace : string;
90
+
report_summary : report_summary;
91
+
repos : repo_sync list;
92
+
recommendations : action list;
93
+
warnings : string list;
94
+
}
95
+
96
+
(** {1 JSON Encoding} *)
97
+
98
+
let change_category_to_string = function
99
+
| Security_fix -> "security-fix"
100
+
| Bug_fix -> "bug-fix"
101
+
| Feature -> "feature"
102
+
| Refactor -> "refactor"
103
+
| Documentation -> "docs"
104
+
| Test -> "test"
105
+
| Other -> "other"
106
+
107
+
let change_category_of_string = function
108
+
| "security-fix" -> Security_fix
109
+
| "bug-fix" -> Bug_fix
110
+
| "feature" -> Feature
111
+
| "refactor" -> Refactor
112
+
| "docs" -> Documentation
113
+
| "test" -> Test
114
+
| _ -> Other
115
+
116
+
let priority_to_string = function
117
+
| Critical -> "critical"
118
+
| High -> "high"
119
+
| Medium -> "medium"
120
+
| Low -> "low"
121
+
122
+
let priority_of_string = function
123
+
| "critical" -> Critical
124
+
| "high" -> High
125
+
| "medium" -> Medium
126
+
| _ -> Low
127
+
128
+
let recommendation_to_string = function
129
+
| Merge_now -> "merge-now"
130
+
| Review_first -> "review-first"
131
+
| Skip -> "skip"
132
+
| Needs_discussion -> "needs-discussion"
133
+
134
+
let recommendation_of_string = function
135
+
| "merge-now" -> Merge_now
136
+
| "review-first" -> Review_first
137
+
| "skip" -> Skip
138
+
| _ -> Needs_discussion
139
+
140
+
let conflict_risk_to_string = function
141
+
| None_risk -> "none"
142
+
| Low_risk -> "low"
143
+
| Medium_risk -> "medium"
144
+
| High_risk -> "high"
145
+
146
+
let conflict_risk_of_string = function
147
+
| "none" -> None_risk
148
+
| "low" -> Low_risk
149
+
| "medium" -> Medium_risk
150
+
| "high" -> High_risk
151
+
| _ -> Low_risk
152
+
153
+
let commit_analysis_jsont =
154
+
let make hash subject author date category priority recommendation conflict_risk commit_summary =
155
+
{ hash; subject; author; date;
156
+
category = change_category_of_string category;
157
+
priority = priority_of_string priority;
158
+
recommendation = recommendation_of_string recommendation;
159
+
conflict_risk = conflict_risk_of_string conflict_risk;
160
+
commit_summary }
161
+
in
162
+
Jsont.Object.map ~kind:"commit_analysis" make
163
+
|> Jsont.Object.mem "hash" Jsont.string ~enc:(fun c -> c.hash)
164
+
|> Jsont.Object.mem "subject" Jsont.string ~enc:(fun c -> c.subject)
165
+
|> Jsont.Object.mem "author" Jsont.string ~enc:(fun c -> c.author)
166
+
|> Jsont.Object.mem "date" Jsont.string ~enc:(fun c -> c.date)
167
+
|> Jsont.Object.mem "category" Jsont.string ~enc:(fun c -> change_category_to_string c.category)
168
+
|> Jsont.Object.mem "priority" Jsont.string ~enc:(fun c -> priority_to_string c.priority)
169
+
|> Jsont.Object.mem "recommendation" Jsont.string ~enc:(fun c -> recommendation_to_string c.recommendation)
170
+
|> Jsont.Object.mem "conflict_risk" Jsont.string ~enc:(fun c -> conflict_risk_to_string c.conflict_risk)
171
+
|> Jsont.Object.mem "summary" Jsont.string ~enc:(fun c -> c.commit_summary)
172
+
|> Jsont.Object.finish
173
+
174
+
let verse_analysis_jsont =
175
+
let make handle commits suggested_action = { handle; commits; suggested_action } in
176
+
Jsont.Object.map ~kind:"verse_analysis" make
177
+
|> Jsont.Object.mem "handle" Jsont.string ~enc:(fun v -> v.handle)
178
+
|> Jsont.Object.mem "commits" (Jsont.list commit_analysis_jsont) ~enc:(fun v -> v.commits)
179
+
|> Jsont.Object.mem "suggested_action" (Jsont.option Jsont.string) ~dec_absent:None ~enc:(fun v -> v.suggested_action)
180
+
|> Jsont.Object.finish
181
+
182
+
let local_sync_to_string = function
183
+
| `In_sync -> "in_sync"
184
+
| `Ahead n -> Printf.sprintf "ahead:%d" n
185
+
| `Behind n -> Printf.sprintf "behind:%d" n
186
+
| `Needs_sync -> "needs_sync"
187
+
188
+
let local_sync_of_string s =
189
+
if s = "in_sync" then `In_sync
190
+
else if s = "needs_sync" then `Needs_sync
191
+
else if String.starts_with ~prefix:"ahead:" s then
192
+
`Ahead (int_of_string (String.sub s 6 (String.length s - 6)))
193
+
else if String.starts_with ~prefix:"behind:" s then
194
+
`Behind (int_of_string (String.sub s 7 (String.length s - 7)))
195
+
else `Needs_sync
196
+
197
+
let repo_sync_jsont =
198
+
let make name local_sync remote_ahead remote_behind verse_analyses =
199
+
{ name; local_sync = local_sync_of_string local_sync; remote_ahead; remote_behind; verse_analyses }
200
+
in
201
+
Jsont.Object.map ~kind:"repo_sync" make
202
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun r -> r.name)
203
+
|> Jsont.Object.mem "local_sync" Jsont.string ~enc:(fun r -> local_sync_to_string r.local_sync)
204
+
|> Jsont.Object.mem "remote_ahead" Jsont.int ~enc:(fun r -> r.remote_ahead)
205
+
|> Jsont.Object.mem "remote_behind" Jsont.int ~enc:(fun r -> r.remote_behind)
206
+
|> Jsont.Object.mem "verse_analyses" (Jsont.list verse_analysis_jsont) ~enc:(fun r -> r.verse_analyses)
207
+
|> Jsont.Object.finish
208
+
209
+
let report_summary_jsont =
210
+
let make repos_total repos_need_sync repos_behind_upstream verse_divergences : report_summary =
211
+
{ repos_total; repos_need_sync; repos_behind_upstream; verse_divergences }
212
+
in
213
+
Jsont.Object.map ~kind:"report_summary" make
214
+
|> Jsont.Object.mem "repos_total" Jsont.int ~enc:(fun s -> s.repos_total)
215
+
|> Jsont.Object.mem "repos_need_sync" Jsont.int ~enc:(fun s -> s.repos_need_sync)
216
+
|> Jsont.Object.mem "repos_behind_upstream" Jsont.int ~enc:(fun s -> s.repos_behind_upstream)
217
+
|> Jsont.Object.mem "verse_divergences" Jsont.int ~enc:(fun s -> s.verse_divergences)
218
+
|> Jsont.Object.finish
219
+
220
+
let action_jsont =
221
+
let make priority description command =
222
+
{ action_priority = priority_of_string priority; description; command }
223
+
in
224
+
Jsont.Object.map ~kind:"action" make
225
+
|> Jsont.Object.mem "priority" Jsont.string ~enc:(fun a -> priority_to_string a.action_priority)
226
+
|> Jsont.Object.mem "action" Jsont.string ~enc:(fun a -> a.description)
227
+
|> Jsont.Object.mem "command" (Jsont.option Jsont.string) ~dec_absent:None ~enc:(fun a -> a.command)
228
+
|> Jsont.Object.finish
229
+
230
+
let report_jsont =
231
+
let make timestamp workspace report_summary repos recommendations warnings =
232
+
{ timestamp; workspace; report_summary; repos; recommendations; warnings }
233
+
in
234
+
Jsont.Object.map ~kind:"report" make
235
+
|> Jsont.Object.mem "timestamp" Jsont.string ~enc:(fun r -> r.timestamp)
236
+
|> Jsont.Object.mem "workspace" Jsont.string ~enc:(fun r -> r.workspace)
237
+
|> Jsont.Object.mem "summary" report_summary_jsont ~enc:(fun r -> r.report_summary)
238
+
|> Jsont.Object.mem "repos" (Jsont.list repo_sync_jsont) ~enc:(fun r -> r.repos)
239
+
|> Jsont.Object.mem "recommendations" (Jsont.list action_jsont) ~enc:(fun r -> r.recommendations)
240
+
|> Jsont.Object.mem "warnings" (Jsont.list Jsont.string) ~enc:(fun r -> r.warnings)
241
+
|> Jsont.Object.finish
242
+
243
+
(** {1 Text Rendering} *)
244
+
245
+
let pp_priority ppf = function
246
+
| Critical -> Fmt.(styled `Red string) ppf "CRIT"
247
+
| High -> Fmt.(styled `Red string) ppf "HIGH"
248
+
| Medium -> Fmt.(styled `Yellow string) ppf "MED "
249
+
| Low -> Fmt.(styled `Faint string) ppf "LOW "
250
+
251
+
let pp_category ppf = function
252
+
| Security_fix -> Fmt.(styled `Red string) ppf "security"
253
+
| Bug_fix -> Fmt.(styled `Magenta string) ppf "bug-fix"
254
+
| Feature -> Fmt.(styled `Green string) ppf "feature"
255
+
| Refactor -> Fmt.(styled `Cyan string) ppf "refactor"
256
+
| Documentation -> Fmt.(styled `Blue string) ppf "docs"
257
+
| Test -> Fmt.(styled `Faint string) ppf "test"
258
+
| Other -> Fmt.string ppf "other"
259
+
260
+
let pp_recommendation ppf = function
261
+
| Merge_now -> Fmt.(styled `Green string) ppf "merge-now"
262
+
| Review_first -> Fmt.(styled `Yellow string) ppf "review-first"
263
+
| Skip -> Fmt.(styled `Faint string) ppf "skip"
264
+
| Needs_discussion -> Fmt.(styled `Cyan string) ppf "discuss"
265
+
266
+
let pp_conflict_risk ppf = function
267
+
| None_risk -> Fmt.(styled `Green string) ppf "none"
268
+
| Low_risk -> Fmt.(styled `Green string) ppf "low"
269
+
| Medium_risk -> Fmt.(styled `Yellow string) ppf "medium"
270
+
| High_risk -> Fmt.(styled `Red string) ppf "high"
271
+
272
+
let pp_commit_analysis ppf c =
273
+
Fmt.pf ppf " [%a] %s %s@." pp_priority c.priority c.hash c.subject;
274
+
Fmt.pf ppf " Category: %a | Risk: %a | Action: %a@."
275
+
pp_category c.category
276
+
pp_conflict_risk c.conflict_risk
277
+
pp_recommendation c.recommendation;
278
+
if c.commit_summary <> "" then
279
+
Fmt.pf ppf " -> %s@." c.commit_summary
280
+
281
+
let pp_verse_analysis ppf v =
282
+
Fmt.pf ppf "@. Their commits from %s (%d):@.@." v.handle (List.length v.commits);
283
+
List.iter (pp_commit_analysis ppf) v.commits;
284
+
match v.suggested_action with
285
+
| Some cmd -> Fmt.pf ppf "@. Suggested: %s@." cmd
286
+
| None -> ()
287
+
288
+
let pp_repo_sync ppf r =
289
+
let local_str = match r.local_sync with
290
+
| `In_sync -> "="
291
+
| `Ahead n -> Printf.sprintf "+%d" n
292
+
| `Behind n -> Printf.sprintf "-%d" n
293
+
| `Needs_sync -> "sync"
294
+
in
295
+
Fmt.pf ppf "@.%a (local:%s, remote:+%d/-%d)@."
296
+
Fmt.(styled `Bold string) r.name local_str r.remote_ahead r.remote_behind;
297
+
if r.verse_analyses <> [] then
298
+
List.iter (pp_verse_analysis ppf) r.verse_analyses
299
+
300
+
let pp_action ppf a =
301
+
Fmt.pf ppf " [%a] %s@." pp_priority a.action_priority a.description;
302
+
match a.command with
303
+
| Some cmd -> Fmt.pf ppf " $ %s@." cmd
304
+
| None -> ()
305
+
306
+
let pp_report ppf r =
307
+
Fmt.pf ppf "@.=== Monopam Doctor Report ===@.";
308
+
Fmt.pf ppf "Generated: %s@." r.timestamp;
309
+
Fmt.pf ppf "@.Summary:@.";
310
+
Fmt.pf ppf " %d repos tracked@." r.report_summary.repos_total;
311
+
Fmt.pf ppf " %d need local sync@." r.report_summary.repos_need_sync;
312
+
Fmt.pf ppf " %d behind upstream@." r.report_summary.repos_behind_upstream;
313
+
Fmt.pf ppf " %d verse divergences@." r.report_summary.verse_divergences;
314
+
315
+
(* Only show repos with issues *)
316
+
let repos_with_issues = List.filter (fun r ->
317
+
r.local_sync <> `In_sync ||
318
+
r.remote_behind > 0 ||
319
+
r.verse_analyses <> [])
320
+
r.repos
321
+
in
322
+
if repos_with_issues <> [] then begin
323
+
Fmt.pf ppf "@.---@.";
324
+
List.iter (pp_repo_sync ppf) repos_with_issues
325
+
end;
326
+
327
+
if r.recommendations <> [] then begin
328
+
Fmt.pf ppf "@.---@.";
329
+
Fmt.pf ppf "@.Recommendations:@.";
330
+
List.iter (pp_action ppf) r.recommendations
331
+
end;
332
+
333
+
if r.warnings <> [] then begin
334
+
Fmt.pf ppf "@.Warnings:@.";
335
+
List.iter (fun w -> Fmt.pf ppf " * %s@." w) r.warnings
336
+
end
337
+
338
+
(** {1 Claude Analysis} *)
339
+
340
+
(** JSON type for Claude's response about commits *)
341
+
type claude_commit_response = {
342
+
category : string;
343
+
cr_priority : string;
344
+
cr_recommendation : string;
345
+
cr_conflict_risk : string;
346
+
cr_summary : string;
347
+
}
348
+
349
+
let claude_commit_response_jsont =
350
+
let make category cr_priority cr_recommendation cr_conflict_risk cr_summary =
351
+
{ category; cr_priority; cr_recommendation; cr_conflict_risk; cr_summary }
352
+
in
353
+
Jsont.Object.map ~kind:"claude_commit_response" make
354
+
|> Jsont.Object.mem "category" Jsont.string ~enc:(fun c -> c.category)
355
+
|> Jsont.Object.mem "priority" Jsont.string ~enc:(fun c -> c.cr_priority)
356
+
|> Jsont.Object.mem "recommendation" Jsont.string ~enc:(fun c -> c.cr_recommendation)
357
+
|> Jsont.Object.mem "conflict_risk" Jsont.string ~enc:(fun c -> c.cr_conflict_risk)
358
+
|> Jsont.Object.mem "summary" Jsont.string ~enc:(fun c -> c.cr_summary)
359
+
|> Jsont.Object.finish
360
+
361
+
(** Analyze commits using Claude *)
362
+
let analyze_verse_commits
363
+
~sw ~process_mgr ~clock
364
+
~repo_name ~handle
365
+
(commits : Git.log_entry list) =
366
+
if commits = [] then { handle; commits = []; suggested_action = None }
367
+
else begin
368
+
let prompt = Buffer.create 2048 in
369
+
Buffer.add_string prompt (Printf.sprintf
370
+
"You are analyzing git commits from a verse collaborator's repository.\n\n");
371
+
Buffer.add_string prompt (Printf.sprintf
372
+
"Repository: %s\nCollaborator: %s\n\n" repo_name handle);
373
+
Buffer.add_string prompt "Commits to analyze:\n\n";
374
+
List.iter (fun (c : Git.log_entry) ->
375
+
Buffer.add_string prompt (Printf.sprintf "### %s by %s (%s)\n%s\n\n%s\n---\n\n"
376
+
(String.sub c.hash 0 (min 7 (String.length c.hash)))
377
+
c.author c.date c.subject c.body))
378
+
commits;
379
+
Buffer.add_string prompt {|
380
+
For each commit, provide JSON analysis:
381
+
- category: security-fix, bug-fix, feature, refactor, docs, test, other
382
+
- priority: critical (security issues), high (important fixes), medium (nice to have), low (minor)
383
+
- recommendation: merge-now, review-first, skip, needs-discussion
384
+
- conflict_risk: none, low, medium, high
385
+
- summary: one-line description of what the commit does (max 80 chars)
386
+
387
+
Respond with a JSON array of analyses, one per commit in order.
388
+
|};
389
+
390
+
(* Create schema for array of responses *)
391
+
let output_schema =
392
+
let open Jsont in
393
+
Object ([
394
+
(("type", Meta.none), String ("array", Meta.none));
395
+
(("items", Meta.none), Object ([
396
+
(("type", Meta.none), String ("object", Meta.none));
397
+
(("properties", Meta.none), Object ([
398
+
(("category", Meta.none), Object ([
399
+
(("type", Meta.none), String ("string", Meta.none));
400
+
], Meta.none));
401
+
(("priority", Meta.none), Object ([
402
+
(("type", Meta.none), String ("string", Meta.none));
403
+
], Meta.none));
404
+
(("recommendation", Meta.none), Object ([
405
+
(("type", Meta.none), String ("string", Meta.none));
406
+
], Meta.none));
407
+
(("conflict_risk", Meta.none), Object ([
408
+
(("type", Meta.none), String ("string", Meta.none));
409
+
], Meta.none));
410
+
(("summary", Meta.none), Object ([
411
+
(("type", Meta.none), String ("string", Meta.none));
412
+
], Meta.none));
413
+
], Meta.none));
414
+
(("required", Meta.none), Array ([
415
+
String ("category", Meta.none);
416
+
String ("priority", Meta.none);
417
+
String ("recommendation", Meta.none);
418
+
String ("conflict_risk", Meta.none);
419
+
String ("summary", Meta.none);
420
+
], Meta.none));
421
+
], Meta.none));
422
+
], Meta.none)
423
+
in
424
+
let output_format = Claude.Proto.Structured_output.of_json_schema output_schema in
425
+
let options =
426
+
Claude.Options.default
427
+
|> Claude.Options.with_output_format output_format
428
+
|> Claude.Options.with_max_turns 1
429
+
in
430
+
431
+
let client = Claude.Client.create ~sw ~process_mgr ~clock ~options () in
432
+
Claude.Client.query client (Buffer.contents prompt);
433
+
434
+
let responses = Claude.Client.receive_all client in
435
+
let analyses = ref [] in
436
+
437
+
List.iter (function
438
+
| Claude.Response.Complete c -> (
439
+
match Claude.Response.Complete.structured_output c with
440
+
| Some json -> (
441
+
match Jsont.Json.decode (Jsont.list claude_commit_response_jsont) json with
442
+
| Ok resps ->
443
+
let commit_analyses = List.map2 (fun (commit : Git.log_entry) (resp : claude_commit_response) ->
444
+
{ hash = String.sub commit.hash 0 (min 7 (String.length commit.hash));
445
+
subject = commit.subject;
446
+
author = commit.author;
447
+
date = commit.date;
448
+
category = change_category_of_string resp.category;
449
+
priority = priority_of_string resp.cr_priority;
450
+
recommendation = recommendation_of_string resp.cr_recommendation;
451
+
conflict_risk = conflict_risk_of_string resp.cr_conflict_risk;
452
+
commit_summary = resp.cr_summary;
453
+
})
454
+
commits resps
455
+
in
456
+
analyses := commit_analyses
457
+
| Error e ->
458
+
Log.warn (fun m -> m "Failed to decode Claude response: %s" e))
459
+
| None ->
460
+
Log.warn (fun m -> m "No structured output from Claude"))
461
+
| Claude.Response.Error e ->
462
+
Log.warn (fun m -> m "Claude error: %s" (Claude.Response.Error.message e))
463
+
| _ -> ())
464
+
responses;
465
+
466
+
let commit_analyses = !analyses in
467
+
468
+
(* Generate suggested action if there are high-priority items *)
469
+
let high_priority = List.filter (fun (c : commit_analysis) ->
470
+
c.priority = Critical || c.priority = High)
471
+
commit_analyses
472
+
in
473
+
let suggested_action =
474
+
if high_priority <> [] then
475
+
let first = List.hd high_priority in
476
+
Some (Printf.sprintf "git fetch verse-%s && git cherry-pick %s"
477
+
handle first.hash)
478
+
else None
479
+
in
480
+
481
+
{ handle; commits = commit_analyses; suggested_action }
482
+
end
483
+
484
+
(** {1 Main Analysis} *)
485
+
486
+
(** Run the doctor analysis *)
487
+
let analyze
488
+
~proc ~fs ~config ~verse_config ~clock
489
+
?package () =
490
+
let now = Eio.Time.now clock in
491
+
let now_ptime = match Ptime.of_float_s now with
492
+
| Some t -> t
493
+
| None -> Ptime.v (0, 0L)
494
+
in
495
+
let timestamp = Ptime.to_rfc3339 now_ptime ~tz_offset_s:0 in
496
+
let workspace = Fpath.to_string (Verse_config.root verse_config) in
497
+
498
+
(* Get status for all packages *)
499
+
let statuses = match Status.compute_all ~proc ~fs ~config
500
+
(match Opam_repo.scan ~fs:(fs :> _ Eio.Path.t) (Config.Paths.opam_repo config) with
501
+
| Ok pkgs -> pkgs
502
+
| Error _ -> [])
503
+
with
504
+
| statuses -> statuses
505
+
in
506
+
507
+
(* Filter by package if specified *)
508
+
let statuses = match package with
509
+
| None -> statuses
510
+
| Some name -> List.filter (fun (s : Status.t) -> Package.name s.package = name) statuses
511
+
in
512
+
513
+
(* Compute fork analysis *)
514
+
let forks = Forks.compute ~proc ~fs:(fs :> Eio.Fs.dir_ty Eio.Path.t) ~verse_config ~monopam_config:config () in
515
+
516
+
(* Build warnings list *)
517
+
let warnings = ref [] in
518
+
519
+
(* Check opam-repo for dirty state *)
520
+
let opam_repo = Config.Paths.opam_repo config in
521
+
if Git.is_dirty ~proc ~fs opam_repo then
522
+
warnings := "opam-repo has uncommitted changes" :: !warnings;
523
+
524
+
(* Check monorepo for dirty state *)
525
+
let monorepo = Config.Paths.monorepo config in
526
+
if Git.is_dirty ~proc ~fs monorepo then
527
+
warnings := "monorepo has uncommitted changes" :: !warnings;
528
+
529
+
(* Build repo sync info *)
530
+
let repos = List.map (fun (status : Status.t) ->
531
+
let name = Package.repo_name status.package in
532
+
let local_sync = match status.subtree_sync with
533
+
| Status.In_sync -> `In_sync
534
+
| Status.Subtree_behind n -> `Behind n
535
+
| Status.Subtree_ahead n -> `Ahead n
536
+
| Status.Trees_differ -> `Needs_sync
537
+
| Status.Unknown -> `Needs_sync
538
+
in
539
+
let (remote_ahead, remote_behind) = match status.checkout with
540
+
| Status.Clean ab -> (ab.ahead, ab.behind)
541
+
| _ -> (0, 0)
542
+
in
543
+
544
+
(* Get verse analyses for this repo *)
545
+
let verse_analyses =
546
+
match List.find_opt (fun (a : Forks.repo_analysis) -> a.repo_name = name) forks.repos with
547
+
| None -> []
548
+
| Some analysis ->
549
+
(* For each verse source where we're behind, analyze their commits *)
550
+
List.filter_map (fun (handle, _src, rel) ->
551
+
match rel with
552
+
| Forks.I_am_behind _count ->
553
+
(* Get commits from their branch that we don't have *)
554
+
let checkouts_root = Config.Paths.checkouts config in
555
+
let checkout_dir = Fpath.(checkouts_root / name) in
556
+
let remote_ref = Printf.sprintf "verse-%s/main" handle in
557
+
let base_ref = "origin/main" in
558
+
(match Git.log ~proc ~fs ~since:(Printf.sprintf "%s.." base_ref)
559
+
~until:remote_ref checkout_dir with
560
+
| Ok commits when commits <> [] ->
561
+
let analysis = Eio.Switch.run @@ fun sw ->
562
+
analyze_verse_commits ~sw ~process_mgr:proc ~clock
563
+
~repo_name:name ~handle commits
564
+
in
565
+
Some analysis
566
+
| _ -> None)
567
+
| Forks.Diverged _ ->
568
+
(* Could also analyze diverged commits but skip for now *)
569
+
None
570
+
| _ -> None)
571
+
analysis.verse_sources
572
+
in
573
+
574
+
{ name; local_sync; remote_ahead; remote_behind; verse_analyses })
575
+
statuses
576
+
in
577
+
578
+
(* Compute summary *)
579
+
let repos_need_sync = List.length (List.filter (fun r -> r.local_sync <> `In_sync) repos) in
580
+
let repos_behind_upstream = List.length (List.filter (fun r -> r.remote_behind > 0) repos) in
581
+
let verse_divergences = List.fold_left (fun acc r -> acc + List.length r.verse_analyses) 0 repos in
582
+
let report_summary = {
583
+
repos_total = List.length repos;
584
+
repos_need_sync;
585
+
repos_behind_upstream;
586
+
verse_divergences;
587
+
} in
588
+
589
+
(* Build recommendations *)
590
+
let recommendations = ref [] in
591
+
592
+
(* Add recommendations for local sync issues *)
593
+
if repos_need_sync > 0 then
594
+
recommendations := {
595
+
action_priority = Medium;
596
+
description = "Run monopam sync to resolve local sync issues";
597
+
command = Some "monopam sync";
598
+
} :: !recommendations;
599
+
600
+
(* Add recommendations for repos behind upstream *)
601
+
if repos_behind_upstream > 0 then
602
+
recommendations := {
603
+
action_priority = Medium;
604
+
description = Printf.sprintf "Pull upstream changes for %d repos" repos_behind_upstream;
605
+
command = Some "monopam sync";
606
+
} :: !recommendations;
607
+
608
+
(* Add recommendations from verse analyses *)
609
+
List.iter (fun r ->
610
+
List.iter (fun v ->
611
+
List.iter (fun (c : commit_analysis) ->
612
+
if c.priority = Critical || c.priority = High then
613
+
recommendations := {
614
+
action_priority = c.priority;
615
+
description = Printf.sprintf "Review %s's %s in %s (%s)"
616
+
v.handle c.hash r.name c.commit_summary;
617
+
command = Some (Printf.sprintf "cd src/%s && git show verse-%s/%s"
618
+
r.name v.handle c.hash);
619
+
} :: !recommendations)
620
+
v.commits)
621
+
r.verse_analyses)
622
+
repos;
623
+
624
+
(* Sort recommendations by priority *)
625
+
let priority_order = function
626
+
| Critical -> 0 | High -> 1 | Medium -> 2 | Low -> 3
627
+
in
628
+
let recommendations = List.sort (fun a b ->
629
+
compare (priority_order a.action_priority) (priority_order b.action_priority))
630
+
!recommendations
631
+
in
632
+
633
+
{ timestamp; workspace; report_summary; repos; recommendations; warnings = List.rev !warnings }
634
+
635
+
(** Encode report to JSON string *)
636
+
let to_json report =
637
+
match Jsont_bytesrw.encode_string ~format:Jsont.Indent report_jsont report with
638
+
| Ok s -> s
639
+
| Error e -> failwith (Printf.sprintf "Failed to encode report: %s" e)
+177
lib/doctor.mli
+177
lib/doctor.mli
···
1
+
(** Doctor command - Claude-powered workspace health analysis.
2
+
3
+
Analyzes workspace state, verse member commits, and provides
4
+
actionable recommendations for maintaining your monorepo.
5
+
6
+
The doctor command uses Claude AI to analyze commits from verse
7
+
collaborators, categorizing them by type, priority, and risk level.
8
+
9
+
{1 Quick Start}
10
+
11
+
Run the doctor analysis:
12
+
{[
13
+
Eio_main.run @@ fun env ->
14
+
let fs = Eio.Stdenv.fs env in
15
+
let proc = Eio.Stdenv.process_mgr env in
16
+
let clock = Eio.Stdenv.clock env in
17
+
let report = Doctor.analyze ~proc ~fs ~config ~verse_config ~clock () in
18
+
Fmt.pr "%a@." Doctor.pp_report report
19
+
]}
20
+
21
+
Or output as JSON:
22
+
{[
23
+
let json = Doctor.to_json report in
24
+
print_endline json
25
+
]} *)
26
+
27
+
(** {1 Types} *)
28
+
29
+
(** Category of a commit change *)
30
+
type change_category =
31
+
| Security_fix
32
+
| Bug_fix
33
+
| Feature
34
+
| Refactor
35
+
| Documentation
36
+
| Test
37
+
| Other
38
+
39
+
(** Priority level for a change *)
40
+
type priority =
41
+
| Critical
42
+
| High
43
+
| Medium
44
+
| Low
45
+
46
+
(** Recommended action for a commit *)
47
+
type recommendation =
48
+
| Merge_now
49
+
| Review_first
50
+
| Skip
51
+
| Needs_discussion
52
+
53
+
(** Risk of conflicts when merging *)
54
+
type conflict_risk =
55
+
| None_risk
56
+
| Low_risk
57
+
| Medium_risk
58
+
| High_risk
59
+
60
+
(** Analysis of a single commit from a verse member *)
61
+
type commit_analysis = {
62
+
hash : string;
63
+
subject : string;
64
+
author : string;
65
+
date : string;
66
+
category : change_category;
67
+
priority : priority;
68
+
recommendation : recommendation;
69
+
conflict_risk : conflict_risk;
70
+
commit_summary : string;
71
+
}
72
+
73
+
(** Analysis of commits from a specific verse member for a repo *)
74
+
type verse_analysis = {
75
+
handle : string;
76
+
commits : commit_analysis list;
77
+
suggested_action : string option;
78
+
}
79
+
80
+
(** Sync status for a single repository *)
81
+
type repo_sync = {
82
+
name : string;
83
+
local_sync : [ `In_sync | `Ahead of int | `Behind of int | `Needs_sync ];
84
+
remote_ahead : int;
85
+
remote_behind : int;
86
+
verse_analyses : verse_analysis list;
87
+
}
88
+
89
+
(** Summary statistics *)
90
+
type report_summary = {
91
+
repos_total : int;
92
+
repos_need_sync : int;
93
+
repos_behind_upstream : int;
94
+
verse_divergences : int;
95
+
}
96
+
97
+
(** Actionable recommendation *)
98
+
type action = {
99
+
action_priority : priority;
100
+
description : string;
101
+
command : string option;
102
+
}
103
+
104
+
(** Full doctor report *)
105
+
type report = {
106
+
timestamp : string;
107
+
workspace : string;
108
+
report_summary : report_summary;
109
+
repos : repo_sync list;
110
+
recommendations : action list;
111
+
warnings : string list;
112
+
}
113
+
114
+
(** {1 Pretty Printing} *)
115
+
116
+
val pp_priority : priority Fmt.t
117
+
(** [pp_priority] formats a priority level with colors. *)
118
+
119
+
val pp_category : change_category Fmt.t
120
+
(** [pp_category] formats a change category with colors. *)
121
+
122
+
val pp_recommendation : recommendation Fmt.t
123
+
(** [pp_recommendation] formats a recommendation with colors. *)
124
+
125
+
val pp_conflict_risk : conflict_risk Fmt.t
126
+
(** [pp_conflict_risk] formats a conflict risk level with colors. *)
127
+
128
+
val pp_commit_analysis : commit_analysis Fmt.t
129
+
(** [pp_commit_analysis] formats a single commit analysis. *)
130
+
131
+
val pp_verse_analysis : verse_analysis Fmt.t
132
+
(** [pp_verse_analysis] formats verse member analysis. *)
133
+
134
+
val pp_repo_sync : repo_sync Fmt.t
135
+
(** [pp_repo_sync] formats repository sync status. *)
136
+
137
+
val pp_action : action Fmt.t
138
+
(** [pp_action] formats an action recommendation. *)
139
+
140
+
val pp_report : report Fmt.t
141
+
(** [pp_report] formats the full doctor report as human-readable text. *)
142
+
143
+
(** {1 JSON Encoding} *)
144
+
145
+
val report_jsont : report Jsont.t
146
+
(** [report_jsont] is the Jsont codec for the report type. *)
147
+
148
+
val to_json : report -> string
149
+
(** [to_json report] encodes the report as a JSON string. *)
150
+
151
+
(** {1 Analysis} *)
152
+
153
+
val analyze :
154
+
proc:_ Eio.Process.mgr ->
155
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
156
+
config:Config.t ->
157
+
verse_config:Verse_config.t ->
158
+
clock:float Eio.Time.clock_ty Eio.Resource.t ->
159
+
?package:string ->
160
+
unit ->
161
+
report
162
+
(** [analyze ~proc ~fs ~config ~verse_config ~clock ?package ()] runs the
163
+
doctor analysis and returns a report.
164
+
165
+
Performs the following analysis:
166
+
1. Computes status for all packages (or the specified package)
167
+
2. Checks for dirty state in opam-repo and monorepo
168
+
3. Analyzes fork relationships with verse members
169
+
4. Uses Claude AI to categorize and prioritize verse commits
170
+
5. Generates actionable recommendations
171
+
172
+
@param proc Eio process manager
173
+
@param fs Eio filesystem
174
+
@param config Monopam configuration
175
+
@param verse_config Verse/opamverse configuration
176
+
@param clock Eio clock for time operations
177
+
@param package Optional specific package to analyze *)
+1
lib/monopam.ml
+1
lib/monopam.ml