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>

+356 -102
+1 -1
bin/main.ml
··· 148 148 let members = Poe.Changelog.get_channel_members ~client ~channel:poe_config.channel in 149 149 150 150 (* Generate narrative changelog with Claude *) 151 - match Poe.Changelog.generate ~sw ~proc ~clock ~commits ~members with 151 + match Poe.Changelog.generate ~sw ~proc ~clock ~commits ~members () with 152 152 | None -> 153 153 Logs.err (fun m -> m "Could not generate changelog") 154 154 | Some content ->
+13
lib/admin.ml
··· 6 6 let last_broadcast_key = "poe:broadcast:last_time" 7 7 let last_git_head_key = "poe:broadcast:last_git_head" 8 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 + 9 12 let get_last_broadcast_time storage = 10 13 match Zulip_bot.Storage.get storage last_broadcast_key with 11 14 | None -> None ··· 27 30 28 31 let set_last_git_head storage hash = 29 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 30 43 31 44 let format_time_option = function 32 45 | None -> "never"
+10
lib/admin.mli
··· 32 32 val set_last_git_head : Zulip_bot.Storage.t -> string -> unit 33 33 (** [set_last_git_head storage hash] stores the git HEAD in storage. *) 34 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 + 35 45 (** {1 Command Handlers} *) 36 46 37 47 val handle : storage:Zulip_bot.Storage.t -> Commands.admin_command -> string
+1 -1
lib/broadcast.ml
··· 40 40 let members = Changelog.get_channel_members ~client ~channel:config.Config.channel in 41 41 42 42 (* Generate narrative changelog with Claude *) 43 - match Changelog.generate ~sw ~proc ~clock ~commits ~members with 43 + match Changelog.generate ~sw ~proc ~clock ~commits ~members () with 44 44 | None -> 45 45 Zulip_bot.Response.reply "Could not generate changelog." 46 46 | Some content ->
+103 -23
lib/changelog.ml
··· 13 13 author: string; 14 14 email: string; 15 15 subject: string; 16 + date: string; 16 17 files: string list; 17 18 } 18 19 ··· 21 22 email: string; 22 23 } 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 + 24 51 let get_commit_files ~proc ~cwd ~hash = 25 52 let cmd = ["git"; "diff-tree"; "--no-commit-id"; "--name-only"; "-r"; hash] in 26 53 Log.debug (fun m -> m "Running: %s (in %s)" (String.concat " " cmd) (Eio.Path.native_exn cwd)); ··· 39 66 40 67 let get_git_log ~proc ~cwd ~since_head = 41 68 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 69 + let cmd = ["git"; "log"; "--pretty=format:%h|%an|%ae|%s|%ci"; since_head ^ "..HEAD"] in 43 70 Log.debug (fun m -> m "Running: %s (in %s)" (String.concat " " cmd) (Eio.Path.native_exn cwd)); 44 71 Eio.Switch.run @@ fun sw -> 45 72 let buf = Buffer.create 1024 in ··· 55 82 String.split_on_char '\n' output 56 83 |> List.filter_map (fun line -> 57 84 match String.split_on_char '|' line with 58 - | [hash; author; email; subject] -> 85 + | [hash; author; email; subject; date] -> 59 86 let files = get_commit_files ~proc ~cwd ~hash in 60 - Some { hash; author; email; subject; files } 87 + Some { hash; author; email; subject; date; files } 61 88 | _ -> None) 62 89 | _ -> [] 63 90 64 91 let get_recent_commits ~proc ~cwd ~count = 65 92 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 93 + let cmd = ["git"; "log"; "--pretty=format:%h|%an|%ae|%s|%ci"; "-n"; string_of_int count] in 67 94 Log.debug (fun m -> m "Running: %s (in %s)" (String.concat " " cmd) (Eio.Path.native_exn cwd)); 68 95 Eio.Switch.run @@ fun sw -> 69 96 let buf = Buffer.create 1024 in ··· 79 106 String.split_on_char '\n' output 80 107 |> List.filter_map (fun line -> 81 108 match String.split_on_char '|' line with 82 - | [hash; author; email; subject] -> 109 + | [hash; author; email; subject; date] -> 83 110 let files = get_commit_files ~proc ~cwd ~hash in 84 - Some { hash; author; email; subject; files } 111 + Some { hash; author; email; subject; date; files } 85 112 | _ -> None) 86 113 | _ -> [] 87 114 ··· 139 166 |> List.filter_map subproject_of_file 140 167 |> List.sort_uniq String.compare 141 168 142 - let generate ~sw ~proc ~clock ~commits ~members = 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 () = 143 203 if commits = [] then None 144 204 else begin 145 205 Log.info (fun m -> m "Generating narrative changelog with Claude for %d commits" (List.length commits)); ··· 179 239 180 240 %s 181 241 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. 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) 183 246 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* 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 + ``` 191 256 192 257 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 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 199 262 200 - Write ONLY the bullet points, no preamble or header.|} commits_text subprojects_text members_text 263 + Output ONLY the JSON object, no markdown code fences or other text.|} commits_text subprojects_text members_text 201 264 in 202 265 203 266 let response = ask_claude ~sw ~proc ~clock prompt in 204 267 Log.info (fun m -> m "Claude generated: %s" response); 205 - Some (String.trim 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) 206 286 end
+10 -6
lib/changelog.mli
··· 16 16 author: string; 17 17 email: string; 18 18 subject: string; 19 + date: string; 19 20 files: string list; 20 21 } 21 - (** A git commit with metadata and list of changed files. *) 22 + (** A git commit with metadata, date, and list of changed files. *) 22 23 23 24 type channel_member = { 24 25 full_name: string; ··· 60 61 clock:float Eio.Time.clock_ty Eio.Resource.t -> 61 62 commits:commit list -> 62 63 members:channel_member list -> 64 + ?opamrepo_url:string -> 65 + unit -> 63 66 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 + (** [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. 67 70 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"). 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. 70 74 Zulip @-mentions are used for authors matching channel members. *)
+5 -2
lib/config.ml
··· 10 10 monorepo_path : string; 11 11 admin_emails : string list; 12 12 changes_dir : string; 13 + verse_path : string option; (* Path to verse/ directory containing user monorepos *) 13 14 } 14 15 15 16 let default = { ··· 19 20 monorepo_path = "."; 20 21 admin_emails = []; 21 22 changes_dir = ".changes"; 23 + verse_path = None; 22 24 } 23 25 24 26 let codec = 25 27 Tomlt.( 26 28 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 + 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 }) 29 31 |> mem "channel" string ~dec_absent:default.channel 30 32 ~enc:(fun c -> c.channel) 31 33 |> mem "topic" string ~dec_absent:default.topic ~enc:(fun c -> c.topic) ··· 37 39 ~enc:(fun c -> c.admin_emails) 38 40 |> mem "changes_dir" string ~dec_absent:default.changes_dir 39 41 ~enc:(fun c -> c.changes_dir) 42 + |> opt_mem "verse_path" string ~enc:(fun c -> c.verse_path) 40 43 |> finish)) 41 44 42 45 let load_from_path path =
+2
lib/config.mli
··· 17 17 monorepo_path = "." 18 18 changes_dir = ".changes" 19 19 admin_emails = ["admin@example.com"] 20 + verse_path = "/path/to/verse" 20 21 v} *) 21 22 22 23 type t = { ··· 26 27 monorepo_path : string; (** Path to the monorepo root *) 27 28 admin_emails : string list; (** Emails authorized for admin commands *) 28 29 changes_dir : string; (** Directory for aggregated JSON files *) 30 + verse_path : string option; (** Path to verse/ directory containing user monorepos *) 29 31 } 30 32 31 33 val default : t
+1 -1
lib/dune
··· 1 1 (library 2 2 (name poe) 3 3 (public_name poe) 4 - (libraries eio eio_main zulip zulip.bot claude tomlt tomlt.bytesrw xdge logs ptime ptime.clock.os)) 4 + (libraries eio eio_main zulip zulip.bot claude tomlt tomlt.bytesrw xdge logs ptime ptime.clock.os monopam fpath jsont))
+51 -8
lib/handler.ml
··· 88 88 89 89 **Basic Commands:** 90 90 - `help` or `?` - Show this help message 91 - - `status` - Show bot configuration status 91 + - `status` - Show bot configuration and tracked verse users with repo links 92 92 - `broadcast` / `post` / `changes` - Generate and broadcast changelog with Claude 93 93 - `refresh` / `pull` / `sync` / `update` - Pull from remote and broadcast changes 94 94 ··· 106 106 The bot reads its configuration from `poe.toml` with the following fields: 107 107 - `channel` - The Zulip channel to broadcast to 108 108 - `topic` - The topic for broadcast messages 109 - - `monorepo_path` - Path to the monorepo root 109 + - `verse_path` - Path to verse/ directory containing user monorepos 110 110 - `admin_emails` - List of emails authorized for admin commands|} 111 111 112 - let handle_status config = 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 = 113 138 let admin_list = if config.Config.admin_emails = [] then "none configured" 114 139 else String.concat ", " config.Config.admin_emails 115 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 116 158 Zulip_bot.Response.reply 117 159 (Printf.sprintf 118 160 {|**Poe Bot Status:** 119 161 120 162 - Channel: `%s` 121 163 - Topic: `%s` 122 - - Monorepo path: `%s` 123 - - Admin emails: %s|} 164 + - Verse path: `%s` 165 + - Admin emails: %s 166 + %s|} 124 167 config.Config.channel config.Config.topic 125 - config.Config.monorepo_path admin_list) 168 + verse_path admin_list users_section) 126 169 127 170 let handle_refresh env ~client ~storage ~config = 128 171 let monorepo_path = Eio.Path.(env.fs / config.Config.monorepo_path) in ··· 153 196 let members = Changelog.get_channel_members ~client ~channel:config.Config.channel in 154 197 155 198 (* Generate narrative changelog with Claude *) 156 - match Changelog.generate ~sw:env.sw ~proc:env.process_mgr ~clock:env.clock ~commits ~members with 199 + match Changelog.generate ~sw:env.sw ~proc:env.process_mgr ~clock:env.clock ~commits ~members () with 157 200 | None -> 158 201 Zulip_bot.Response.reply 159 202 (Printf.sprintf "**Refresh completed:**\n\n- %s\n- Could not generate changelog" pull_msg) ··· 223 266 Log.info (fun m -> m "Received message: %s" content); 224 267 match Commands.parse content with 225 268 | Commands.Help -> handle_help () 226 - | Commands.Status -> handle_status config 269 + | Commands.Status -> handle_status env config 227 270 | Commands.Broadcast -> 228 271 Broadcast.run ~sw:env.sw ~proc:env.process_mgr ~clock:env.clock 229 272 ~fs:env.fs ~client ~storage ~config
+159 -60
lib/loop.ml
··· 6 6 let src = Logs.Src.create "poe.loop" ~doc:"Poe polling loop" 7 7 module Log = (val Logs.src_log src : Logs.LOG) 8 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 + 9 70 let run_command ~proc ~cwd cmd = 10 71 let cwd_str = Eio.Path.native_exn cwd in 11 72 Log.debug (fun m -> m "Running: %s (in %s)" (String.concat " " cmd) cwd_str); ··· 17 78 ~stderr:(Eio.Flow.buffer_sink buf_stderr) 18 79 cmd 19 80 in 81 + (* Must await process before reading buffers *) 82 + let status = Eio.Process.await child in 20 83 let stdout = Buffer.contents buf_stdout in 21 84 let stderr = Buffer.contents buf_stderr in 22 - match Eio.Process.await child with 85 + match status with 23 86 | `Exited code -> (code, stdout, stderr) 24 87 | `Signaled sig_ -> (-sig_, stdout, stderr) 25 88 ··· 55 118 let resp = Zulip.Messages.send client msg in 56 119 Log.info (fun m -> m "Broadcast sent, message ID: %d" (Zulip.Message_response.id resp)) 57 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 + 58 194 let run ~sw ~env ~config ~zulip_config ~handler ~interval = 59 195 let fs = Eio.Stdenv.fs env in 60 196 let proc = Eio.Stdenv.process_mgr env in ··· 64 200 let client = Zulip_bot.Bot.create_client ~sw ~env ~config:zulip_config in 65 201 let storage = Zulip_bot.Storage.create client in 66 202 67 - let monorepo_path = Eio.Path.(fs / config.Config.monorepo_path) in 68 - let monorepo_native = Eio.Path.native_exn monorepo_path in 203 + Log.info (fun m -> m "Starting loop with %d second interval" interval); 69 204 70 - Log.info (fun m -> m "Starting loop with %d second interval" interval); 71 - Log.info (fun m -> m "Monorepo path: %s" monorepo_native); 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); 72 214 73 215 let broadcast_loop () = 74 216 let rec loop () = 75 - Log.info (fun m -> m "Checking for changes..."); 217 + Log.info (fun m -> m "Checking for changes across verse users..."); 76 218 77 - (* Pull latest changes from remote *) 78 - let _pull_ok = run_git_pull ~proc ~cwd:monorepo_path in 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)); 79 222 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"); 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; 132 231 133 232 (* Sleep until next check *) 134 233 Log.info (fun m -> m "Sleeping for %d seconds" interval);