anil.recoil.org
OCaml HTML5 parser/serialiser based on Python's JustHTML
Squashed 'poe/' changes from 9f0d328..c1a05c5
c1a05c5 merge
ce614c3 Merge commit 'd21c464c038210a433179514689f24b6d722dbef'
5c4bfb8 Change poe changelog to bullet points with project and change type
678fc01 Use natural prose for poe changelog, tag sub-projects per change
fc33f91 Structure poe broadcast output with sub-projects and change categories
5868525 Add Opus 4.5 and 4.1 model types, use Opus 4.5 in poe
18efb6f Replace monopam changelog generation with Claude-powered narratives
010c4ce Run message handler concurrently with broadcast loop in poe
b813055 fix
5253efb Add refresh command to poe bot for manual git pull and broadcast
8292e68 Merge monopam_changes into monopam library and update poe
7705a06 Skip past days with existing files, verify admin via delivery_email
a77ba9a bot improvements
db618c5 Add changes broadcast system with monopam_changes library and poe enhancements
git-subtree-dir: poe
git-subtree-split: c1a05c5b856b29c5470d4f0c3dde5912c4fae4b5
+140
-31
bin/main.ml
+140
-31
bin/main.ml
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
-
let setup_logging style_renderer level =
6
+
(* Log source prefixes for requests library - disabled by default to reduce noise *)
7
+
let requests_src_prefix = "requests"
8
+
9
+
let setup_logging style_renderer level ~requests_verbose =
7
10
Fmt_tty.setup_std_outputs ?style_renderer ();
8
11
Logs.set_level level;
9
-
Logs.set_reporter (Logs_fmt.reporter ())
12
+
Logs.set_reporter (Logs_fmt.reporter ());
13
+
(* Disable requests logging by default unless explicitly enabled *)
14
+
if not requests_verbose then
15
+
List.iter (fun src ->
16
+
let name = Logs.Src.name src in
17
+
if String.length name >= String.length requests_src_prefix &&
18
+
String.sub name 0 (String.length requests_src_prefix) = requests_src_prefix then
19
+
Logs.Src.set_level src (Some Logs.Warning)
20
+
) (Logs.Src.list ())
10
21
11
22
let run_bot bot_name config_file =
12
23
Eio_main.run @@ fun env ->
···
16
27
let clock = Eio.Stdenv.clock env in
17
28
18
29
(* Load poe config: explicit path > XDG > current dir > defaults *)
19
-
let poe_config =
30
+
let poe_config, config_source =
20
31
match config_file with
21
-
| Some path -> Poe.Config.load ~fs path
32
+
| Some path -> (Poe.Config.load ~fs path, Printf.sprintf "explicit path: %s" path)
22
33
| None -> (
23
34
match Poe.Config.load_xdg_opt ~fs with
24
-
| Some c -> c
35
+
| Some c -> (c, "XDG config (~/.config/poe/config.toml)")
25
36
| None -> (
26
37
match Poe.Config.load_opt ~fs "poe.toml" with
27
-
| Some c -> c
28
-
| None -> Poe.Config.default))
38
+
| Some c -> (c, "current directory (poe.toml)")
39
+
| None -> (Poe.Config.default, "built-in defaults")))
29
40
in
30
41
42
+
Logs.info (fun m -> m "Poe config loaded from %s" config_source);
43
+
Logs.info (fun m -> m " Channel: %s, Topic: %s" poe_config.channel poe_config.topic);
44
+
Logs.info (fun m -> m " Monorepo: %s, Changes dir: %s" poe_config.monorepo_path poe_config.changes_dir);
45
+
let admin_count = List.length poe_config.admin_emails in
46
+
if admin_count > 0 then
47
+
Logs.info (fun m -> m " Admin users: %d configured (%s)" admin_count
48
+
(String.concat ", " poe_config.admin_emails))
49
+
else
50
+
Logs.info (fun m -> m " Admin users: none configured");
51
+
31
52
(* Load zulip bot config from poe's XDG directory *)
32
53
let zulip_config = Zulip_bot.Config.load_or_env ~xdg_app:"poe" ~fs bot_name in
33
54
···
38
59
39
60
(* Create and run the bot *)
40
61
let handler = Poe.Handler.make_handler handler_env poe_config in
41
-
Logs.info (fun m ->
42
-
m "Starting Poe bot, broadcasting to %s/%s" poe_config.channel
43
-
poe_config.topic);
62
+
Logs.info (fun m -> m "Starting Poe bot...");
44
63
Zulip_bot.Bot.run ~sw ~env ~config:zulip_config ~handler
45
64
65
+
let requests_verbose_arg =
66
+
let open Cmdliner in
67
+
Arg.(
68
+
value
69
+
& flag
70
+
& info [ "requests-verbose" ]
71
+
~doc:"Enable verbose HTTP request logging (disabled by default).")
72
+
46
73
let run_cmd =
47
74
let open Cmdliner in
48
75
let bot_name =
···
59
86
& info [ "c"; "config" ] ~docv:"FILE"
60
87
~doc:"Path to poe.toml configuration file.")
61
88
in
62
-
let run style_renderer level bot_name config_file =
63
-
setup_logging style_renderer level;
89
+
let run style_renderer level requests_verbose bot_name config_file =
90
+
setup_logging style_renderer level ~requests_verbose;
64
91
run_bot bot_name config_file
65
92
in
66
93
let doc = "Run the Poe Zulip bot" in
67
94
let info = Cmd.info "run" ~doc in
68
95
Cmd.v info
69
96
Term.(
70
-
const run $ Fmt_cli.style_renderer () $ Logs_cli.level () $ bot_name
71
-
$ config_file)
97
+
const run $ Fmt_cli.style_renderer () $ Logs_cli.level ()
98
+
$ requests_verbose_arg $ bot_name $ config_file)
72
99
73
100
let broadcast_cmd =
74
101
let open Cmdliner in
···
86
113
& info [ "n"; "name" ] ~docv:"NAME"
87
114
~doc:"Bot name for Zulip configuration lookup.")
88
115
in
89
-
let broadcast style_renderer level config_file bot_name =
90
-
setup_logging style_renderer level;
116
+
let broadcast style_renderer level requests_verbose config_file bot_name =
117
+
setup_logging style_renderer level ~requests_verbose;
91
118
Eio_main.run @@ fun env ->
92
119
Eio.Switch.run @@ fun sw ->
93
120
let fs = Eio.Stdenv.fs env in
121
+
let proc = Eio.Stdenv.process_mgr env in
122
+
let clock = Eio.Stdenv.clock env in
94
123
95
124
(* Load poe config: explicit path > XDG > current dir > defaults *)
96
125
let poe_config =
···
107
136
108
137
let zulip_config = Zulip_bot.Config.load_or_env ~xdg_app:"poe" ~fs bot_name in
109
138
let client = Zulip_bot.Bot.create_client ~sw ~env ~config:zulip_config in
139
+
let monorepo_path = Eio.Path.(fs / poe_config.monorepo_path) in
140
+
141
+
(* Get recent commits *)
142
+
let commits = Poe.Changelog.get_recent_commits ~proc ~cwd:monorepo_path ~count:10 in
110
143
111
-
match Poe.Handler.read_changes_file ~fs poe_config with
112
-
| None ->
113
-
Logs.err (fun m ->
114
-
m "Could not read changes file: %s" poe_config.changes_file)
115
-
| Some content ->
116
-
let msg =
117
-
Zulip.Message.create ~type_:`Channel ~to_:[ poe_config.channel ]
118
-
~topic:poe_config.topic ~content ()
119
-
in
120
-
let resp = Zulip.Messages.send client msg in
121
-
Logs.info (fun m ->
122
-
m "Broadcast sent, message ID: %d" (Zulip.Message_response.id resp))
144
+
if commits = [] then
145
+
Logs.info (fun m -> m "No commits to broadcast")
146
+
else begin
147
+
(* Get channel members for @mentions *)
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 ->
155
+
let msg =
156
+
Zulip.Message.create ~type_:`Channel ~to_:[ poe_config.channel ]
157
+
~topic:poe_config.topic ~content ()
158
+
in
159
+
let resp = Zulip.Messages.send client msg in
160
+
Logs.info (fun m ->
161
+
m "Broadcast sent, message ID: %d" (Zulip.Message_response.id resp))
162
+
end
123
163
in
124
164
let doc = "Broadcast daily changes to Zulip (one-shot)" in
125
165
let info = Cmd.info "broadcast" ~doc in
126
166
Cmd.v info
127
167
Term.(
128
168
const broadcast $ Fmt_cli.style_renderer () $ Logs_cli.level ()
129
-
$ config_file $ bot_name)
169
+
$ requests_verbose_arg $ config_file $ bot_name)
170
+
171
+
let loop_cmd =
172
+
let open Cmdliner in
173
+
let config_file =
174
+
Arg.(
175
+
value
176
+
& opt (some string) None
177
+
& info [ "c"; "config" ] ~docv:"FILE"
178
+
~doc:"Path to poe.toml configuration file.")
179
+
in
180
+
let bot_name =
181
+
Arg.(
182
+
value
183
+
& opt string "poe"
184
+
& info [ "n"; "name" ] ~docv:"NAME"
185
+
~doc:"Bot name for Zulip configuration lookup.")
186
+
in
187
+
let interval =
188
+
Arg.(
189
+
value
190
+
& opt int 3600
191
+
& info [ "i"; "interval" ] ~docv:"SECONDS"
192
+
~doc:"Interval in seconds between change checks (default: 3600).")
193
+
in
194
+
let loop style_renderer level requests_verbose config_file bot_name interval =
195
+
setup_logging style_renderer level ~requests_verbose;
196
+
Eio_main.run @@ fun env ->
197
+
Eio.Switch.run @@ fun sw ->
198
+
let fs = Eio.Stdenv.fs env in
199
+
let process_mgr = Eio.Stdenv.process_mgr env in
200
+
let clock = Eio.Stdenv.clock env in
201
+
202
+
(* Load poe config: explicit path > XDG > current dir > defaults *)
203
+
let poe_config =
204
+
match config_file with
205
+
| Some path -> Poe.Config.load ~fs path
206
+
| None -> (
207
+
match Poe.Config.load_xdg_opt ~fs with
208
+
| Some c -> c
209
+
| None -> (
210
+
match Poe.Config.load_opt ~fs "poe.toml" with
211
+
| Some c -> c
212
+
| None -> Poe.Config.default))
213
+
in
214
+
215
+
let zulip_config = Zulip_bot.Config.load_or_env ~xdg_app:"poe" ~fs bot_name in
216
+
217
+
(* Create handler environment *)
218
+
let handler_env : _ Poe.Handler.env =
219
+
{ sw; process_mgr; clock; fs }
220
+
in
221
+
222
+
(* Create handler for message processing *)
223
+
let handler = Poe.Handler.make_handler handler_env poe_config in
224
+
225
+
Logs.info (fun m ->
226
+
m "Starting loop, broadcasting to %s/%s every %d seconds"
227
+
poe_config.channel poe_config.topic interval);
228
+
Poe.Loop.run ~sw ~env ~config:poe_config ~zulip_config ~handler ~interval
229
+
in
230
+
let doc = "Run polling loop to check for and broadcast changes" in
231
+
let info = Cmd.info "loop" ~doc in
232
+
Cmd.v info
233
+
Term.(
234
+
const loop $ Fmt_cli.style_renderer () $ Logs_cli.level ()
235
+
$ requests_verbose_arg $ config_file $ bot_name $ interval)
130
236
131
237
let main_cmd =
132
238
let open Cmdliner in
···
143
249
`S Manpage.s_commands;
144
250
`P "$(b,run) - Run the bot as a long-running service";
145
251
`P "$(b,broadcast) - Send daily changes once and exit";
252
+
`P "$(b,loop) - Run polling loop to check for and broadcast changes";
146
253
`S "CONFIGURATION";
147
254
`P
148
255
"Poe configuration is searched in order:";
···
155
262
"channel = \"general\" # Zulip channel to broadcast to\n\
156
263
topic = \"Daily Changes\" # Topic for broadcasts\n\
157
264
changes_file = \"DAILY-CHANGES.md\"\n\
158
-
monorepo_path = \".\"";
265
+
monorepo_path = \".\"\n\
266
+
changes_dir = \".changes\"\n\
267
+
admin_emails = [\"admin@example.com\"]";
159
268
`P
160
269
"Zulip credentials are loaded from \
161
270
$(b,~/.config/poe/zulip.config) or environment variables.";
162
271
]
163
272
in
164
-
Cmd.group info [ run_cmd; broadcast_cmd ]
273
+
Cmd.group info [ run_cmd; broadcast_cmd; loop_cmd ]
165
274
166
275
let () =
167
276
Fmt_tty.setup_std_outputs ();
+71
lib/admin.ml
+71
lib/admin.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2026 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
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
12
+
| Some s when s = "" -> None
13
+
| Some s ->
14
+
match Ptime.of_rfc3339 s with
15
+
| Ok (t, _, _) -> Some t
16
+
| Error _ -> None
17
+
18
+
let set_last_broadcast_time storage time =
19
+
let timestamp = Ptime.to_rfc3339 ~tz_offset_s:0 time in
20
+
Zulip_bot.Storage.set storage last_broadcast_key timestamp
21
+
22
+
let get_last_git_head storage =
23
+
match Zulip_bot.Storage.get storage last_git_head_key with
24
+
| None -> None
25
+
| Some s when s = "" -> None
26
+
| Some s -> Some s
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"
33
+
| Some t -> Ptime.to_rfc3339 ~tz_offset_s:0 t
34
+
35
+
let handle ~storage cmd =
36
+
match cmd with
37
+
| Commands.Last_broadcast ->
38
+
let time = get_last_broadcast_time storage in
39
+
let head = get_last_git_head storage in
40
+
Printf.sprintf "**Last Broadcast**\n- Time: `%s`\n- Git HEAD: `%s`"
41
+
(format_time_option time)
42
+
(Option.value ~default:"unknown" head)
43
+
44
+
| Commands.Reset_broadcast timestamp ->
45
+
(match Ptime.of_rfc3339 timestamp with
46
+
| Ok (t, _, _) ->
47
+
set_last_broadcast_time storage t;
48
+
Printf.sprintf "Broadcast time reset to: `%s`"
49
+
(Ptime.to_rfc3339 ~tz_offset_s:0 t)
50
+
| Error _ ->
51
+
Printf.sprintf "Invalid timestamp format: `%s`. Use ISO 8601 format (e.g., 2026-01-15T10:30:00Z)."
52
+
timestamp)
53
+
54
+
| Commands.Storage_keys ->
55
+
let keys = Zulip_bot.Storage.keys storage in
56
+
if keys = [] then
57
+
"No storage keys found."
58
+
else
59
+
"**Storage Keys:**\n" ^
60
+
String.concat "\n" (List.map (fun k -> "- `" ^ k ^ "`") keys)
61
+
62
+
| Commands.Storage_get key ->
63
+
(match Zulip_bot.Storage.get storage key with
64
+
| None -> Printf.sprintf "Key `%s` not found." key
65
+
| Some "" -> Printf.sprintf "Key `%s` is empty." key
66
+
| Some value ->
67
+
Printf.sprintf "**%s:**\n```\n%s\n```" key value)
68
+
69
+
| Commands.Storage_delete key ->
70
+
Zulip_bot.Storage.remove storage key;
71
+
Printf.sprintf "Deleted key: `%s`" key
+38
lib/admin.mli
+38
lib/admin.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2026 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Admin command handlers for Poe bot.
7
+
8
+
This module provides handlers for admin commands and storage helpers
9
+
for managing broadcast state via Zulip bot storage. *)
10
+
11
+
(** {1 Storage Keys} *)
12
+
13
+
val last_broadcast_key : string
14
+
(** Key for storing the last broadcast timestamp: ["poe:broadcast:last_time"] *)
15
+
16
+
val last_git_head_key : string
17
+
(** Key for storing the last git head: ["poe:broadcast:last_git_head"] *)
18
+
19
+
(** {1 Storage Access} *)
20
+
21
+
val get_last_broadcast_time : Zulip_bot.Storage.t -> Ptime.t option
22
+
(** [get_last_broadcast_time storage] retrieves the last broadcast timestamp
23
+
from Zulip bot storage. Returns [None] if not set or invalid. *)
24
+
25
+
val set_last_broadcast_time : Zulip_bot.Storage.t -> Ptime.t -> unit
26
+
(** [set_last_broadcast_time storage time] stores the broadcast timestamp
27
+
in Zulip bot storage. *)
28
+
29
+
val get_last_git_head : Zulip_bot.Storage.t -> string option
30
+
(** [get_last_git_head storage] retrieves the last seen git HEAD from storage. *)
31
+
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
+
(** {1 Command Handlers} *)
36
+
37
+
val handle : storage:Zulip_bot.Storage.t -> Commands.admin_command -> string
38
+
(** [handle ~storage cmd] executes an admin command and returns the response. *)
+59
lib/broadcast.ml
+59
lib/broadcast.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2026 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let src = Logs.Src.create "poe.broadcast" ~doc:"Poe broadcast logic"
7
+
module Log = (val Logs.src_log src : Logs.LOG)
8
+
9
+
let get_git_head ~proc ~cwd =
10
+
Eio.Switch.run @@ fun sw ->
11
+
let buf = Buffer.create 64 in
12
+
let child = Eio.Process.spawn proc ~sw ~cwd
13
+
~stdout:(Eio.Flow.buffer_sink buf)
14
+
["git"; "rev-parse"; "--short"; "HEAD"]
15
+
in
16
+
match Eio.Process.await child with
17
+
| `Exited 0 -> Some (String.trim (Buffer.contents buf))
18
+
| _ -> None
19
+
20
+
let run ~sw ~proc ~clock ~fs ~client ~storage ~config =
21
+
let monorepo_path = Eio.Path.(fs / config.Config.monorepo_path) in
22
+
23
+
(* Get last git HEAD from storage *)
24
+
let last_head = Admin.get_last_git_head storage in
25
+
Log.info (fun m -> m "Last HEAD: %s"
26
+
(Option.value ~default:"(none)" last_head));
27
+
28
+
(* Get commits - either since last HEAD or recent commits *)
29
+
let commits = match last_head with
30
+
| Some h -> Changelog.get_git_log ~proc ~cwd:monorepo_path ~since_head:h
31
+
| None -> Changelog.get_recent_commits ~proc ~cwd:monorepo_path ~count:10
32
+
in
33
+
34
+
if commits = [] then begin
35
+
Log.info (fun m -> m "No commits to broadcast");
36
+
Zulip_bot.Response.reply "No new commits to broadcast."
37
+
end
38
+
else begin
39
+
(* Get channel members for @mentions *)
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 ->
47
+
(* Update storage *)
48
+
let now = Ptime_clock.now () in
49
+
Admin.set_last_broadcast_time storage now;
50
+
let current_head = get_git_head ~proc ~cwd:monorepo_path in
51
+
Option.iter (Admin.set_last_git_head storage) current_head;
52
+
Log.info (fun m -> m "Updated broadcast time to %s" (Ptime.to_rfc3339 now));
53
+
54
+
(* Send as stream message *)
55
+
Log.info (fun m -> m "Broadcasting: %s" content);
56
+
57
+
Zulip_bot.Response.stream ~stream:config.Config.channel
58
+
~topic:config.Config.topic ~content
59
+
end
+30
lib/broadcast.mli
+30
lib/broadcast.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2026 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Smart broadcast logic for Poe bot.
7
+
8
+
This module implements intelligent change broadcasting that generates
9
+
narrative changelogs using Claude, with @mentions for channel members. *)
10
+
11
+
val run :
12
+
sw:Eio.Switch.t ->
13
+
proc:_ Eio.Process.mgr ->
14
+
clock:float Eio.Time.clock_ty Eio.Resource.t ->
15
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
16
+
client:Zulip.Client.t ->
17
+
storage:Zulip_bot.Storage.t ->
18
+
config:Config.t ->
19
+
Zulip_bot.Response.t
20
+
(** [run ~sw ~proc ~clock ~client ~storage ~config] generates and broadcasts
21
+
a changelog for recent commits.
22
+
23
+
Logic:
24
+
1. Get last git HEAD from storage
25
+
2. Get commits since that HEAD (or last 10 if first run)
26
+
3. Get channel members for @mention matching
27
+
4. Generate narrative changelog with Claude
28
+
5. Send as stream message to configured channel/topic
29
+
6. Update last broadcast time and git HEAD in storage
30
+
7. Return confirmation message *)
+200
lib/changelog.ml
+200
lib/changelog.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2026 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Claude-powered narrative changelog generation with @mentions. *)
7
+
8
+
let src = Logs.Src.create "poe.changelog" ~doc:"Poe changelog generation"
9
+
module Log = (val Logs.src_log src : Logs.LOG)
10
+
11
+
type commit = {
12
+
hash: string;
13
+
author: string;
14
+
email: string;
15
+
subject: string;
16
+
files: string list;
17
+
}
18
+
19
+
type channel_member = {
20
+
full_name: string;
21
+
email: string;
22
+
}
23
+
24
+
let get_commit_files ~proc ~cwd ~hash =
25
+
Eio.Switch.run @@ fun sw ->
26
+
let buf = Buffer.create 256 in
27
+
let child = Eio.Process.spawn proc ~sw ~cwd
28
+
~stdout:(Eio.Flow.buffer_sink buf)
29
+
["git"; "diff-tree"; "--no-commit-id"; "--name-only"; "-r"; hash]
30
+
in
31
+
match Eio.Process.await child with
32
+
| `Exited 0 ->
33
+
Buffer.contents buf
34
+
|> String.split_on_char '\n'
35
+
|> List.filter (fun s -> String.trim s <> "")
36
+
| _ -> []
37
+
38
+
let get_git_log ~proc ~cwd ~since_head =
39
+
Log.info (fun m -> m "Getting commits since %s" since_head);
40
+
Eio.Switch.run @@ fun sw ->
41
+
let buf = Buffer.create 1024 in
42
+
let child = Eio.Process.spawn proc ~sw ~cwd
43
+
~stdout:(Eio.Flow.buffer_sink buf)
44
+
["git"; "log"; "--pretty=format:%h|%an|%ae|%s"; since_head ^ "..HEAD"]
45
+
in
46
+
match Eio.Process.await child with
47
+
| `Exited 0 ->
48
+
let output = Buffer.contents buf in
49
+
if String.trim output = "" then []
50
+
else
51
+
String.split_on_char '\n' output
52
+
|> List.filter_map (fun line ->
53
+
match String.split_on_char '|' line with
54
+
| [hash; author; email; subject] ->
55
+
let files = get_commit_files ~proc ~cwd ~hash in
56
+
Some { hash; author; email; subject; files }
57
+
| _ -> None)
58
+
| _ -> []
59
+
60
+
let get_recent_commits ~proc ~cwd ~count =
61
+
Log.info (fun m -> m "Getting last %d commits" count);
62
+
Eio.Switch.run @@ fun sw ->
63
+
let buf = Buffer.create 1024 in
64
+
let child = Eio.Process.spawn proc ~sw ~cwd
65
+
~stdout:(Eio.Flow.buffer_sink buf)
66
+
["git"; "log"; "--pretty=format:%h|%an|%ae|%s"; "-n"; string_of_int count]
67
+
in
68
+
match Eio.Process.await child with
69
+
| `Exited 0 ->
70
+
let output = Buffer.contents buf in
71
+
if String.trim output = "" then []
72
+
else
73
+
String.split_on_char '\n' output
74
+
|> List.filter_map (fun line ->
75
+
match String.split_on_char '|' line with
76
+
| [hash; author; email; subject] ->
77
+
let files = get_commit_files ~proc ~cwd ~hash in
78
+
Some { hash; author; email; subject; files }
79
+
| _ -> None)
80
+
| _ -> []
81
+
82
+
let get_channel_members ~client ~channel =
83
+
Log.info (fun m -> m "Getting members of channel %s" channel);
84
+
try
85
+
let stream_id = Zulip.Channels.get_id client ~name:channel in
86
+
let subscriber_ids = Zulip.Channels.get_subscribers client ~stream_id in
87
+
Log.info (fun m -> m "Found %d subscribers" (List.length subscriber_ids));
88
+
List.filter_map (fun user_id ->
89
+
try
90
+
let user = Zulip.Users.get_by_id client ~user_id () in
91
+
Some {
92
+
full_name = Zulip.User.full_name user;
93
+
email = Zulip.User.email user;
94
+
}
95
+
with _ -> None
96
+
) subscriber_ids
97
+
with e ->
98
+
Log.warn (fun m -> m "Failed to get channel members: %s" (Printexc.to_string e));
99
+
[]
100
+
101
+
let create_claude_client ~sw ~proc ~clock =
102
+
let options =
103
+
Claude.Options.default
104
+
|> Claude.Options.with_model `Opus_4_5
105
+
|> Claude.Options.with_permission_mode Claude.Permissions.Mode.Bypass_permissions
106
+
|> Claude.Options.with_allowed_tools []
107
+
in
108
+
Claude.Client.create ~options ~sw ~process_mgr:proc ~clock ()
109
+
110
+
let ask_claude ~sw ~proc ~clock prompt =
111
+
let client = create_claude_client ~sw ~proc ~clock in
112
+
Claude.Client.query client prompt;
113
+
let responses = Claude.Client.receive_all client in
114
+
let text =
115
+
List.filter_map
116
+
(function
117
+
| Claude.Response.Text t -> Some (Claude.Response.Text.content t)
118
+
| _ -> None)
119
+
responses
120
+
in
121
+
String.concat "" text
122
+
123
+
(* Extract sub-project name from a file path (first directory component) *)
124
+
let subproject_of_file path =
125
+
match String.split_on_char '/' path with
126
+
| dir :: _ when dir <> "" && dir <> "." -> Some dir
127
+
| _ -> None
128
+
129
+
(* Get unique sub-projects affected by a list of commits *)
130
+
let affected_subprojects commits =
131
+
commits
132
+
|> List.concat_map (fun c -> c.files)
133
+
|> List.filter_map subproject_of_file
134
+
|> List.sort_uniq String.compare
135
+
136
+
let generate ~sw ~proc ~clock ~commits ~members =
137
+
if commits = [] then None
138
+
else begin
139
+
Log.info (fun m -> m "Generating narrative changelog with Claude for %d commits" (List.length commits));
140
+
141
+
(* Get affected sub-projects *)
142
+
let subprojects = affected_subprojects commits in
143
+
let subprojects_text = String.concat ", " subprojects in
144
+
145
+
(* Format commits for the prompt, including files *)
146
+
let commits_text = commits
147
+
|> List.map (fun c ->
148
+
let files_text = match c.files with
149
+
| [] -> ""
150
+
| files -> Printf.sprintf "\n Files: %s" (String.concat ", " files)
151
+
in
152
+
Printf.sprintf "- %s by %s <%s>: %s%s" c.hash c.author c.email c.subject files_text)
153
+
|> String.concat "\n"
154
+
in
155
+
156
+
(* Format members for mention matching *)
157
+
let members_text = members
158
+
|> List.map (fun m ->
159
+
Printf.sprintf "- @**%s** (email: %s)" m.full_name m.email)
160
+
|> String.concat "\n"
161
+
in
162
+
163
+
let prompt = Printf.sprintf
164
+
{|You are writing a changelog update for a Zulip channel about a monorepo.
165
+
166
+
Git commits:
167
+
168
+
%s
169
+
170
+
Affected sub-projects: %s
171
+
172
+
Channel members who can be @mentioned (use exact @**Name** format):
173
+
174
+
%s
175
+
176
+
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.
177
+
178
+
Format:
179
+
- **project-name**: Description of the change. *change type*
180
+
181
+
Example:
182
+
- **ocaml-claudeio**: Added model types for Opus 4.5 and 4.1. *new feature*
183
+
- **ocaml-zulip**: Fixed encoding bug in channel name lookups that affected names with spaces. *bug fix*
184
+
- **poe**: Updated to use the latest Opus model for changelog generation. *enhancement*
185
+
186
+
Guidelines:
187
+
1. One bullet per logical change (group related commits)
188
+
2. Project name in bold at the start
189
+
3. One or two sentences describing the change
190
+
4. Change type in italics at the end: *new feature*, *bug fix*, *enhancement*, *refactoring*, etc.
191
+
5. Use @**Name** mentions when authors match channel members
192
+
6. No emojis
193
+
194
+
Write ONLY the bullet points, no preamble or header.|} commits_text subprojects_text members_text
195
+
in
196
+
197
+
let response = ask_claude ~sw ~proc ~clock prompt in
198
+
Log.info (fun m -> m "Claude generated: %s" response);
199
+
Some (String.trim response)
200
+
end
+70
lib/changelog.mli
+70
lib/changelog.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2026 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Claude-powered narrative changelog generation with @mentions.
7
+
8
+
This module generates human-readable changelog narratives from git commits,
9
+
using Claude to summarize changes and automatically @mention channel members
10
+
who authored commits. *)
11
+
12
+
(** {1 Types} *)
13
+
14
+
type commit = {
15
+
hash: string;
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;
25
+
email: string;
26
+
}
27
+
(** A Zulip channel member for @mention matching. *)
28
+
29
+
(** {1 Git Operations} *)
30
+
31
+
val get_git_log :
32
+
proc:_ Eio.Process.mgr ->
33
+
cwd:Eio.Fs.dir_ty Eio.Path.t ->
34
+
since_head:string ->
35
+
commit list
36
+
(** [get_git_log ~proc ~cwd ~since_head] returns commits between [since_head]
37
+
and HEAD. *)
38
+
39
+
val get_recent_commits :
40
+
proc:_ Eio.Process.mgr ->
41
+
cwd:Eio.Fs.dir_ty Eio.Path.t ->
42
+
count:int ->
43
+
commit list
44
+
(** [get_recent_commits ~proc ~cwd ~count] returns the last [count] commits. *)
45
+
46
+
(** {1 Zulip Operations} *)
47
+
48
+
val get_channel_members :
49
+
client:Zulip.Client.t ->
50
+
channel:string ->
51
+
channel_member list
52
+
(** [get_channel_members ~client ~channel] returns the members of [channel]
53
+
for @mention matching. *)
54
+
55
+
(** {1 Changelog Generation} *)
56
+
57
+
val generate :
58
+
sw:Eio.Switch.t ->
59
+
proc:_ Eio.Process.mgr ->
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. *)
+51
lib/commands.ml
+51
lib/commands.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2026 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type admin_command =
7
+
| Last_broadcast
8
+
| Reset_broadcast of string
9
+
| Storage_keys
10
+
| Storage_get of string
11
+
| Storage_delete of string
12
+
13
+
type command =
14
+
| Help
15
+
| Status
16
+
| Broadcast
17
+
| Refresh
18
+
| Admin of admin_command
19
+
| Unknown of string
20
+
21
+
let admin_parse args =
22
+
let args = String.trim args in
23
+
match String.split_on_char ' ' args with
24
+
| ["last-broadcast"] | ["last_broadcast"] | ["lastbroadcast"] ->
25
+
Some Last_broadcast
26
+
| ["reset-broadcast"; timestamp] | ["reset_broadcast"; timestamp] ->
27
+
Some (Reset_broadcast timestamp)
28
+
| ["storage"; "keys"] ->
29
+
Some Storage_keys
30
+
| ["storage"; "get"; key] ->
31
+
Some (Storage_get key)
32
+
| ["storage"; "delete"; key] ->
33
+
Some (Storage_delete key)
34
+
| _ ->
35
+
None
36
+
37
+
let parse content =
38
+
let content = String.trim (String.lowercase_ascii content) in
39
+
match content with
40
+
| "help" | "?" -> Help
41
+
| "status" -> Status
42
+
| "broadcast" | "post changes" | "post" | "changes" -> Broadcast
43
+
| "refresh" | "pull" | "sync" | "update" -> Refresh
44
+
| _ ->
45
+
if String.starts_with ~prefix:"admin " content then
46
+
let args = String.sub content 6 (String.length content - 6) in
47
+
match admin_parse args with
48
+
| Some cmd -> Admin cmd
49
+
| None -> Unknown content
50
+
else
51
+
Unknown content
+34
lib/commands.mli
+34
lib/commands.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2026 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Command parsing for Poe bot.
7
+
8
+
This module provides deterministic command parsing for the Poe Zulip bot.
9
+
Unrecognized commands are passed through to Claude for interpretation. *)
10
+
11
+
(** Admin sub-commands for storage and broadcast management. *)
12
+
type admin_command =
13
+
| Last_broadcast (** Show last broadcast time *)
14
+
| Reset_broadcast of string (** Reset broadcast time to ISO timestamp *)
15
+
| Storage_keys (** List all storage keys *)
16
+
| Storage_get of string (** Get value for a storage key *)
17
+
| Storage_delete of string (** Delete a storage key *)
18
+
19
+
(** Parsed bot commands. *)
20
+
type command =
21
+
| Help (** Show help message *)
22
+
| Status (** Show bot configuration status *)
23
+
| Broadcast (** Broadcast new changes *)
24
+
| Refresh (** Pull from remote, regenerate changes, and broadcast *)
25
+
| Admin of admin_command (** Admin commands (require authorization) *)
26
+
| Unknown of string (** Unrecognized command - pass to Claude *)
27
+
28
+
val parse : string -> command
29
+
(** [parse content] parses a message into a command.
30
+
The input should be trimmed and lowercased. *)
31
+
32
+
val admin_parse : string -> admin_command option
33
+
(** [admin_parse args] parses admin sub-command arguments.
34
+
Returns [None] if the arguments don't match any admin command. *)
+10
-2
lib/config.ml
+10
-2
lib/config.ml
···
8
8
topic : string;
9
9
changes_file : string;
10
10
monorepo_path : string;
11
+
admin_emails : string list;
12
+
changes_dir : string;
11
13
}
12
14
13
15
let default = {
···
15
17
topic = "Daily Changes";
16
18
changes_file = "DAILY-CHANGES.md";
17
19
monorepo_path = ".";
20
+
admin_emails = [];
21
+
changes_dir = ".changes";
18
22
}
19
23
20
24
let codec =
21
25
Tomlt.(
22
26
Table.(
23
-
obj (fun channel topic changes_file monorepo_path ->
24
-
{ channel; topic; changes_file; monorepo_path })
27
+
obj (fun channel topic changes_file monorepo_path admin_emails changes_dir ->
28
+
{ channel; topic; changes_file; monorepo_path; admin_emails; changes_dir })
25
29
|> mem "channel" string ~dec_absent:default.channel
26
30
~enc:(fun c -> c.channel)
27
31
|> mem "topic" string ~dec_absent:default.topic ~enc:(fun c -> c.topic)
···
29
33
~enc:(fun c -> c.changes_file)
30
34
|> mem "monorepo_path" string ~dec_absent:default.monorepo_path
31
35
~enc:(fun c -> c.monorepo_path)
36
+
|> mem "admin_emails" (list string) ~dec_absent:default.admin_emails
37
+
~enc:(fun c -> c.admin_emails)
38
+
|> mem "changes_dir" string ~dec_absent:default.changes_dir
39
+
~enc:(fun c -> c.changes_dir)
32
40
|> finish))
33
41
34
42
let load_from_path path =
+5
-1
lib/config.mli
+5
-1
lib/config.mli
···
15
15
topic = "Daily Changes"
16
16
changes_file = "DAILY-CHANGES.md"
17
17
monorepo_path = "."
18
+
changes_dir = ".changes"
19
+
admin_emails = ["admin@example.com"]
18
20
v} *)
19
21
20
22
type t = {
21
23
channel : string; (** The Zulip channel to broadcast to *)
22
24
topic : string; (** The topic for broadcast messages *)
23
-
changes_file : string; (** Path to the daily changes file *)
25
+
changes_file : string; (** Path to the daily changes markdown file *)
24
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 *)
25
29
}
26
30
27
31
val default : t
+1
-1
lib/dune
+1
-1
lib/dune
+144
-30
lib/handler.ml
+144
-30
lib/handler.ml
···
14
14
fs : Eio.Fs.dir_ty Eio.Path.t;
15
15
}
16
16
17
-
let read_changes_file ~fs config =
18
-
let open Eio.Path in
19
-
let path = fs / config.Config.monorepo_path / config.Config.changes_file in
20
-
try Some (load path) with _ -> None
17
+
let run_git_pull ~proc ~cwd =
18
+
Log.info (fun m -> m "Pulling latest changes from remote");
19
+
Eio.Switch.run @@ fun sw ->
20
+
let buf_stdout = Buffer.create 256 in
21
+
let buf_stderr = Buffer.create 256 in
22
+
let child = Eio.Process.spawn proc ~sw ~cwd
23
+
~stdout:(Eio.Flow.buffer_sink buf_stdout)
24
+
~stderr:(Eio.Flow.buffer_sink buf_stderr)
25
+
["git"; "pull"; "--ff-only"]
26
+
in
27
+
match Eio.Process.await child with
28
+
| `Exited 0 ->
29
+
let output = String.trim (Buffer.contents buf_stdout) in
30
+
if output = "Already up to date." then begin
31
+
Log.info (fun m -> m "Repository already up to date");
32
+
Ok `Up_to_date
33
+
end else begin
34
+
Log.info (fun m -> m "Pulled new changes from remote");
35
+
Ok (`Updated output)
36
+
end
37
+
| `Exited code ->
38
+
let stderr = String.trim (Buffer.contents buf_stderr) in
39
+
Log.warn (fun m -> m "git pull exited with code %d: %s" code stderr);
40
+
Error (Printf.sprintf "git pull failed (code %d): %s" code stderr)
41
+
| `Signaled sig_ ->
42
+
Log.warn (fun m -> m "git pull killed by signal %d" sig_);
43
+
Error (Printf.sprintf "git pull killed by signal %d" sig_)
21
44
22
-
let broadcast_changes ~fs ~storage:_ ~identity:_ config _msg =
23
-
match read_changes_file ~fs config with
24
-
| None ->
25
-
Zulip_bot.Response.reply
26
-
(Printf.sprintf "Could not read changes file: %s"
27
-
config.Config.changes_file)
28
-
| Some content ->
29
-
Zulip_bot.Response.stream ~stream:config.Config.channel
30
-
~topic:config.Config.topic ~content
45
+
let get_git_head ~proc ~cwd =
46
+
Eio.Switch.run @@ fun sw ->
47
+
let buf = Buffer.create 64 in
48
+
let child = Eio.Process.spawn proc ~sw ~cwd
49
+
~stdout:(Eio.Flow.buffer_sink buf)
50
+
["git"; "rev-parse"; "--short"; "HEAD"]
51
+
in
52
+
match Eio.Process.await child with
53
+
| `Exited 0 -> Some (String.trim (Buffer.contents buf))
54
+
| _ -> None
31
55
32
56
let create_claude_client env =
33
57
let options =
34
58
Claude.Options.default
35
-
|> Claude.Options.with_model `Sonnet_4_5
59
+
|> Claude.Options.with_model `Opus_4_5
36
60
|> Claude.Options.with_permission_mode Claude.Permissions.Mode.Bypass_permissions
37
61
|> Claude.Options.with_allowed_tools [ "Read"; "Glob"; "Grep" ]
38
62
|> Claude.Options.with_append_system_prompt
···
62
86
Zulip_bot.Response.reply
63
87
{|**Poe Bot Commands:**
64
88
65
-
- `broadcast` or `post changes` - Broadcast the daily changes to the configured channel
66
-
- `help` - Show this help message
89
+
**Basic Commands:**
90
+
- `help` or `?` - Show this help message
67
91
- `status` - Show bot configuration status
68
-
- Any other message will be interpreted by Claude to help you understand or modify the bot
92
+
- `broadcast` / `post` / `changes` - Generate and broadcast changelog with Claude
93
+
- `refresh` / `pull` / `sync` / `update` - Pull from remote and broadcast changes
94
+
95
+
**Admin Commands:** (require authorization)
96
+
- `admin last-broadcast` - Show last broadcast time and git HEAD
97
+
- `admin reset-broadcast <ISO-timestamp>` - Reset broadcast time
98
+
- `admin storage keys` - List all storage keys
99
+
- `admin storage get <key>` - Get value for a storage key
100
+
- `admin storage delete <key>` - Delete a storage key
101
+
102
+
**Other Messages:**
103
+
Any other message will be interpreted by Claude to help you understand or modify the bot.
69
104
70
105
**Configuration:**
71
106
The bot reads its configuration from `poe.toml` with the following fields:
72
107
- `channel` - The Zulip channel to broadcast to
73
108
- `topic` - The topic for broadcast messages
74
-
- `changes_file` - Path to the daily changes file
75
-
- `monorepo_path` - Path to the monorepo root|}
109
+
- `monorepo_path` - Path to the monorepo root
110
+
- `admin_emails` - List of emails authorized for admin commands|}
76
111
77
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
78
116
Zulip_bot.Response.reply
79
117
(Printf.sprintf
80
118
{|**Poe Bot Status:**
81
119
82
120
- Channel: `%s`
83
121
- Topic: `%s`
84
-
- Changes file: `%s`
85
-
- Monorepo path: `%s`|}
86
-
config.Config.channel config.Config.topic config.Config.changes_file
87
-
config.Config.monorepo_path)
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
129
+
130
+
(* Step 1: Git pull *)
131
+
let pull_result = run_git_pull ~proc:env.process_mgr ~cwd:monorepo_path in
132
+
match pull_result with
133
+
| Error e ->
134
+
Zulip_bot.Response.reply (Printf.sprintf "**Refresh failed:**\n\n%s" e)
135
+
| Ok pull_status ->
136
+
let pull_msg = match pull_status with
137
+
| `Up_to_date -> "Repository already up to date"
138
+
| `Updated _ -> "Pulled new changes from remote"
139
+
in
140
+
141
+
(* Step 2: Get commits since last HEAD *)
142
+
let last_head = Admin.get_last_git_head storage in
143
+
let commits = match last_head with
144
+
| Some h -> Changelog.get_git_log ~proc:env.process_mgr ~cwd:monorepo_path ~since_head:h
145
+
| None -> Changelog.get_recent_commits ~proc:env.process_mgr ~cwd:monorepo_path ~count:10
146
+
in
147
+
148
+
if commits = [] then
149
+
Zulip_bot.Response.reply
150
+
(Printf.sprintf "**Refresh completed:**\n\n- %s\n- No new commits to broadcast" pull_msg)
151
+
else begin
152
+
(* Get channel members for @mentions *)
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)
160
+
| Some content ->
161
+
(* Update storage *)
162
+
let now = Ptime_clock.now () in
163
+
Admin.set_last_broadcast_time storage now;
164
+
let current_head = get_git_head ~proc:env.process_mgr ~cwd:monorepo_path in
165
+
Option.iter (Admin.set_last_git_head storage) current_head;
166
+
Log.info (fun m -> m "Refresh broadcasting: %s" content);
167
+
168
+
(* Send to channel *)
169
+
Zulip_bot.Response.stream
170
+
~stream:config.Config.channel
171
+
~topic:config.Config.topic
172
+
~content:(Printf.sprintf "**Refresh triggered manually**\n\n%s" content)
173
+
end
88
174
89
175
let handle_claude_query env msg =
90
176
let content = Zulip_bot.Message.content msg in
···
104
190
Log.info (fun m -> m "Claude response: %s" response);
105
191
Zulip_bot.Response.reply response
106
192
193
+
let is_admin config ~storage msg =
194
+
let sender_id = Zulip_bot.Message.sender_id msg in
195
+
let client = Zulip_bot.Storage.client storage in
196
+
try
197
+
let user = Zulip.Users.get_by_id client ~user_id:sender_id () in
198
+
let delivery_email = Zulip.User.delivery_email user in
199
+
let email = Zulip.User.email user in
200
+
(* Check both delivery_email (actual email) and email (Zulip internal) *)
201
+
let emails_to_check =
202
+
match delivery_email with
203
+
| Some de -> [ de; email ]
204
+
| None -> [ email ]
205
+
in
206
+
List.exists (fun e -> List.mem e config.Config.admin_emails) emails_to_check
207
+
with _ ->
208
+
(* Fallback to sender_email from message if API call fails *)
209
+
let sender_email = Zulip_bot.Message.sender_email msg in
210
+
List.mem sender_email config.Config.admin_emails
211
+
107
212
let make_handler env config =
108
213
fun ~storage ~identity msg ->
109
214
let bot_email = identity.Zulip_bot.Bot.email in
110
215
let sender_email = Zulip_bot.Message.sender_email msg in
111
216
if sender_email = bot_email then Zulip_bot.Response.silent
112
217
else
218
+
let client = Zulip_bot.Storage.client storage in
113
219
let content =
114
220
Zulip_bot.Message.strip_mention msg ~user_email:bot_email
115
-
|> String.trim |> String.lowercase_ascii
221
+
|> String.trim
116
222
in
117
223
Log.info (fun m -> m "Received message: %s" content);
118
-
match content with
119
-
| "help" | "?" -> handle_help ()
120
-
| "status" -> handle_status config
121
-
| "broadcast" | "post changes" | "post" | "changes" ->
122
-
broadcast_changes ~fs:env.fs ~storage ~identity config msg
123
-
| _ -> handle_claude_query env msg
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
230
+
| Commands.Refresh ->
231
+
handle_refresh env ~client ~storage ~config
232
+
| Commands.Admin cmd ->
233
+
if is_admin config ~storage msg then
234
+
Zulip_bot.Response.reply (Admin.handle ~storage cmd)
235
+
else
236
+
Zulip_bot.Response.reply "Admin commands require authorization. Contact an admin to be added to the admin_emails list."
237
+
| Commands.Unknown _ -> handle_claude_query env msg
-3
lib/handler.mli
-3
lib/handler.mli
+179
lib/loop.ml
+179
lib/loop.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2026 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
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 get_git_head ~proc ~cwd =
10
+
Eio.Switch.run @@ fun sw ->
11
+
let buf = Buffer.create 64 in
12
+
let child = Eio.Process.spawn proc ~sw ~cwd
13
+
~stdout:(Eio.Flow.buffer_sink buf)
14
+
["git"; "rev-parse"; "--short"; "HEAD"]
15
+
in
16
+
match Eio.Process.await child with
17
+
| `Exited 0 -> Some (String.trim (Buffer.contents buf))
18
+
| _ -> None
19
+
20
+
let run_git_pull ~proc ~cwd =
21
+
Log.info (fun m -> m "Pulling latest changes from remote");
22
+
Eio.Switch.run @@ fun sw ->
23
+
let buf_stdout = Buffer.create 256 in
24
+
let buf_stderr = Buffer.create 256 in
25
+
let child = Eio.Process.spawn proc ~sw ~cwd
26
+
~stdout:(Eio.Flow.buffer_sink buf_stdout)
27
+
~stderr:(Eio.Flow.buffer_sink buf_stderr)
28
+
["git"; "pull"; "--ff-only"]
29
+
in
30
+
match Eio.Process.await child with
31
+
| `Exited 0 ->
32
+
let output = String.trim (Buffer.contents buf_stdout) in
33
+
if output = "Already up to date." then
34
+
Log.info (fun m -> m "Repository already up to date")
35
+
else begin
36
+
Log.info (fun m -> m "Pulled new changes from remote");
37
+
String.split_on_char '\n' output
38
+
|> List.iter (fun line ->
39
+
let line = String.trim line in
40
+
if line <> "" then Log.info (fun m -> m " %s" line))
41
+
end;
42
+
true
43
+
| `Exited code ->
44
+
let stderr = String.trim (Buffer.contents buf_stderr) in
45
+
Log.warn (fun m -> m "git pull exited with code %d: %s" code stderr);
46
+
false
47
+
| `Signaled sig_ ->
48
+
Log.warn (fun m -> m "git pull killed by signal %d" sig_);
49
+
false
50
+
51
+
let send_message ~client ~stream ~topic ~content =
52
+
let msg = Zulip.Message.create ~type_:`Channel ~to_:[stream] ~topic ~content () in
53
+
let resp = Zulip.Messages.send client msg in
54
+
Log.info (fun m -> m "Broadcast sent, message ID: %d" (Zulip.Message_response.id resp))
55
+
56
+
let run ~sw ~env ~config ~zulip_config ~handler ~interval =
57
+
let fs = Eio.Stdenv.fs env in
58
+
let proc = Eio.Stdenv.process_mgr env in
59
+
let clock = Eio.Stdenv.clock env in
60
+
61
+
(* Create Zulip client *)
62
+
let client = Zulip_bot.Bot.create_client ~sw ~env ~config:zulip_config in
63
+
let storage = Zulip_bot.Storage.create client in
64
+
65
+
let monorepo_path = Eio.Path.(fs / config.Config.monorepo_path) in
66
+
67
+
Log.info (fun m -> m "Starting loop with %d second interval" interval);
68
+
69
+
let broadcast_loop () =
70
+
let rec loop () =
71
+
Log.info (fun m -> m "Checking for changes...");
72
+
73
+
(* Pull latest changes from remote *)
74
+
let _pull_ok = run_git_pull ~proc ~cwd:monorepo_path in
75
+
76
+
(* Get current git HEAD *)
77
+
let current_head = get_git_head ~proc ~cwd:monorepo_path in
78
+
let last_head = Admin.get_last_git_head storage in
79
+
80
+
Log.info (fun m -> m "Current HEAD: %s, Last HEAD: %s"
81
+
(Option.value ~default:"(none)" current_head)
82
+
(Option.value ~default:"(none)" last_head));
83
+
84
+
(* Check if HEAD has changed *)
85
+
let head_changed = match (current_head, last_head) with
86
+
| (Some c, Some l) -> c <> l
87
+
| (Some _, None) -> true (* First run *)
88
+
| _ -> false
89
+
in
90
+
91
+
if head_changed then begin
92
+
Log.info (fun m -> m "Git HEAD changed, generating changes...");
93
+
94
+
(* Get commits since last HEAD *)
95
+
let commits = match last_head with
96
+
| Some h -> Changelog.get_git_log ~proc ~cwd:monorepo_path ~since_head:h
97
+
| None -> [] (* First run, don't broadcast everything *)
98
+
in
99
+
100
+
if commits = [] then begin
101
+
Log.info (fun m -> m "No commits to broadcast");
102
+
(* Still update HEAD so we don't reprocess *)
103
+
Option.iter (Admin.set_last_git_head storage) current_head
104
+
end
105
+
else begin
106
+
(* Get channel members for @mentions *)
107
+
let members = Changelog.get_channel_members ~client ~channel:config.Config.channel in
108
+
109
+
(* Generate narrative changelog with Claude *)
110
+
match Changelog.generate ~sw ~proc ~clock ~commits ~members with
111
+
| None ->
112
+
Log.info (fun m -> m "No changelog generated");
113
+
Option.iter (Admin.set_last_git_head storage) current_head
114
+
| Some content ->
115
+
Log.info (fun m -> m "Broadcasting narrative changelog");
116
+
send_message ~client ~stream:config.Config.channel
117
+
~topic:config.Config.topic ~content;
118
+
119
+
(* Update storage *)
120
+
let now = Ptime_clock.now () in
121
+
Admin.set_last_broadcast_time storage now;
122
+
Option.iter (Admin.set_last_git_head storage) current_head;
123
+
Log.info (fun m -> m "Updated broadcast time and git HEAD")
124
+
end
125
+
end
126
+
else
127
+
Log.debug (fun m -> m "No HEAD change, skipping");
128
+
129
+
(* Sleep until next check *)
130
+
Log.info (fun m -> m "Sleeping for %d seconds" interval);
131
+
Eio.Time.sleep clock (float_of_int interval);
132
+
loop ()
133
+
in
134
+
loop ()
135
+
in
136
+
137
+
(* Run broadcast loop and message handler concurrently *)
138
+
Eio.Fiber.both
139
+
broadcast_loop
140
+
(fun () ->
141
+
Log.info (fun m -> m "Starting message handler");
142
+
let identity = Zulip_bot.Bot.fetch_identity client in
143
+
Log.info (fun m ->
144
+
m "Bot identity: %s <%s> (id: %d)" identity.full_name identity.email
145
+
identity.user_id);
146
+
let queue =
147
+
Zulip.Event_queue.register client
148
+
~event_types:[ Zulip.Event_type.Message ]
149
+
()
150
+
in
151
+
Log.info (fun m ->
152
+
m "Event queue registered: %s" (Zulip.Event_queue.id queue));
153
+
let rec event_loop last_event_id =
154
+
try
155
+
let events =
156
+
Zulip.Event_queue.get_events queue client ~last_event_id ()
157
+
in
158
+
if List.length events > 0 then
159
+
Log.info (fun m -> m "Received %d event(s)" (List.length events));
160
+
List.iter
161
+
(fun event ->
162
+
Log.debug (fun m ->
163
+
m "Event id=%d, type=%s" (Zulip.Event.id event)
164
+
(Zulip.Event_type.to_string (Zulip.Event.type_ event)));
165
+
Zulip_bot.Bot.process_event ~client ~storage ~identity ~handler event)
166
+
events;
167
+
let new_last_id =
168
+
List.fold_left
169
+
(fun max_id event -> max (Zulip.Event.id event) max_id)
170
+
last_event_id events
171
+
in
172
+
event_loop new_last_id
173
+
with Eio.Exn.Io (e, _) ->
174
+
Log.warn (fun m ->
175
+
m "Error getting events: %a (retrying in 2s)" Eio.Exn.pp_err e);
176
+
Eio.Time.sleep clock 2.0;
177
+
event_loop last_event_id
178
+
in
179
+
event_loop (-1))
+48
lib/loop.mli
+48
lib/loop.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2026 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Combined loop for change detection, broadcast, and message handling.
7
+
8
+
This module implements a polling loop that periodically checks for new
9
+
changes in the monorepo and broadcasts them to Zulip. It also runs a
10
+
concurrent message handler to respond to DMs and mentions while the
11
+
broadcast loop sleeps. *)
12
+
13
+
val run :
14
+
sw:Eio.Switch.t ->
15
+
env:< clock : float Eio.Time.clock_ty Eio.Resource.t ;
16
+
fs : Eio.Fs.dir_ty Eio.Path.t ;
17
+
net : [ `Generic | `Unix ] Eio.Net.ty Eio.Resource.t ;
18
+
process_mgr : _ Eio.Process.mgr ;
19
+
.. > ->
20
+
config:Config.t ->
21
+
zulip_config:Zulip_bot.Config.t ->
22
+
handler:Zulip_bot.Bot.handler ->
23
+
interval:int ->
24
+
unit
25
+
(** [run ~sw ~env ~config ~zulip_config ~handler ~interval] starts both the
26
+
polling loop and the message handler concurrently.
27
+
28
+
The broadcast loop flow:
29
+
1. Pull latest changes from remote (git pull --ff-only)
30
+
2. Check if git HEAD has changed (compare with stored last_git_head)
31
+
3. If changed:
32
+
- Get commits since last HEAD via git log
33
+
- Fetch channel members for @mention matching
34
+
- Generate narrative changelog using Claude
35
+
- Send to Zulip channel
36
+
- Update last_broadcast_time and last_git_head in storage
37
+
4. Sleep for interval seconds
38
+
5. Repeat
39
+
40
+
Concurrently, the message handler listens for incoming Zulip messages
41
+
(DMs and mentions) and processes them using the provided handler.
42
+
43
+
@param sw Eio switch for resource management
44
+
@param env Eio environment
45
+
@param config Poe configuration
46
+
@param zulip_config Zulip bot configuration
47
+
@param handler Message handler function
48
+
@param interval Seconds between broadcast checks (default: 3600) *)
+5
lib/poe.ml
+5
lib/poe.ml
···
6
6
(** Poe - A Zulip bot for broadcasting monorepo changes with Claude integration. *)
7
7
8
8
module Config = Config
9
+
module Commands = Commands
10
+
module Admin = Admin
11
+
module Broadcast = Broadcast
12
+
module Changelog = Changelog
13
+
module Loop = Loop
9
14
module Handler = Handler