A Zulip bot agent to sit in our Black Sun. Ever evolving
poe: track cross-verse fork activity and de-emphasise metadata in daily updates
Restructure the changelog output into three sections: cross-verse fork
activity (grouped by source/target user), functionality changes (with
expanded descriptions), and metadata (project names only). Detect fork
relationships by scanning verse users' sources.toml for upstream fields.
Co-Authored-By: Claude (claude-opus-4-5) <noreply@anthropic.com>
+230
-36
+133
-25
lib/changelog.ml
+133
-25
lib/changelog.ml
···
28
28
change_type: string;
29
29
}
30
30
31
+
type fork_context = {
32
+
source_handle: string; (** who owns the upstream repo *)
33
+
target_handle: string; (** who made changes to the fork *)
34
+
repos: string list; (** which repos are forks *)
35
+
}
36
+
37
+
type structured_changelog = {
38
+
fork_activity: (string * string * changelog_item list) list;
39
+
(** (source_handle, target_handle, items) *)
40
+
functionality: changelog_item list;
41
+
metadata: string list; (** just project names *)
42
+
}
43
+
31
44
type changelog_response = {
32
45
items: changelog_item list;
33
46
}
···
46
59
~kind:"changelog_response"
47
60
(fun items -> { items })
48
61
|> Jsont.Object.mem "items" (Jsont.list changelog_item_codec) ~enc:(fun r -> r.items)
62
+
|> Jsont.Object.finish
63
+
64
+
(* Codec for fork_activity entries: {source, target, items} *)
65
+
let fork_group_codec : (string * string * changelog_item list) Jsont.t =
66
+
Jsont.Object.map
67
+
~kind:"fork_group"
68
+
(fun source target items -> (source, target, items))
69
+
|> Jsont.Object.mem "source" Jsont.string ~enc:(fun (s, _, _) -> s)
70
+
|> Jsont.Object.mem "target" Jsont.string ~enc:(fun (_, t, _) -> t)
71
+
|> Jsont.Object.mem "items" (Jsont.list changelog_item_codec) ~enc:(fun (_, _, i) -> i)
72
+
|> Jsont.Object.finish
73
+
74
+
let structured_changelog_codec : structured_changelog Jsont.t =
75
+
Jsont.Object.map
76
+
~kind:"structured_changelog"
77
+
(fun fork_activity functionality metadata -> { fork_activity; functionality; metadata })
78
+
|> Jsont.Object.mem "fork_activity" (Jsont.list fork_group_codec) ~enc:(fun r -> r.fork_activity)
79
+
|> Jsont.Object.mem "functionality" (Jsont.list changelog_item_codec) ~enc:(fun r -> r.functionality)
80
+
|> Jsont.Object.mem "metadata" (Jsont.list Jsont.string) ~enc:(fun r -> r.metadata)
49
81
|> Jsont.Object.finish
50
82
51
83
let get_commit_files ~proc ~cwd ~hash =
···
187
219
| Ok response -> Ok response.items
188
220
| Error e ->
189
221
Log.warn (fun m -> m "Failed to parse JSON response: %s" e);
222
+
Error e
223
+
224
+
(* Parse structured changelog JSON from Claude *)
225
+
let parse_structured_changelog json_str =
226
+
match Jsont_bytesrw.decode_string structured_changelog_codec json_str with
227
+
| Ok response -> Ok response
228
+
| Error e ->
229
+
Log.warn (fun m -> m "Failed to parse structured JSON: %s" e);
190
230
Error e
191
231
192
232
(* Build a map from package name to dev-repo URL by scanning the opam repo *)
···
220
260
in
221
261
Printf.sprintf "- **%s**: %s *%s*" project_link item.description item.change_type
222
262
223
-
let generate ~sw ~proc ~clock ~fs ~commits ~members ?opamrepo_path () =
263
+
(* Format a structured changelog with fork activity, functionality, and metadata sections *)
264
+
let format_structured ~package_urls (sc : structured_changelog) =
265
+
let buf = Buffer.create 512 in
266
+
(* Cross-verse activity *)
267
+
if sc.fork_activity <> [] then begin
268
+
Buffer.add_string buf "**Cross-verse activity**\n";
269
+
List.iter (fun (source, target, items) ->
270
+
Buffer.add_string buf (Printf.sprintf "*%s \u{2192} %s forks:*\n" target source);
271
+
List.iter (fun item ->
272
+
Buffer.add_string buf (format_item ~package_urls item);
273
+
Buffer.add_char buf '\n'
274
+
) items
275
+
) sc.fork_activity;
276
+
Buffer.add_char buf '\n'
277
+
end;
278
+
(* Functionality *)
279
+
if sc.functionality <> [] then begin
280
+
Buffer.add_string buf "**Functionality**\n";
281
+
List.iter (fun item ->
282
+
Buffer.add_string buf (format_item ~package_urls item);
283
+
Buffer.add_char buf '\n'
284
+
) sc.functionality;
285
+
Buffer.add_char buf '\n'
286
+
end;
287
+
(* Metadata - single line *)
288
+
if sc.metadata <> [] then begin
289
+
let linked = List.map (fun proj ->
290
+
match Hashtbl.find_opt package_urls proj with
291
+
| Some url -> Printf.sprintf "[%s](%s)" proj url
292
+
| None -> proj
293
+
) sc.metadata in
294
+
Buffer.add_string buf (Printf.sprintf "**Metadata** \u{2014} %s\n" (String.concat ", " linked))
295
+
end;
296
+
String.trim (Buffer.contents buf)
297
+
298
+
let generate ~sw ~proc ~clock ~fs ~commits ~members ?(fork_context=[]) ?opamrepo_path () =
224
299
if commits = [] then None
225
300
else begin
226
301
Log.info (fun m -> m "Generating narrative changelog with Claude for %d commits" (List.length commits));
···
250
325
|> String.concat "\n"
251
326
in
252
327
328
+
(* Format fork context *)
329
+
let fork_context_text = match fork_context with
330
+
| [] -> ""
331
+
| forks ->
332
+
let lines = List.map (fun (fc : fork_context) ->
333
+
Printf.sprintf "- %s has forked repos from %s: %s"
334
+
fc.target_handle fc.source_handle (String.concat ", " fc.repos)
335
+
) forks in
336
+
Printf.sprintf "\nFork relationships between verse users:\n%s\n" (String.concat "\n" lines)
337
+
in
338
+
339
+
let has_forks = fork_context <> [] in
340
+
253
341
let prompt = Printf.sprintf
254
342
{|You are writing a changelog update for a Zulip channel about a monorepo.
255
343
···
258
346
%s
259
347
260
348
Affected sub-projects: %s
261
-
349
+
%s
262
350
Channel members who can be @mentioned (use exact @**Name** format):
263
351
264
352
%s
265
353
266
-
Write a changelog as a JSON object with an "items" array. Each item should have:
354
+
Write a changelog as a JSON object with three sections:
355
+
- "fork_activity": array of objects with "source" (upstream owner handle), "target" (person who changed the fork), and "items" (array of changelog items for repos that are forks of another user). %s
356
+
- "functionality": array of changelog items for feature additions, bug fixes, enhancements, and other functional changes (NOT forks). Give these expanded descriptions (2-3 sentences).
357
+
- "metadata": array of project name strings for changes that are purely metadata (documentation, CI, formatting, version bumps, opam file updates, .ocamlformat changes, README updates). Just list the project names, no descriptions.
358
+
359
+
Each changelog item has:
267
360
- "project": the project/package name (string)
268
361
- "description": description of the change, may include @**Name** mentions (string)
269
-
- "change_type": one of "new feature", "bug fix", "enhancement", "refactoring", "documentation", etc. (string)
362
+
- "change_type": one of "new feature", "bug fix", "enhancement", "refactoring" (string)
270
363
271
364
Example output:
272
365
```json
273
366
{
274
-
"items": [
275
-
{"project": "ocaml-claudeio", "description": "Added model types for Opus 4.5 and 4.1.", "change_type": "new feature"},
276
-
{"project": "ocaml-zulip", "description": "Fixed encoding bug in channel name lookups that affected names with spaces.", "change_type": "bug fix"}
277
-
]
367
+
"fork_activity": [
368
+
{"source": "anil.recoil.org", "target": "gazagnaire.org", "items": [
369
+
{"project": "ocaml-mdns", "description": "Refactored DNS query pipeline to use Eio effects.", "change_type": "enhancement"}
370
+
]}
371
+
],
372
+
"functionality": [
373
+
{"project": "ocaml-claudeio", "description": "Added model types for Opus 4.5 and 4.1. This extends the client to support the latest Claude model lineup.", "change_type": "new feature"}
374
+
],
375
+
"metadata": ["ocaml-dns", "dune"]
278
376
}
279
377
```
280
378
281
379
Guidelines:
282
380
1. One item per logical change (group related commits)
283
-
2. One or two sentences for the description
381
+
2. Functionality items should have 2-3 sentence descriptions explaining the change and its purpose
284
382
3. Use @**Name** mentions in the description when authors match channel members
285
383
4. No emojis
384
+
5. Put documentation, CI, formatting, version bumps, and opam metadata changes in "metadata" not "functionality"
385
+
6. If a change is to a forked repo, put it in "fork_activity" grouped by source/target pair
286
386
287
-
Output ONLY the JSON object, no markdown code fences or other text.|} commits_text subprojects_text members_text
387
+
Output ONLY the JSON object, no markdown code fences or other text.|} commits_text subprojects_text fork_context_text members_text
388
+
(if has_forks then "Group items by (source, target) pair based on the fork relationships listed above."
389
+
else "Leave empty if no fork relationships exist.")
288
390
in
289
391
290
392
let response = ask_claude ~sw ~proc ~clock prompt in
291
393
Log.info (fun m -> m "Claude generated: %s" response);
292
394
293
-
(* Parse JSON and format with links *)
294
-
match parse_changelog_json (String.trim response) with
295
-
| Ok items ->
296
-
let last_date = most_recent_date commits in
297
-
let header = match last_date with
298
-
| Some d -> Printf.sprintf "**Changes as of %s**\n\n" (date_only d)
299
-
| None -> ""
300
-
in
301
-
let formatted = items
302
-
|> List.map (format_item ~package_urls)
303
-
|> String.concat "\n"
304
-
in
395
+
let last_date = most_recent_date commits in
396
+
let header = match last_date with
397
+
| Some d -> Printf.sprintf "**Changes as of %s**\n\n" (date_only d)
398
+
| None -> ""
399
+
in
400
+
401
+
(* Try structured format first, fall back to flat format *)
402
+
match parse_structured_changelog (String.trim response) with
403
+
| Ok sc ->
404
+
let formatted = format_structured ~package_urls sc in
305
405
Some (header ^ formatted)
306
406
| Error _ ->
307
-
(* Fallback: return raw response if JSON parsing fails *)
308
-
Log.warn (fun m -> m "Using raw Claude response as fallback");
309
-
Some (String.trim response)
407
+
(* Fallback: try flat format *)
408
+
match parse_changelog_json (String.trim response) with
409
+
| Ok items ->
410
+
let formatted = items
411
+
|> List.map (format_item ~package_urls)
412
+
|> String.concat "\n"
413
+
in
414
+
Some (header ^ formatted)
415
+
| Error _ ->
416
+
Log.warn (fun m -> m "Using raw Claude response as fallback");
417
+
Some (String.trim response)
310
418
end
+23
-8
lib/changelog.mli
+23
-8
lib/changelog.mli
···
53
53
(** [get_channel_members ~client ~channel] returns the members of [channel]
54
54
for mention matching. *)
55
55
56
+
(** {1 Utilities} *)
57
+
58
+
val affected_subprojects : commit list -> string list
59
+
(** [affected_subprojects commits] returns unique sub-project names from commit file paths. *)
60
+
61
+
(** {1 Fork Context} *)
62
+
63
+
type fork_context = {
64
+
source_handle: string;
65
+
target_handle: string;
66
+
repos: string list;
67
+
}
68
+
(** Fork relationship: [target_handle] has repos forked from [source_handle]. *)
69
+
56
70
(** {1 Changelog Generation} *)
57
71
58
72
val generate :
···
62
76
fs:_ Eio.Path.t ->
63
77
commits:commit list ->
64
78
members:channel_member list ->
79
+
?fork_context:fork_context list ->
65
80
?opamrepo_path:Fpath.t ->
66
81
unit ->
67
82
string option
68
-
(** [generate ~sw ~proc ~clock ~fs ~commits ~members ?opamrepo_path ()] generates
69
-
a bullet-point changelog using Claude. Returns [None] if commits is empty,
70
-
or [Some changelog] with the generated text.
83
+
(** [generate ~sw ~proc ~clock ~fs ~commits ~members ?fork_context ?opamrepo_path ()]
84
+
generates a structured changelog using Claude.
85
+
86
+
When [fork_context] is provided, the output is organized into three sections:
87
+
- Cross-verse activity: changes to repos forked from other verse users
88
+
- Functionality: feature/bugfix/enhancement changes with expanded descriptions
89
+
- Metadata: documentation, CI, formatting changes listed as project names only
71
90
72
-
Each bullet has the project name (linked to the actual project repository
73
-
from the opam metadata's dev-repo field if [opamrepo_path] is provided),
74
-
a description of the change, and the change type in italics.
75
-
The output includes a header with the date of the most recent commit.
76
-
Zulip mentions are used for authors matching channel members. *)
91
+
Returns [None] if commits is empty, or [Some changelog] with the formatted text. *)
+74
-3
lib/loop.ml
+74
-3
lib/loop.ml
···
136
136
let resp = Zulip.Messages.send client msg in
137
137
Log.info (fun m -> m "Broadcast sent, message ID: %d" (Zulip.Message_response.id resp))
138
138
139
+
(* Detect fork relationships: check if this user's affected repos appear as
140
+
forks in other users' sources.toml, or vice versa *)
141
+
let detect_fork_context ~fs ~verse_path ~handle ~affected_repos users =
142
+
(* For each other user, load their sources.toml and check for upstream refs *)
143
+
let forks = List.filter_map (fun (other : verse_user) ->
144
+
if other.handle = handle then None
145
+
else
146
+
let sources_path = Fpath.(v verse_path / other.handle / "sources.toml") in
147
+
match Monopam.Sources_registry.load ~fs sources_path with
148
+
| Error _ -> None
149
+
| Ok registry ->
150
+
(* Check if any of the other user's entries have upstream pointing to
151
+
repos that this user also has *)
152
+
let forked_repos = List.filter_map (fun (subtree, entry) ->
153
+
match entry.Monopam.Sources_registry.upstream with
154
+
| Some _upstream when List.mem subtree affected_repos ->
155
+
Some subtree
156
+
| _ ->
157
+
(* Also check if this user's sources.toml has entries with
158
+
upstream pointing to the other user's repos *)
159
+
None
160
+
) (Monopam.Sources_registry.to_list registry) in
161
+
match forked_repos with
162
+
| [] -> None
163
+
| repos -> Some { Changelog.source_handle = handle;
164
+
target_handle = other.handle;
165
+
repos }
166
+
) users in
167
+
(* Also check the reverse: if this user has sources with upstream pointing
168
+
to other users *)
169
+
let own_sources_path = Fpath.(v verse_path / handle / "sources.toml") in
170
+
let reverse_forks = match Monopam.Sources_registry.load ~fs own_sources_path with
171
+
| Error _ -> []
172
+
| Ok registry ->
173
+
List.filter_map (fun (subtree, entry) ->
174
+
match entry.Monopam.Sources_registry.upstream with
175
+
| Some upstream_url ->
176
+
(* Try to match upstream URL to a verse user *)
177
+
let matching_user = List.find_opt (fun (other : verse_user) ->
178
+
other.handle <> handle &&
179
+
(String.starts_with ~prefix:other.handle upstream_url ||
180
+
String.starts_with ~prefix:other.monorepo_url upstream_url)
181
+
) users in
182
+
(match matching_user with
183
+
| Some other when List.mem subtree affected_repos ->
184
+
Some { Changelog.source_handle = other.handle;
185
+
target_handle = handle;
186
+
repos = [subtree] }
187
+
| _ -> None)
188
+
| None -> None
189
+
) (Monopam.Sources_registry.to_list registry)
190
+
in
191
+
(* Merge: group by (source, target) pair *)
192
+
let all = forks @ reverse_forks in
193
+
let merged = Hashtbl.create 8 in
194
+
List.iter (fun (fc : Changelog.fork_context) ->
195
+
let key = (fc.source_handle, fc.target_handle) in
196
+
let existing = try Hashtbl.find merged key with Not_found -> [] in
197
+
Hashtbl.replace merged key (fc.repos @ existing)
198
+
) all;
199
+
Hashtbl.fold (fun (source_handle, target_handle) repos acc ->
200
+
let repos = List.sort_uniq String.compare repos in
201
+
{ Changelog.source_handle; target_handle; repos } :: acc
202
+
) merged []
203
+
139
204
(* Process a single verse user: pull, check HEAD, generate changelog if needed *)
140
-
let process_verse_user ~sw ~proc ~clock ~fs ~storage ~client ~config user =
205
+
let process_verse_user ~sw ~proc ~clock ~fs ~storage ~client ~config ~verse_path ~all_users user =
141
206
let handle = user.handle in
142
207
Log.info (fun m -> m "Checking %s for changes..." handle);
143
208
···
177
242
(* Get channel members for @mentions *)
178
243
let members = Changelog.get_channel_members ~client ~channel:config.Config.channel in
179
244
245
+
(* Detect fork relationships *)
246
+
let affected = Changelog.affected_subprojects commits in
247
+
let fork_context = detect_fork_context ~fs ~verse_path
248
+
~handle:user.handle ~affected_repos:affected all_users in
249
+
180
250
(* Generate narrative changelog with Claude *)
181
251
match Changelog.generate ~sw ~proc ~clock ~fs ~commits ~members
182
-
?opamrepo_path:user.opamrepo_path () with
252
+
~fork_context ?opamrepo_path:user.opamrepo_path () with
183
253
| None ->
184
254
Log.info (fun m -> m "[%s] No changelog generated" handle);
185
255
Option.iter (Admin.set_user_git_head storage ~handle) current_head
···
241
311
(* Process each user *)
242
312
List.iter (fun user ->
243
313
try
244
-
process_verse_user ~sw ~proc ~clock ~fs ~storage ~client ~config user
314
+
process_verse_user ~sw ~proc ~clock ~fs ~storage ~client ~config
315
+
~verse_path ~all_users:users user
245
316
with e ->
246
317
Log.warn (fun m -> m "[%s] Error processing user: %s"
247
318
user.handle (Printexc.to_string e))