anil.recoil.org
A Zulip bot agent to sit in our Black Sun. Ever evolving
Add structured JSON changelog output with repo links and verse support
- Changelog now uses JSON output from Claude with jsont decoding
- Each changelog item links to the project in the opam repo
- Output includes header with date of most recent commit
- Add verse multi-user support for tracking multiple monorepos
- Per-user git HEAD tracking for incremental broadcasts
- Status command shows tracked verse users with repo links
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+1
-1
bin/main.ml
+1
-1
bin/main.ml
···
148
let members = Poe.Changelog.get_channel_members ~client ~channel:poe_config.channel in
149
150
(* Generate narrative changelog with Claude *)
151
-
match Poe.Changelog.generate ~sw ~proc ~clock ~commits ~members with
152
| None ->
153
Logs.err (fun m -> m "Could not generate changelog")
154
| Some content ->
···
148
let members = Poe.Changelog.get_channel_members ~client ~channel:poe_config.channel in
149
150
(* Generate narrative changelog with Claude *)
151
+
match Poe.Changelog.generate ~sw ~proc ~clock ~commits ~members () with
152
| None ->
153
Logs.err (fun m -> m "Could not generate changelog")
154
| Some content ->
+13
lib/admin.ml
+13
lib/admin.ml
···
6
let last_broadcast_key = "poe:broadcast:last_time"
7
let last_git_head_key = "poe:broadcast:last_git_head"
8
9
let get_last_broadcast_time storage =
10
match Zulip_bot.Storage.get storage last_broadcast_key with
11
| None -> None
···
27
28
let set_last_git_head storage hash =
29
Zulip_bot.Storage.set storage last_git_head_key hash
30
31
let format_time_option = function
32
| None -> "never"
···
6
let last_broadcast_key = "poe:broadcast:last_time"
7
let last_git_head_key = "poe:broadcast:last_git_head"
8
9
+
(* Per-user git head keys for verse members *)
10
+
let user_git_head_key handle = Printf.sprintf "poe:broadcast:git_head:%s" handle
11
+
12
let get_last_broadcast_time storage =
13
match Zulip_bot.Storage.get storage last_broadcast_key with
14
| None -> None
···
30
31
let set_last_git_head storage hash =
32
Zulip_bot.Storage.set storage last_git_head_key hash
33
+
34
+
(* Per-user git HEAD tracking for verse members *)
35
+
let get_user_git_head storage ~handle =
36
+
match Zulip_bot.Storage.get storage (user_git_head_key handle) with
37
+
| None -> None
38
+
| Some s when s = "" -> None
39
+
| Some s -> Some s
40
+
41
+
let set_user_git_head storage ~handle hash =
42
+
Zulip_bot.Storage.set storage (user_git_head_key handle) hash
43
44
let format_time_option = function
45
| None -> "never"
+10
lib/admin.mli
+10
lib/admin.mli
···
32
val set_last_git_head : Zulip_bot.Storage.t -> string -> unit
33
(** [set_last_git_head storage hash] stores the git HEAD in storage. *)
34
35
+
(** {2 Per-User Git HEAD Tracking} *)
36
+
37
+
val get_user_git_head : Zulip_bot.Storage.t -> handle:string -> string option
38
+
(** [get_user_git_head storage ~handle] retrieves the last seen git HEAD
39
+
for a specific verse user. *)
40
+
41
+
val set_user_git_head : Zulip_bot.Storage.t -> handle:string -> string -> unit
42
+
(** [set_user_git_head storage ~handle hash] stores the git HEAD for a
43
+
specific verse user. *)
44
+
45
(** {1 Command Handlers} *)
46
47
val handle : storage:Zulip_bot.Storage.t -> Commands.admin_command -> string
+1
-1
lib/broadcast.ml
+1
-1
lib/broadcast.ml
···
40
let members = Changelog.get_channel_members ~client ~channel:config.Config.channel in
41
42
(* Generate narrative changelog with Claude *)
43
-
match Changelog.generate ~sw ~proc ~clock ~commits ~members with
44
| None ->
45
Zulip_bot.Response.reply "Could not generate changelog."
46
| Some content ->
···
40
let members = Changelog.get_channel_members ~client ~channel:config.Config.channel in
41
42
(* Generate narrative changelog with Claude *)
43
+
match Changelog.generate ~sw ~proc ~clock ~commits ~members () with
44
| None ->
45
Zulip_bot.Response.reply "Could not generate changelog."
46
| Some content ->
+103
-23
lib/changelog.ml
+103
-23
lib/changelog.ml
···
13
author: string;
14
email: string;
15
subject: string;
16
files: string list;
17
}
18
···
21
email: string;
22
}
23
24
let get_commit_files ~proc ~cwd ~hash =
25
let cmd = ["git"; "diff-tree"; "--no-commit-id"; "--name-only"; "-r"; hash] in
26
Log.debug (fun m -> m "Running: %s (in %s)" (String.concat " " cmd) (Eio.Path.native_exn cwd));
···
39
40
let get_git_log ~proc ~cwd ~since_head =
41
Log.info (fun m -> m "Getting commits since %s" since_head);
42
-
let cmd = ["git"; "log"; "--pretty=format:%h|%an|%ae|%s"; since_head ^ "..HEAD"] in
43
Log.debug (fun m -> m "Running: %s (in %s)" (String.concat " " cmd) (Eio.Path.native_exn cwd));
44
Eio.Switch.run @@ fun sw ->
45
let buf = Buffer.create 1024 in
···
55
String.split_on_char '\n' output
56
|> List.filter_map (fun line ->
57
match String.split_on_char '|' line with
58
-
| [hash; author; email; subject] ->
59
let files = get_commit_files ~proc ~cwd ~hash in
60
-
Some { hash; author; email; subject; files }
61
| _ -> None)
62
| _ -> []
63
64
let get_recent_commits ~proc ~cwd ~count =
65
Log.info (fun m -> m "Getting last %d commits" count);
66
-
let cmd = ["git"; "log"; "--pretty=format:%h|%an|%ae|%s"; "-n"; string_of_int count] in
67
Log.debug (fun m -> m "Running: %s (in %s)" (String.concat " " cmd) (Eio.Path.native_exn cwd));
68
Eio.Switch.run @@ fun sw ->
69
let buf = Buffer.create 1024 in
···
79
String.split_on_char '\n' output
80
|> List.filter_map (fun line ->
81
match String.split_on_char '|' line with
82
-
| [hash; author; email; subject] ->
83
let files = get_commit_files ~proc ~cwd ~hash in
84
-
Some { hash; author; email; subject; files }
85
| _ -> None)
86
| _ -> []
87
···
139
|> List.filter_map subproject_of_file
140
|> List.sort_uniq String.compare
141
142
-
let generate ~sw ~proc ~clock ~commits ~members =
143
if commits = [] then None
144
else begin
145
Log.info (fun m -> m "Generating narrative changelog with Claude for %d commits" (List.length commits));
···
179
180
%s
181
182
-
Write a bullet-point changelog. Each bullet should have the project name first in bold, then a brief description of the change, and the change type in italics at the end.
183
184
-
Format:
185
-
- **project-name**: Description of the change. *change type*
186
-
187
-
Example:
188
-
- **ocaml-claudeio**: Added model types for Opus 4.5 and 4.1. *new feature*
189
-
- **ocaml-zulip**: Fixed encoding bug in channel name lookups that affected names with spaces. *bug fix*
190
-
- **poe**: Updated to use the latest Opus model for changelog generation. *enhancement*
191
192
Guidelines:
193
-
1. One bullet per logical change (group related commits)
194
-
2. Project name in bold at the start
195
-
3. One or two sentences describing the change
196
-
4. Change type in italics at the end: *new feature*, *bug fix*, *enhancement*, *refactoring*, etc.
197
-
5. Use @**Name** mentions when authors match channel members
198
-
6. No emojis
199
200
-
Write ONLY the bullet points, no preamble or header.|} commits_text subprojects_text members_text
201
in
202
203
let response = ask_claude ~sw ~proc ~clock prompt in
204
Log.info (fun m -> m "Claude generated: %s" response);
205
-
Some (String.trim response)
206
end
···
13
author: string;
14
email: string;
15
subject: string;
16
+
date: string;
17
files: string list;
18
}
19
···
22
email: string;
23
}
24
25
+
type changelog_item = {
26
+
project: string;
27
+
description: string;
28
+
change_type: string;
29
+
}
30
+
31
+
type changelog_response = {
32
+
items: changelog_item list;
33
+
}
34
+
35
+
let changelog_item_codec : changelog_item Jsont.t =
36
+
Jsont.Object.map
37
+
~kind:"changelog_item"
38
+
(fun project description change_type -> { project; description; change_type })
39
+
|> Jsont.Object.mem "project" Jsont.string ~enc:(fun i -> i.project)
40
+
|> Jsont.Object.mem "description" Jsont.string ~enc:(fun i -> i.description)
41
+
|> Jsont.Object.mem "change_type" Jsont.string ~enc:(fun i -> i.change_type)
42
+
|> Jsont.Object.finish
43
+
44
+
let changelog_response_codec : changelog_response Jsont.t =
45
+
Jsont.Object.map
46
+
~kind:"changelog_response"
47
+
(fun items -> { items })
48
+
|> Jsont.Object.mem "items" (Jsont.list changelog_item_codec) ~enc:(fun r -> r.items)
49
+
|> Jsont.Object.finish
50
+
51
let get_commit_files ~proc ~cwd ~hash =
52
let cmd = ["git"; "diff-tree"; "--no-commit-id"; "--name-only"; "-r"; hash] in
53
Log.debug (fun m -> m "Running: %s (in %s)" (String.concat " " cmd) (Eio.Path.native_exn cwd));
···
66
67
let get_git_log ~proc ~cwd ~since_head =
68
Log.info (fun m -> m "Getting commits since %s" since_head);
69
+
let cmd = ["git"; "log"; "--pretty=format:%h|%an|%ae|%s|%ci"; since_head ^ "..HEAD"] in
70
Log.debug (fun m -> m "Running: %s (in %s)" (String.concat " " cmd) (Eio.Path.native_exn cwd));
71
Eio.Switch.run @@ fun sw ->
72
let buf = Buffer.create 1024 in
···
82
String.split_on_char '\n' output
83
|> List.filter_map (fun line ->
84
match String.split_on_char '|' line with
85
+
| [hash; author; email; subject; date] ->
86
let files = get_commit_files ~proc ~cwd ~hash in
87
+
Some { hash; author; email; subject; date; files }
88
| _ -> None)
89
| _ -> []
90
91
let get_recent_commits ~proc ~cwd ~count =
92
Log.info (fun m -> m "Getting last %d commits" count);
93
+
let cmd = ["git"; "log"; "--pretty=format:%h|%an|%ae|%s|%ci"; "-n"; string_of_int count] in
94
Log.debug (fun m -> m "Running: %s (in %s)" (String.concat " " cmd) (Eio.Path.native_exn cwd));
95
Eio.Switch.run @@ fun sw ->
96
let buf = Buffer.create 1024 in
···
106
String.split_on_char '\n' output
107
|> List.filter_map (fun line ->
108
match String.split_on_char '|' line with
109
+
| [hash; author; email; subject; date] ->
110
let files = get_commit_files ~proc ~cwd ~hash in
111
+
Some { hash; author; email; subject; date; files }
112
| _ -> None)
113
| _ -> []
114
···
166
|> List.filter_map subproject_of_file
167
|> List.sort_uniq String.compare
168
169
+
(* Get most recent commit date from a list of commits *)
170
+
let most_recent_date commits =
171
+
match commits with
172
+
| [] -> None
173
+
| commits ->
174
+
let dates = List.map (fun c -> c.date) commits in
175
+
(* Dates are in ISO format, so string comparison works *)
176
+
Some (List.fold_left max "" dates)
177
+
178
+
(* Extract just the date part from git date string (YYYY-MM-DD from "YYYY-MM-DD HH:MM:SS +ZZZZ") *)
179
+
let date_only s =
180
+
match String.split_on_char ' ' s with
181
+
| d :: _ -> d
182
+
| [] -> s
183
+
184
+
(* Parse JSON response from Claude, with fallback to raw text *)
185
+
let parse_changelog_json json_str =
186
+
match Jsont_bytesrw.decode_string changelog_response_codec json_str with
187
+
| Ok response -> Ok response.items
188
+
| Error e ->
189
+
Log.warn (fun m -> m "Failed to parse JSON response: %s" e);
190
+
Error e
191
+
192
+
(* Format a changelog item as a markdown bullet with repo link *)
193
+
let format_item ~opamrepo_url item =
194
+
let project_link = match opamrepo_url with
195
+
| Some url ->
196
+
(* Link to the package in the opam repo: url/packages/project *)
197
+
Printf.sprintf "[%s](%s/packages/%s)" item.project url item.project
198
+
| None -> item.project
199
+
in
200
+
Printf.sprintf "- **%s**: %s *%s*" project_link item.description item.change_type
201
+
202
+
let generate ~sw ~proc ~clock ~commits ~members ?opamrepo_url () =
203
if commits = [] then None
204
else begin
205
Log.info (fun m -> m "Generating narrative changelog with Claude for %d commits" (List.length commits));
···
239
240
%s
241
242
+
Write a changelog as a JSON object with an "items" array. Each item should have:
243
+
- "project": the project/package name (string)
244
+
- "description": description of the change, may include @**Name** mentions (string)
245
+
- "change_type": one of "new feature", "bug fix", "enhancement", "refactoring", "documentation", etc. (string)
246
247
+
Example output:
248
+
```json
249
+
{
250
+
"items": [
251
+
{"project": "ocaml-claudeio", "description": "Added model types for Opus 4.5 and 4.1.", "change_type": "new feature"},
252
+
{"project": "ocaml-zulip", "description": "Fixed encoding bug in channel name lookups that affected names with spaces.", "change_type": "bug fix"}
253
+
]
254
+
}
255
+
```
256
257
Guidelines:
258
+
1. One item per logical change (group related commits)
259
+
2. One or two sentences for the description
260
+
3. Use @**Name** mentions in the description when authors match channel members
261
+
4. No emojis
262
263
+
Output ONLY the JSON object, no markdown code fences or other text.|} commits_text subprojects_text members_text
264
in
265
266
let response = ask_claude ~sw ~proc ~clock prompt in
267
Log.info (fun m -> m "Claude generated: %s" response);
268
+
269
+
(* Parse JSON and format with links *)
270
+
match parse_changelog_json (String.trim response) with
271
+
| Ok items ->
272
+
let last_date = most_recent_date commits in
273
+
let header = match last_date with
274
+
| Some d -> Printf.sprintf "**Changes as of %s**\n\n" (date_only d)
275
+
| None -> ""
276
+
in
277
+
let formatted = items
278
+
|> List.map (format_item ~opamrepo_url)
279
+
|> String.concat "\n"
280
+
in
281
+
Some (header ^ formatted)
282
+
| Error _ ->
283
+
(* Fallback: return raw response if JSON parsing fails *)
284
+
Log.warn (fun m -> m "Using raw Claude response as fallback");
285
+
Some (String.trim response)
286
end
+10
-6
lib/changelog.mli
+10
-6
lib/changelog.mli
···
16
author: string;
17
email: string;
18
subject: string;
19
files: string list;
20
}
21
-
(** A git commit with metadata and list of changed files. *)
22
23
type channel_member = {
24
full_name: string;
···
60
clock:float Eio.Time.clock_ty Eio.Resource.t ->
61
commits:commit list ->
62
members:channel_member list ->
63
string option
64
-
(** [generate ~sw ~proc ~clock ~commits ~members] generates a bullet-point
65
-
changelog using Claude. Returns [None] if commits is empty, or
66
-
[Some changelog] with the generated text.
67
68
-
Each bullet has the project name in bold, a description of the change,
69
-
and the change type in italics (e.g. "new feature", "bug fix").
70
Zulip @-mentions are used for authors matching channel members. *)
···
16
author: string;
17
email: string;
18
subject: string;
19
+
date: string;
20
files: string list;
21
}
22
+
(** A git commit with metadata, date, and list of changed files. *)
23
24
type channel_member = {
25
full_name: string;
···
61
clock:float Eio.Time.clock_ty Eio.Resource.t ->
62
commits:commit list ->
63
members:channel_member list ->
64
+
?opamrepo_url:string ->
65
+
unit ->
66
string option
67
+
(** [generate ~sw ~proc ~clock ~commits ~members ?opamrepo_url ()] generates a
68
+
bullet-point changelog using Claude. Returns [None] if commits is empty,
69
+
or [Some changelog] with the generated text.
70
71
+
Each bullet has the project name (linked to the opam repo if [opamrepo_url]
72
+
is provided), a description of the change, and the change type in italics.
73
+
The output includes a header with the date of the most recent commit.
74
Zulip @-mentions are used for authors matching channel members. *)
+5
-2
lib/config.ml
+5
-2
lib/config.ml
···
10
monorepo_path : string;
11
admin_emails : string list;
12
changes_dir : string;
13
}
14
15
let default = {
···
19
monorepo_path = ".";
20
admin_emails = [];
21
changes_dir = ".changes";
22
}
23
24
let codec =
25
Tomlt.(
26
Table.(
27
-
obj (fun channel topic changes_file monorepo_path admin_emails changes_dir ->
28
-
{ channel; topic; changes_file; monorepo_path; admin_emails; changes_dir })
29
|> mem "channel" string ~dec_absent:default.channel
30
~enc:(fun c -> c.channel)
31
|> mem "topic" string ~dec_absent:default.topic ~enc:(fun c -> c.topic)
···
37
~enc:(fun c -> c.admin_emails)
38
|> mem "changes_dir" string ~dec_absent:default.changes_dir
39
~enc:(fun c -> c.changes_dir)
40
|> finish))
41
42
let load_from_path path =
···
10
monorepo_path : string;
11
admin_emails : string list;
12
changes_dir : string;
13
+
verse_path : string option; (* Path to verse/ directory containing user monorepos *)
14
}
15
16
let default = {
···
20
monorepo_path = ".";
21
admin_emails = [];
22
changes_dir = ".changes";
23
+
verse_path = None;
24
}
25
26
let codec =
27
Tomlt.(
28
Table.(
29
+
obj (fun channel topic changes_file monorepo_path admin_emails changes_dir verse_path ->
30
+
{ channel; topic; changes_file; monorepo_path; admin_emails; changes_dir; verse_path })
31
|> mem "channel" string ~dec_absent:default.channel
32
~enc:(fun c -> c.channel)
33
|> mem "topic" string ~dec_absent:default.topic ~enc:(fun c -> c.topic)
···
39
~enc:(fun c -> c.admin_emails)
40
|> mem "changes_dir" string ~dec_absent:default.changes_dir
41
~enc:(fun c -> c.changes_dir)
42
+
|> opt_mem "verse_path" string ~enc:(fun c -> c.verse_path)
43
|> finish))
44
45
let load_from_path path =
+2
lib/config.mli
+2
lib/config.mli
···
17
monorepo_path = "."
18
changes_dir = ".changes"
19
admin_emails = ["admin@example.com"]
20
v} *)
21
22
type t = {
···
26
monorepo_path : string; (** Path to the monorepo root *)
27
admin_emails : string list; (** Emails authorized for admin commands *)
28
changes_dir : string; (** Directory for aggregated JSON files *)
29
}
30
31
val default : t
···
17
monorepo_path = "."
18
changes_dir = ".changes"
19
admin_emails = ["admin@example.com"]
20
+
verse_path = "/path/to/verse"
21
v} *)
22
23
type t = {
···
27
monorepo_path : string; (** Path to the monorepo root *)
28
admin_emails : string list; (** Emails authorized for admin commands *)
29
changes_dir : string; (** Directory for aggregated JSON files *)
30
+
verse_path : string option; (** Path to verse/ directory containing user monorepos *)
31
}
32
33
val default : t
+1
-1
lib/dune
+1
-1
lib/dune
+51
-8
lib/handler.ml
+51
-8
lib/handler.ml
···
88
89
**Basic Commands:**
90
- `help` or `?` - Show this help message
91
-
- `status` - Show bot configuration status
92
- `broadcast` / `post` / `changes` - Generate and broadcast changelog with Claude
93
- `refresh` / `pull` / `sync` / `update` - Pull from remote and broadcast changes
94
···
106
The bot reads its configuration from `poe.toml` with the following fields:
107
- `channel` - The Zulip channel to broadcast to
108
- `topic` - The topic for broadcast messages
109
-
- `monorepo_path` - Path to the monorepo root
110
- `admin_emails` - List of emails authorized for admin commands|}
111
112
-
let handle_status config =
113
let admin_list = if config.Config.admin_emails = [] then "none configured"
114
else String.concat ", " config.Config.admin_emails
115
in
116
Zulip_bot.Response.reply
117
(Printf.sprintf
118
{|**Poe Bot Status:**
119
120
- Channel: `%s`
121
- Topic: `%s`
122
-
- Monorepo path: `%s`
123
-
- Admin emails: %s|}
124
config.Config.channel config.Config.topic
125
-
config.Config.monorepo_path admin_list)
126
127
let handle_refresh env ~client ~storage ~config =
128
let monorepo_path = Eio.Path.(env.fs / config.Config.monorepo_path) in
···
153
let members = Changelog.get_channel_members ~client ~channel:config.Config.channel in
154
155
(* Generate narrative changelog with Claude *)
156
-
match Changelog.generate ~sw:env.sw ~proc:env.process_mgr ~clock:env.clock ~commits ~members with
157
| None ->
158
Zulip_bot.Response.reply
159
(Printf.sprintf "**Refresh completed:**\n\n- %s\n- Could not generate changelog" pull_msg)
···
223
Log.info (fun m -> m "Received message: %s" content);
224
match Commands.parse content with
225
| Commands.Help -> handle_help ()
226
-
| Commands.Status -> handle_status config
227
| Commands.Broadcast ->
228
Broadcast.run ~sw:env.sw ~proc:env.process_mgr ~clock:env.clock
229
~fs:env.fs ~client ~storage ~config
···
88
89
**Basic Commands:**
90
- `help` or `?` - Show this help message
91
+
- `status` - Show bot configuration and tracked verse users with repo links
92
- `broadcast` / `post` / `changes` - Generate and broadcast changelog with Claude
93
- `refresh` / `pull` / `sync` / `update` - Pull from remote and broadcast changes
94
···
106
The bot reads its configuration from `poe.toml` with the following fields:
107
- `channel` - The Zulip channel to broadcast to
108
- `topic` - The topic for broadcast messages
109
+
- `verse_path` - Path to verse/ directory containing user monorepos
110
- `admin_emails` - List of emails authorized for admin commands|}
111
112
+
(* Load verse registry and get tracked users with their repo URLs *)
113
+
let get_verse_status ~fs ~verse_path =
114
+
let registry_path = Monopam.Verse_config.registry_path () in
115
+
let registry_toml = Fpath.(registry_path / "opamverse.toml") in
116
+
match Monopam.Verse_registry.load ~fs registry_toml with
117
+
| Error msg ->
118
+
Log.warn (fun m -> m "Failed to load registry: %s" msg);
119
+
[]
120
+
| Ok registry ->
121
+
(* Scan verse directory for user subdirectories *)
122
+
let verse_eio = Eio.Path.(fs / verse_path) in
123
+
let subdirs = try
124
+
Eio.Path.read_dir verse_eio
125
+
|> List.filter (fun name ->
126
+
not (String.starts_with ~prefix:"." name) &&
127
+
not (String.ends_with ~suffix:"-opam" name))
128
+
with Eio.Io _ -> []
129
+
in
130
+
(* Match each subdirectory with registry member *)
131
+
List.filter_map (fun handle ->
132
+
match Monopam.Verse_registry.find_member registry ~handle with
133
+
| Some member -> Some (handle, member.monorepo, member.opamrepo)
134
+
| None -> None
135
+
) subdirs
136
+
137
+
let handle_status env config =
138
let admin_list = if config.Config.admin_emails = [] then "none configured"
139
else String.concat ", " config.Config.admin_emails
140
in
141
+
let verse_path = match config.Config.verse_path with
142
+
| Some vp -> vp
143
+
| None ->
144
+
let mono_dir = Filename.dirname config.Config.monorepo_path in
145
+
Filename.concat mono_dir "verse"
146
+
in
147
+
let verse_users = get_verse_status ~fs:env.fs ~verse_path in
148
+
let users_section = if verse_users = [] then
149
+
"- Tracked verse users: none"
150
+
else
151
+
"- Tracked verse users:\n" ^
152
+
(verse_users
153
+
|> List.map (fun (handle, mono_url, opam_url) ->
154
+
Printf.sprintf " - **%s**: [monorepo](%s) | [opam-repo](%s)"
155
+
handle mono_url opam_url)
156
+
|> String.concat "\n")
157
+
in
158
Zulip_bot.Response.reply
159
(Printf.sprintf
160
{|**Poe Bot Status:**
161
162
- Channel: `%s`
163
- Topic: `%s`
164
+
- Verse path: `%s`
165
+
- Admin emails: %s
166
+
%s|}
167
config.Config.channel config.Config.topic
168
+
verse_path admin_list users_section)
169
170
let handle_refresh env ~client ~storage ~config =
171
let monorepo_path = Eio.Path.(env.fs / config.Config.monorepo_path) in
···
196
let members = Changelog.get_channel_members ~client ~channel:config.Config.channel in
197
198
(* Generate narrative changelog with Claude *)
199
+
match Changelog.generate ~sw:env.sw ~proc:env.process_mgr ~clock:env.clock ~commits ~members () with
200
| None ->
201
Zulip_bot.Response.reply
202
(Printf.sprintf "**Refresh completed:**\n\n- %s\n- Could not generate changelog" pull_msg)
···
266
Log.info (fun m -> m "Received message: %s" content);
267
match Commands.parse content with
268
| Commands.Help -> handle_help ()
269
+
| Commands.Status -> handle_status env config
270
| Commands.Broadcast ->
271
Broadcast.run ~sw:env.sw ~proc:env.process_mgr ~clock:env.clock
272
~fs:env.fs ~client ~storage ~config
+159
-60
lib/loop.ml
+159
-60
lib/loop.ml
···
6
let src = Logs.Src.create "poe.loop" ~doc:"Poe polling loop"
7
module Log = (val Logs.src_log src : Logs.LOG)
8
9
let run_command ~proc ~cwd cmd =
10
let cwd_str = Eio.Path.native_exn cwd in
11
Log.debug (fun m -> m "Running: %s (in %s)" (String.concat " " cmd) cwd_str);
···
17
~stderr:(Eio.Flow.buffer_sink buf_stderr)
18
cmd
19
in
20
let stdout = Buffer.contents buf_stdout in
21
let stderr = Buffer.contents buf_stderr in
22
-
match Eio.Process.await child with
23
| `Exited code -> (code, stdout, stderr)
24
| `Signaled sig_ -> (-sig_, stdout, stderr)
25
···
55
let resp = Zulip.Messages.send client msg in
56
Log.info (fun m -> m "Broadcast sent, message ID: %d" (Zulip.Message_response.id resp))
57
58
let run ~sw ~env ~config ~zulip_config ~handler ~interval =
59
let fs = Eio.Stdenv.fs env in
60
let proc = Eio.Stdenv.process_mgr env in
···
64
let client = Zulip_bot.Bot.create_client ~sw ~env ~config:zulip_config in
65
let storage = Zulip_bot.Storage.create client in
66
67
-
let monorepo_path = Eio.Path.(fs / config.Config.monorepo_path) in
68
-
let monorepo_native = Eio.Path.native_exn monorepo_path in
69
70
-
Log.info (fun m -> m "Starting loop with %d second interval" interval);
71
-
Log.info (fun m -> m "Monorepo path: %s" monorepo_native);
72
73
let broadcast_loop () =
74
let rec loop () =
75
-
Log.info (fun m -> m "Checking for changes...");
76
77
-
(* Pull latest changes from remote *)
78
-
let _pull_ok = run_git_pull ~proc ~cwd:monorepo_path in
79
80
-
(* Get current git HEAD *)
81
-
let current_head = get_git_head ~proc ~cwd:monorepo_path in
82
-
let last_head = Admin.get_last_git_head storage in
83
-
84
-
Log.info (fun m -> m "Current HEAD: %s, Last HEAD: %s"
85
-
(Option.value ~default:"(none)" current_head)
86
-
(Option.value ~default:"(none)" last_head));
87
-
88
-
(* Check if HEAD has changed *)
89
-
let head_changed = match (current_head, last_head) with
90
-
| (Some c, Some l) -> c <> l
91
-
| (Some _, None) -> true (* First run *)
92
-
| _ -> false
93
-
in
94
-
95
-
if head_changed then begin
96
-
Log.info (fun m -> m "Git HEAD changed, generating changes...");
97
-
98
-
(* Get commits since last HEAD *)
99
-
let commits = match last_head with
100
-
| Some h -> Changelog.get_git_log ~proc ~cwd:monorepo_path ~since_head:h
101
-
| None -> [] (* First run, don't broadcast everything *)
102
-
in
103
-
104
-
if commits = [] then begin
105
-
Log.info (fun m -> m "No commits to broadcast");
106
-
(* Still update HEAD so we don't reprocess *)
107
-
Option.iter (Admin.set_last_git_head storage) current_head
108
-
end
109
-
else begin
110
-
(* Get channel members for @mentions *)
111
-
let members = Changelog.get_channel_members ~client ~channel:config.Config.channel in
112
-
113
-
(* Generate narrative changelog with Claude *)
114
-
match Changelog.generate ~sw ~proc ~clock ~commits ~members with
115
-
| None ->
116
-
Log.info (fun m -> m "No changelog generated");
117
-
Option.iter (Admin.set_last_git_head storage) current_head
118
-
| Some content ->
119
-
Log.info (fun m -> m "Broadcasting narrative changelog");
120
-
send_message ~client ~stream:config.Config.channel
121
-
~topic:config.Config.topic ~content;
122
-
123
-
(* Update storage *)
124
-
let now = Ptime_clock.now () in
125
-
Admin.set_last_broadcast_time storage now;
126
-
Option.iter (Admin.set_last_git_head storage) current_head;
127
-
Log.info (fun m -> m "Updated broadcast time and git HEAD")
128
-
end
129
-
end
130
-
else
131
-
Log.debug (fun m -> m "No HEAD change, skipping");
132
133
(* Sleep until next check *)
134
Log.info (fun m -> m "Sleeping for %d seconds" interval);
···
6
let src = Logs.Src.create "poe.loop" ~doc:"Poe polling loop"
7
module Log = (val Logs.src_log src : Logs.LOG)
8
9
+
(* Verse user info for iteration *)
10
+
type verse_user = {
11
+
handle : string;
12
+
monorepo_path : Eio.Fs.dir_ty Eio.Path.t;
13
+
monorepo_url : string;
14
+
opamrepo_url : string;
15
+
}
16
+
17
+
(* Load the opamverse registry from XDG data path *)
18
+
let load_registry ~fs =
19
+
let registry_path = Monopam.Verse_config.registry_path () in
20
+
let registry_toml = Fpath.(registry_path / "opamverse.toml") in
21
+
Monopam.Verse_registry.load ~fs registry_toml
22
+
23
+
(* Get list of verse users by scanning verse directory and matching with registry *)
24
+
let get_verse_users ~fs ~verse_path =
25
+
match load_registry ~fs with
26
+
| Error msg ->
27
+
Log.warn (fun m -> m "Failed to load registry: %s" msg);
28
+
[]
29
+
| Ok registry ->
30
+
(* Scan verse directory for user subdirectories *)
31
+
let verse_eio = Eio.Path.(fs / verse_path) in
32
+
let subdirs = try
33
+
Eio.Path.read_dir verse_eio
34
+
|> List.filter (fun name ->
35
+
(* Filter out -opam directories and hidden files *)
36
+
not (String.starts_with ~prefix:"." name) &&
37
+
not (String.ends_with ~suffix:"-opam" name))
38
+
with Eio.Io _ ->
39
+
Log.warn (fun m -> m "Failed to read verse directory: %s" verse_path);
40
+
[]
41
+
in
42
+
(* Match each subdirectory with registry member *)
43
+
List.filter_map (fun handle ->
44
+
match Monopam.Verse_registry.find_member registry ~handle with
45
+
| Some member ->
46
+
let mono_path = Eio.Path.(verse_eio / handle) in
47
+
(* Check if it's actually a git repo *)
48
+
let is_repo = try
49
+
match Eio.Path.kind ~follow:true Eio.Path.(mono_path / ".git") with
50
+
| `Directory -> true
51
+
| _ -> false
52
+
with _ -> false
53
+
in
54
+
if is_repo then
55
+
Some {
56
+
handle;
57
+
monorepo_path = mono_path;
58
+
monorepo_url = member.monorepo;
59
+
opamrepo_url = member.opamrepo;
60
+
}
61
+
else begin
62
+
Log.debug (fun m -> m "Skipping %s: not a git repo" handle);
63
+
None
64
+
end
65
+
| None ->
66
+
Log.debug (fun m -> m "Skipping %s: not in registry" handle);
67
+
None
68
+
) subdirs
69
+
70
let run_command ~proc ~cwd cmd =
71
let cwd_str = Eio.Path.native_exn cwd in
72
Log.debug (fun m -> m "Running: %s (in %s)" (String.concat " " cmd) cwd_str);
···
78
~stderr:(Eio.Flow.buffer_sink buf_stderr)
79
cmd
80
in
81
+
(* Must await process before reading buffers *)
82
+
let status = Eio.Process.await child in
83
let stdout = Buffer.contents buf_stdout in
84
let stderr = Buffer.contents buf_stderr in
85
+
match status with
86
| `Exited code -> (code, stdout, stderr)
87
| `Signaled sig_ -> (-sig_, stdout, stderr)
88
···
118
let resp = Zulip.Messages.send client msg in
119
Log.info (fun m -> m "Broadcast sent, message ID: %d" (Zulip.Message_response.id resp))
120
121
+
(* Process a single verse user: pull, check HEAD, generate changelog if needed *)
122
+
let process_verse_user ~sw ~proc ~clock ~storage ~client ~config user =
123
+
let handle = user.handle in
124
+
Log.info (fun m -> m "Checking %s for changes..." handle);
125
+
126
+
(* Pull latest changes from remote *)
127
+
let _pull_ok = run_git_pull ~proc ~cwd:user.monorepo_path in
128
+
129
+
(* Get current git HEAD *)
130
+
let current_head = get_git_head ~proc ~cwd:user.monorepo_path in
131
+
let last_head = Admin.get_user_git_head storage ~handle in
132
+
133
+
Log.info (fun m -> m "[%s] Current HEAD: %s, Last HEAD: %s" handle
134
+
(Option.value ~default:"(none)" current_head)
135
+
(Option.value ~default:"(none)" last_head));
136
+
137
+
(* Check if HEAD has changed *)
138
+
let head_changed = match (current_head, last_head) with
139
+
| (Some c, Some l) -> c <> l
140
+
| (Some _, None) -> true (* First run for this user *)
141
+
| _ -> false
142
+
in
143
+
144
+
if head_changed then begin
145
+
Log.info (fun m -> m "[%s] Git HEAD changed, generating changes..." handle);
146
+
147
+
(* Get commits since last HEAD, or last 25 on first run *)
148
+
let commits = match last_head with
149
+
| Some h -> Changelog.get_git_log ~proc ~cwd:user.monorepo_path ~since_head:h
150
+
| None -> Changelog.get_recent_commits ~proc ~cwd:user.monorepo_path ~count:25
151
+
in
152
+
153
+
if commits = [] then begin
154
+
Log.info (fun m -> m "[%s] No commits to broadcast" handle);
155
+
(* Still update HEAD so we don't reprocess *)
156
+
Option.iter (Admin.set_user_git_head storage ~handle) current_head
157
+
end
158
+
else begin
159
+
(* Get channel members for @mentions *)
160
+
let members = Changelog.get_channel_members ~client ~channel:config.Config.channel in
161
+
162
+
(* Generate narrative changelog with Claude *)
163
+
match Changelog.generate ~sw ~proc ~clock ~commits ~members
164
+
~opamrepo_url:user.opamrepo_url () with
165
+
| None ->
166
+
Log.info (fun m -> m "[%s] No changelog generated" handle);
167
+
Option.iter (Admin.set_user_git_head storage ~handle) current_head
168
+
| Some changelog_content ->
169
+
Log.info (fun m -> m "[%s] Broadcasting narrative changelog" handle);
170
+
171
+
(* Format the broadcast with repo hrefs *)
172
+
let content = Printf.sprintf
173
+
{|**Updates from %s**
174
+
175
+
Repos: [monorepo](%s) | [opam-repo](%s)
176
+
177
+
%s|}
178
+
handle user.monorepo_url user.opamrepo_url changelog_content
179
+
in
180
+
181
+
send_message ~client ~stream:config.Config.channel
182
+
~topic:config.Config.topic ~content;
183
+
184
+
(* Update storage with per-user HEAD *)
185
+
let now = Ptime_clock.now () in
186
+
Admin.set_last_broadcast_time storage now;
187
+
Option.iter (Admin.set_user_git_head storage ~handle) current_head;
188
+
Log.info (fun m -> m "[%s] Updated broadcast time and git HEAD" handle)
189
+
end
190
+
end
191
+
else
192
+
Log.debug (fun m -> m "[%s] No HEAD change, skipping" handle)
193
+
194
let run ~sw ~env ~config ~zulip_config ~handler ~interval =
195
let fs = Eio.Stdenv.fs env in
196
let proc = Eio.Stdenv.process_mgr env in
···
200
let client = Zulip_bot.Bot.create_client ~sw ~env ~config:zulip_config in
201
let storage = Zulip_bot.Storage.create client in
202
203
+
Log.info (fun m -> m "Starting loop with %d second interval" interval);
204
205
+
(* Determine verse path - use config.verse_path if set, otherwise derive from monorepo_path *)
206
+
let verse_path = match config.Config.verse_path with
207
+
| Some vp -> vp
208
+
| None ->
209
+
(* Assume verse/ is a sibling of monorepo_path's parent *)
210
+
let mono_dir = Filename.dirname config.Config.monorepo_path in
211
+
Filename.concat mono_dir "verse"
212
+
in
213
+
Log.info (fun m -> m "Verse path: %s" verse_path);
214
215
let broadcast_loop () =
216
let rec loop () =
217
+
Log.info (fun m -> m "Checking for changes across verse users...");
218
219
+
(* Get all verse users *)
220
+
let users = get_verse_users ~fs ~verse_path in
221
+
Log.info (fun m -> m "Found %d verse users" (List.length users));
222
223
+
(* Process each user *)
224
+
List.iter (fun user ->
225
+
try
226
+
process_verse_user ~sw ~proc ~clock ~storage ~client ~config user
227
+
with e ->
228
+
Log.warn (fun m -> m "[%s] Error processing user: %s"
229
+
user.handle (Printexc.to_string e))
230
+
) users;
231
232
(* Sleep until next check *)
233
Log.info (fun m -> m "Sleeping for %d seconds" interval);