My aggregated monorepo of OCaml code, automaintained
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

Squashed 'poe/' changes from 125e71d4..91b087dd

91b087dd poe: fix long prompts
28c662f1 poe: track cross-verse fork activity and de-emphasise metadata in daily updates
0d41ca0d Pass event-level flags through to bot handlers
7a0cf762 poe: fix mentions
57858464 Show active sessions in status command with stats
b80cea64 Add multi-turn session tracking with silent context accumulation
34347a4a Post Claude agent activity to Zulip channel/DM during sessions
41d30ab7 Add per-channel and per-DM session tracking for multi-turn Claude conversations

git-subtree-dir: poe
git-subtree-split: 91b087dd2cc586570f802a9981dd26a737028994

+843 -93
+3
bin/main.ml
··· 60 60 (* Create and run the bot *) 61 61 let handler = Poe.Handler.make_handler handler_env poe_config in 62 62 Logs.info (fun m -> m "Starting Poe bot..."); 63 + (* process_all_messages:true allows the bot to accumulate context from all 64 + messages in active sessions, not just @mentions *) 63 65 Zulip_bot.Bot.run ~sw ~env ~config:zulip_config ~handler 66 + ~process_all_messages:true () 64 67 65 68 let requests_verbose_arg = 66 69 let open Cmdliner in
+198 -46
lib/changelog.ml
··· 28 28 change_type: string; 29 29 } 30 30 31 + type fork_context = { 32 + source_handle: string; (** who owns the upstream repo *) 33 + target_handle: string; (** who made changes to the fork *) 34 + repos: string list; (** which repos are forks *) 35 + } 36 + 37 + type structured_changelog = { 38 + fork_activity: (string * string * changelog_item list) list; 39 + (** (source_handle, target_handle, items) *) 40 + functionality: changelog_item list; 41 + metadata: string list; (** just project names *) 42 + } 43 + 31 44 type changelog_response = { 32 45 items: changelog_item list; 33 46 } ··· 48 61 |> Jsont.Object.mem "items" (Jsont.list changelog_item_codec) ~enc:(fun r -> r.items) 49 62 |> Jsont.Object.finish 50 63 64 + (* Codec for fork_activity entries: {source, target, items} *) 65 + let fork_group_codec : (string * string * changelog_item list) Jsont.t = 66 + Jsont.Object.map 67 + ~kind:"fork_group" 68 + (fun source target items -> (source, target, items)) 69 + |> Jsont.Object.mem "source" Jsont.string ~enc:(fun (s, _, _) -> s) 70 + |> Jsont.Object.mem "target" Jsont.string ~enc:(fun (_, t, _) -> t) 71 + |> Jsont.Object.mem "items" (Jsont.list changelog_item_codec) ~enc:(fun (_, _, i) -> i) 72 + |> Jsont.Object.finish 73 + 74 + let structured_changelog_codec : structured_changelog Jsont.t = 75 + Jsont.Object.map 76 + ~kind:"structured_changelog" 77 + (fun fork_activity functionality metadata -> { fork_activity; functionality; metadata }) 78 + |> Jsont.Object.mem "fork_activity" (Jsont.list fork_group_codec) ~enc:(fun r -> r.fork_activity) 79 + |> Jsont.Object.mem "functionality" (Jsont.list changelog_item_codec) ~enc:(fun r -> r.functionality) 80 + |> Jsont.Object.mem "metadata" (Jsont.list Jsont.string) ~enc:(fun r -> r.metadata) 81 + |> Jsont.Object.finish 82 + 51 83 let get_commit_files ~proc ~cwd ~hash = 52 84 let cmd = ["git"; "diff-tree"; "--no-commit-id"; "--name-only"; "-r"; hash] in 53 85 Log.debug (fun m -> m "Running: %s (in %s)" (String.concat " " cmd) (Eio.Path.native_exn cwd)); ··· 131 163 Log.warn (fun m -> m "Failed to get channel members: %s" (Printexc.to_string e)); 132 164 [] 133 165 134 - let create_claude_client ~sw ~proc ~clock = 166 + let create_claude_client ~sw ~proc ~clock ?(allow_read=false) () = 135 167 let options = 136 168 Claude.Options.default 137 169 |> Claude.Options.with_model `Opus_4_5 138 170 |> Claude.Options.with_permission_mode Claude.Permissions.Mode.Bypass_permissions 139 - |> Claude.Options.with_allowed_tools [] 171 + |> Claude.Options.with_allowed_tools (if allow_read then ["Read"] else []) 140 172 in 141 173 Claude.Client.create ~options ~sw ~process_mgr:proc ~clock () 142 174 143 - let ask_claude ~sw ~proc ~clock prompt = 144 - let client = create_claude_client ~sw ~proc ~clock in 175 + let ask_claude ~sw ~proc ~clock ?(allow_read=false) prompt = 176 + let client = create_claude_client ~sw ~proc ~clock ~allow_read () in 145 177 Claude.Client.query client prompt; 146 178 let responses = Claude.Client.receive_all client in 147 179 let text = ··· 189 221 Log.warn (fun m -> m "Failed to parse JSON response: %s" e); 190 222 Error e 191 223 224 + (* Parse structured changelog JSON from Claude *) 225 + let parse_structured_changelog json_str = 226 + match Jsont_bytesrw.decode_string structured_changelog_codec json_str with 227 + | Ok response -> Ok response 228 + | Error e -> 229 + Log.warn (fun m -> m "Failed to parse structured JSON: %s" e); 230 + Error e 231 + 192 232 (* Build a map from package name to dev-repo URL by scanning the opam repo *) 193 233 let build_package_url_map ~fs ~opamrepo_path = 194 234 match opamrepo_path with ··· 220 260 in 221 261 Printf.sprintf "- **%s**: %s *%s*" project_link item.description item.change_type 222 262 223 - let generate ~sw ~proc ~clock ~fs ~commits ~members ?opamrepo_path () = 263 + (* Format a structured changelog with fork activity, functionality, and metadata sections *) 264 + let format_structured ~package_urls (sc : structured_changelog) = 265 + let buf = Buffer.create 512 in 266 + (* Cross-verse activity *) 267 + if sc.fork_activity <> [] then begin 268 + Buffer.add_string buf "**Cross-verse activity**\n"; 269 + List.iter (fun (source, target, items) -> 270 + Buffer.add_string buf (Printf.sprintf "*%s \u{2192} %s forks:*\n" target source); 271 + List.iter (fun item -> 272 + Buffer.add_string buf (format_item ~package_urls item); 273 + Buffer.add_char buf '\n' 274 + ) items 275 + ) sc.fork_activity; 276 + Buffer.add_char buf '\n' 277 + end; 278 + (* Functionality *) 279 + if sc.functionality <> [] then begin 280 + Buffer.add_string buf "**Functionality**\n"; 281 + List.iter (fun item -> 282 + Buffer.add_string buf (format_item ~package_urls item); 283 + Buffer.add_char buf '\n' 284 + ) sc.functionality; 285 + Buffer.add_char buf '\n' 286 + end; 287 + (* Metadata - single line *) 288 + if sc.metadata <> [] then begin 289 + let linked = List.map (fun proj -> 290 + match Hashtbl.find_opt package_urls proj with 291 + | Some url -> Printf.sprintf "[%s](%s)" proj url 292 + | None -> proj 293 + ) sc.metadata in 294 + Buffer.add_string buf (Printf.sprintf "**Metadata** \u{2014} %s\n" (String.concat ", " linked)) 295 + end; 296 + String.trim (Buffer.contents buf) 297 + 298 + (* Threshold for using staged file approach (50KB) *) 299 + let large_prompt_threshold = 50_000 300 + 301 + (* Build the common instructions part of the prompt *) 302 + let build_instructions ~subprojects_text ~fork_context_text ~members_text ~has_forks = 303 + Printf.sprintf 304 + {|Write a changelog as a JSON object with three sections: 305 + - "fork_activity": array of objects with "source" (upstream owner handle), "target" (person who changed the fork), and "items" (array of changelog items for repos that are forks of another user). %s 306 + - "functionality": array of changelog items for feature additions, bug fixes, enhancements, and other functional changes (NOT forks). Give these expanded descriptions (2-3 sentences). 307 + - "metadata": array of project name strings for changes that are purely metadata (documentation, CI, formatting, version bumps, opam file updates, .ocamlformat changes, README updates). Just list the project names, no descriptions. 308 + 309 + Affected sub-projects: %s 310 + %s 311 + Channel members who can be @mentioned (use exact @**Name** format): 312 + 313 + %s 314 + 315 + Each changelog item has: 316 + - "project": the project/package name (string) 317 + - "description": description of the change, may include @**Name** mentions (string) 318 + - "change_type": one of "new feature", "bug fix", "enhancement", "refactoring" (string) 319 + 320 + Example output: 321 + ```json 322 + { 323 + "fork_activity": [ 324 + {"source": "anil.recoil.org", "target": "gazagnaire.org", "items": [ 325 + {"project": "ocaml-mdns", "description": "Refactored DNS query pipeline to use Eio effects.", "change_type": "enhancement"} 326 + ]} 327 + ], 328 + "functionality": [ 329 + {"project": "ocaml-claudeio", "description": "Added model types for Opus 4.5 and 4.1. This extends the client to support the latest Claude model lineup.", "change_type": "new feature"} 330 + ], 331 + "metadata": ["ocaml-dns", "dune"] 332 + } 333 + ``` 334 + 335 + Guidelines: 336 + 1. One item per logical change (group related commits) 337 + 2. Functionality items should have 2-3 sentence descriptions explaining the change and its purpose 338 + 3. Use @**Name** mentions in the description when authors match channel members 339 + 4. No emojis 340 + 5. Put documentation, CI, formatting, version bumps, and opam metadata changes in "metadata" not "functionality" 341 + 6. If a change is to a forked repo, put it in "fork_activity" grouped by source/target pair 342 + 343 + Output ONLY the JSON object, no markdown code fences or other text.|} 344 + (if has_forks then "Group items by (source, target) pair based on the fork relationships listed above." 345 + else "Leave empty if no fork relationships exist.") 346 + subprojects_text fork_context_text members_text 347 + 348 + let generate ~sw ~proc ~clock ~fs ~commits ~members ?(fork_context=[]) ?opamrepo_path () = 224 349 if commits = [] then None 225 350 else begin 226 351 Log.info (fun m -> m "Generating narrative changelog with Claude for %d commits" (List.length commits)); ··· 250 375 |> String.concat "\n" 251 376 in 252 377 253 - let prompt = Printf.sprintf 254 - {|You are writing a changelog update for a Zulip channel about a monorepo. 378 + (* Format fork context *) 379 + let fork_context_text = match fork_context with 380 + | [] -> "" 381 + | forks -> 382 + let lines = List.map (fun (fc : fork_context) -> 383 + Printf.sprintf "- %s has forked repos from %s: %s" 384 + fc.target_handle fc.source_handle (String.concat ", " fc.repos) 385 + ) forks in 386 + Printf.sprintf "\nFork relationships between verse users:\n%s\n" (String.concat "\n" lines) 387 + in 255 388 256 - Git commits: 389 + let has_forks = fork_context <> [] in 390 + let instructions = build_instructions ~subprojects_text ~fork_context_text ~members_text ~has_forks in 257 391 258 - %s 392 + (* Check if we need to stage the commit data in a file *) 393 + let commits_size = String.length commits_text in 394 + let use_staged_file = commits_size > large_prompt_threshold in 259 395 260 - Affected sub-projects: %s 396 + let response = 397 + if use_staged_file then begin 398 + (* Write commits to a temporary file and ask Claude to read it *) 399 + Log.info (fun m -> m "Large commit data (%d bytes), staging in temporary file" commits_size); 400 + let tmp_dir = Filename.get_temp_dir_name () in 401 + let tmp_file = Filename.concat tmp_dir (Printf.sprintf "poe-commits-%d.txt" (Unix.getpid ())) in 402 + (* Write the file using Eio *) 403 + let tmp_path = Eio.Path.(fs / tmp_file) in 404 + Eio.Path.save ~create:(`Or_truncate 0o644) tmp_path commits_text; 405 + Log.info (fun m -> m "Staged commit data to %s" tmp_file); 261 406 262 - Channel members who can be @mentioned (use exact @**Name** format): 407 + let prompt = Printf.sprintf 408 + {|You are writing a changelog update for a Zulip channel about a monorepo. 263 409 410 + The git commit data is too large to include inline. Please read it from this file: 264 411 %s 265 412 266 - Write a changelog as a JSON object with an "items" array. Each item should have: 267 - - "project": the project/package name (string) 268 - - "description": description of the change, may include @**Name** mentions (string) 269 - - "change_type": one of "new feature", "bug fix", "enhancement", "refactoring", "documentation", etc. (string) 413 + After reading the file, generate the changelog. 270 414 271 - Example output: 272 - ```json 273 - { 274 - "items": [ 275 - {"project": "ocaml-claudeio", "description": "Added model types for Opus 4.5 and 4.1.", "change_type": "new feature"}, 276 - {"project": "ocaml-zulip", "description": "Fixed encoding bug in channel name lookups that affected names with spaces.", "change_type": "bug fix"} 277 - ] 278 - } 279 - ``` 415 + %s|} tmp_file instructions 416 + in 280 417 281 - Guidelines: 282 - 1. One item per logical change (group related commits) 283 - 2. One or two sentences for the description 284 - 3. Use @**Name** mentions in the description when authors match channel members 285 - 4. No emojis 418 + let result = ask_claude ~sw ~proc ~clock ~allow_read:true prompt in 419 + (* Clean up the temporary file *) 420 + (try Eio.Path.unlink tmp_path with _ -> ()); 421 + result 422 + end else begin 423 + (* Small enough to include inline *) 424 + let prompt = Printf.sprintf 425 + {|You are writing a changelog update for a Zulip channel about a monorepo. 426 + 427 + Git commits: 428 + 429 + %s 286 430 287 - Output ONLY the JSON object, no markdown code fences or other text.|} commits_text subprojects_text members_text 431 + %s|} commits_text instructions 432 + in 433 + ask_claude ~sw ~proc ~clock prompt 434 + end 288 435 in 289 436 290 - let response = ask_claude ~sw ~proc ~clock prompt in 291 437 Log.info (fun m -> m "Claude generated: %s" response); 292 438 293 - (* Parse JSON and format with links *) 294 - match parse_changelog_json (String.trim response) with 295 - | Ok items -> 296 - let last_date = most_recent_date commits in 297 - let header = match last_date with 298 - | Some d -> Printf.sprintf "**Changes as of %s**\n\n" (date_only d) 299 - | None -> "" 300 - in 301 - let formatted = items 302 - |> List.map (format_item ~package_urls) 303 - |> String.concat "\n" 304 - in 439 + let last_date = most_recent_date commits in 440 + let header = match last_date with 441 + | Some d -> Printf.sprintf "**Changes as of %s**\n\n" (date_only d) 442 + | None -> "" 443 + in 444 + 445 + (* Try structured format first, fall back to flat format *) 446 + match parse_structured_changelog (String.trim response) with 447 + | Ok sc -> 448 + let formatted = format_structured ~package_urls sc in 305 449 Some (header ^ formatted) 306 450 | Error _ -> 307 - (* Fallback: return raw response if JSON parsing fails *) 308 - Log.warn (fun m -> m "Using raw Claude response as fallback"); 309 - Some (String.trim response) 451 + (* Fallback: try flat format *) 452 + match parse_changelog_json (String.trim response) with 453 + | Ok items -> 454 + let formatted = items 455 + |> List.map (format_item ~package_urls) 456 + |> String.concat "\n" 457 + in 458 + Some (header ^ formatted) 459 + | Error _ -> 460 + Log.warn (fun m -> m "Using raw Claude response as fallback"); 461 + Some (String.trim response) 310 462 end
+23 -8
lib/changelog.mli
··· 53 53 (** [get_channel_members ~client ~channel] returns the members of [channel] 54 54 for mention matching. *) 55 55 56 + (** {1 Utilities} *) 57 + 58 + val affected_subprojects : commit list -> string list 59 + (** [affected_subprojects commits] returns unique sub-project names from commit file paths. *) 60 + 61 + (** {1 Fork Context} *) 62 + 63 + type fork_context = { 64 + source_handle: string; 65 + target_handle: string; 66 + repos: string list; 67 + } 68 + (** Fork relationship: [target_handle] has repos forked from [source_handle]. *) 69 + 56 70 (** {1 Changelog Generation} *) 57 71 58 72 val generate : ··· 62 76 fs:_ Eio.Path.t -> 63 77 commits:commit list -> 64 78 members:channel_member list -> 79 + ?fork_context:fork_context list -> 65 80 ?opamrepo_path:Fpath.t -> 66 81 unit -> 67 82 string option 68 - (** [generate ~sw ~proc ~clock ~fs ~commits ~members ?opamrepo_path ()] generates 69 - a bullet-point changelog using Claude. Returns [None] if commits is empty, 70 - or [Some changelog] with the generated text. 83 + (** [generate ~sw ~proc ~clock ~fs ~commits ~members ?fork_context ?opamrepo_path ()] 84 + generates a structured changelog using Claude. 85 + 86 + When [fork_context] is provided, the output is organized into three sections: 87 + - Cross-verse activity: changes to repos forked from other verse users 88 + - Functionality: feature/bugfix/enhancement changes with expanded descriptions 89 + - Metadata: documentation, CI, formatting changes listed as project names only 71 90 72 - Each bullet has the project name (linked to the actual project repository 73 - from the opam metadata's dev-repo field if [opamrepo_path] is provided), 74 - a description of the change, and the change type in italics. 75 - The output includes a header with the date of the most recent commit. 76 - Zulip mentions are used for authors matching channel members. *) 91 + Returns [None] if commits is empty, or [Some changelog] with the formatted text. *)
+2
lib/commands.ml
··· 15 15 | Status 16 16 | Broadcast 17 17 | Refresh 18 + | Clear_session 18 19 | Admin of admin_command 19 20 | Unknown of string 20 21 ··· 41 42 | "status" -> Status 42 43 | "broadcast" | "post changes" | "post" | "changes" -> Broadcast 43 44 | "refresh" | "pull" | "sync" | "update" -> Refresh 45 + | "clear" | "new" | "reset" | "clear session" | "new session" -> Clear_session 44 46 | _ -> 45 47 if String.starts_with ~prefix:"admin " content then 46 48 let args = String.sub content 6 (String.length content - 6) in
+1
lib/commands.mli
··· 22 22 | Status (** Show bot configuration status *) 23 23 | Broadcast (** Broadcast new changes *) 24 24 | Refresh (** Pull from remote, regenerate changes, and broadcast *) 25 + | Clear_session (** Clear conversation session for this channel/DM *) 25 26 | Admin of admin_command (** Admin commands (require authorization) *) 26 27 | Unknown of string (** Unrecognized command - pass to Claude *) 27 28
+296 -36
lib/handler.ml
··· 14 14 fs : Eio.Fs.dir_ty Eio.Path.t; 15 15 } 16 16 17 + (** In-memory tracking of active sessions. 18 + A session becomes active when the bot is first @mentioned in a channel/DM. 19 + Once active, all messages in that scope are accumulated into context. 20 + Resets on bot restart (intentional - requires new @mention to reactivate). *) 21 + module Active_sessions = struct 22 + (* Store scope and activation time *) 23 + let sessions : (string, Session.scope * float) Hashtbl.t = Hashtbl.create 16 24 + 25 + let activate scope = 26 + let key = Session.scope_to_string scope in 27 + if not (Hashtbl.mem sessions key) then begin 28 + Hashtbl.add sessions key (scope, Unix.gettimeofday ()); 29 + Log.info (fun m -> m "Session activated for %s" key) 30 + end 31 + 32 + let is_active scope = 33 + let key = Session.scope_to_string scope in 34 + Hashtbl.mem sessions key 35 + 36 + let deactivate scope = 37 + let key = Session.scope_to_string scope in 38 + Hashtbl.remove sessions key; 39 + Log.info (fun m -> m "Session deactivated for %s" key) 40 + 41 + let list_all () = 42 + Hashtbl.fold (fun _key (scope, activated_at) acc -> 43 + (scope, activated_at) :: acc 44 + ) sessions [] 45 + end 46 + 47 + (** Strip any @**name** mention from the start of content. 48 + This handles display names like @**Poe** that don't match email patterns. *) 49 + let strip_leading_mention content = 50 + let s = String.trim content in 51 + if String.length s >= 5 && String.sub s 0 3 = "@**" then 52 + match String.index_from_opt s 3 '*' with 53 + | Some i when i + 1 < String.length s && s.[i+1] = '*' -> 54 + (* Found closing **, strip the mention *) 55 + String.trim (String.sub s (i + 2) (String.length s - i - 2)) 56 + | _ -> s 57 + else s 58 + 17 59 let run_git_pull ~proc ~cwd = 18 60 Log.info (fun m -> m "Pulling latest changes from remote"); 19 61 Eio.Switch.run @@ fun sw -> ··· 69 111 Claude.Client.create ~options ~sw:env.sw ~process_mgr:env.process_mgr 70 112 ~clock:env.clock () 71 113 114 + (** Format tool use for Zulip richtext display *) 115 + let format_tool_use (tool : Claude.Response.Tool_use.t) = 116 + let name = Claude.Response.Tool_use.name tool in 117 + let input = Claude.Response.Tool_use.input tool in 118 + (* Extract key parameters for common tools *) 119 + let params = match name with 120 + | "Read" -> 121 + Claude.Tool_input.get_string input "file_path" 122 + |> Option.map (fun p -> Printf.sprintf "`%s`" p) 123 + |> Option.value ~default:"" 124 + | "Glob" -> 125 + Claude.Tool_input.get_string input "pattern" 126 + |> Option.map (fun p -> Printf.sprintf "pattern: `%s`" p) 127 + |> Option.value ~default:"" 128 + | "Grep" -> 129 + let pattern = Claude.Tool_input.get_string input "pattern" |> Option.value ~default:"" in 130 + let path = Claude.Tool_input.get_string input "path" |> Option.value ~default:"." in 131 + Printf.sprintf "`%s` in `%s`" pattern path 132 + | "Edit" -> 133 + Claude.Tool_input.get_string input "file_path" 134 + |> Option.map (fun p -> Printf.sprintf "`%s`" p) 135 + |> Option.value ~default:"" 136 + | "Write" -> 137 + Claude.Tool_input.get_string input "file_path" 138 + |> Option.map (fun p -> Printf.sprintf "`%s`" p) 139 + |> Option.value ~default:"" 140 + | "Bash" -> 141 + Claude.Tool_input.get_string input "command" 142 + |> Option.map (fun c -> 143 + let truncated = if String.length c > 60 then String.sub c 0 57 ^ "..." else c in 144 + Printf.sprintf "`%s`" truncated) 145 + |> Option.value ~default:"" 146 + | _ -> "" 147 + in 148 + if params = "" then 149 + Printf.sprintf "> :gear: **%s**" name 150 + else 151 + Printf.sprintf "> :gear: **%s** %s" name params 152 + 153 + (** Format thinking block for Zulip richtext display *) 154 + let format_thinking (thinking : Claude.Response.Thinking.t) = 155 + let content = Claude.Response.Thinking.content thinking in 156 + (* Truncate long thinking and format as quote *) 157 + let truncated = 158 + if String.length content > 200 then 159 + String.sub content 0 197 ^ "..." 160 + else content 161 + in 162 + Printf.sprintf "> :thought_balloon: *%s*" truncated 163 + 164 + (** Format error for Zulip richtext display *) 165 + let format_error (err : Claude.Response.Error.t) = 166 + let msg = Claude.Response.Error.message err in 167 + Printf.sprintf "> :warning: **Error:** %s" msg 168 + 169 + (** Post a message to the appropriate Zulip channel/DM based on scope *) 170 + let post_to_scope ~client ~(scope : Session.scope) content = 171 + let message = match scope with 172 + | Session.Channel { stream; topic } -> 173 + Zulip.Message.create ~type_:`Channel ~to_:[stream] ~topic ~content () 174 + | Session.Direct { user_email; _ } -> 175 + Zulip.Message.create ~type_:`Direct ~to_:[user_email] ~content () 176 + in 177 + let _resp = Zulip.Messages.send client message in 178 + () 179 + 72 180 let ask_claude env prompt = 73 181 let client = create_claude_client env in 74 182 Claude.Client.query client prompt; ··· 82 190 in 83 191 String.concat "" text 84 192 193 + (** Ask Claude with streaming responses posted to Zulip *) 194 + let ask_claude_with_session_streaming env ~zulip_client ~storage msg user_content = 195 + let scope = Session.scope_of_message msg in 196 + let now = Unix.gettimeofday () in 197 + let session = Session.load storage ~scope ~now in 198 + let session = Session.add_user_message session ~content:user_content ~now in 199 + 200 + (* Build prompt with session context *) 201 + let context_section = match Session.build_context session with 202 + | None -> "" 203 + | Some ctx -> ctx ^ "\n\n---\n\n" 204 + in 205 + let prompt = 206 + Printf.sprintf 207 + {|%sThe user sent this message to the Poe Zulip bot: 208 + 209 + %s 210 + 211 + Please help them. If they're asking about adding features to the bot, read the bot's source code in the poe/ directory first. 212 + If they're asking about the monorepo or daily changes, help them understand the content. 213 + Keep your response concise and suitable for a Zulip message.|} 214 + context_section user_content 215 + in 216 + 217 + (* Create Claude client and start query *) 218 + let claude_client = create_claude_client env in 219 + Claude.Client.query claude_client prompt; 220 + 221 + (* Accumulate text and track agent messages *) 222 + let text_buffer = Buffer.create 1024 in 223 + let agent_messages = ref [] in 224 + 225 + (* Create streaming handler that posts agent messages to Zulip *) 226 + let handler = object 227 + inherit Claude.Handler.default 228 + 229 + method! on_text t = 230 + Buffer.add_string text_buffer (Claude.Response.Text.content t) 231 + 232 + method! on_tool_use t = 233 + let formatted = format_tool_use t in 234 + agent_messages := formatted :: !agent_messages; 235 + Log.debug (fun m -> m "Tool use: %s" (Claude.Response.Tool_use.name t)) 236 + 237 + method! on_thinking t = 238 + let formatted = format_thinking t in 239 + agent_messages := formatted :: !agent_messages; 240 + Log.debug (fun m -> m "Thinking: %s" (String.sub (Claude.Response.Thinking.content t) 0 (min 50 (String.length (Claude.Response.Thinking.content t))))) 241 + 242 + method! on_error t = 243 + let formatted = format_error t in 244 + agent_messages := formatted :: !agent_messages; 245 + Log.warn (fun m -> m "Claude error: %s" (Claude.Response.Error.message t)) 246 + 247 + method! on_complete c = 248 + let cost = Claude.Response.Complete.total_cost_usd c |> Option.value ~default:0.0 in 249 + let turns = Claude.Response.Complete.num_turns c in 250 + Log.info (fun m -> m "Claude complete: %d turns, $%.4f" turns cost) 251 + end in 252 + 253 + (* Run the streaming handler *) 254 + Claude.Client.run claude_client ~handler; 255 + 256 + (* Post agent messages summary if any occurred *) 257 + let agent_msgs = List.rev !agent_messages in 258 + if agent_msgs <> [] then begin 259 + let agent_summary = String.concat "\n" agent_msgs in 260 + let header = Printf.sprintf "**Agent activity:**\n%s" agent_summary in 261 + post_to_scope ~client:zulip_client ~scope header 262 + end; 263 + 264 + let response = Buffer.contents text_buffer in 265 + 266 + (* Save the updated session with the response *) 267 + let now = Unix.gettimeofday () in 268 + let session = Session.add_assistant_message session ~content:response ~now in 269 + Session.save storage ~scope session; 270 + 271 + Log.info (fun m -> m "Session for %s: %s" 272 + (Session.scope_to_string scope) (Session.stats session)); 273 + response 274 + 275 + (** Silently accumulate a message into the session without calling Claude. 276 + Used when the bot is not @mentioned but the session is active. *) 277 + let accumulate_message_silently ~storage msg = 278 + let scope = Session.scope_of_message msg in 279 + let now = Unix.gettimeofday () in 280 + let session = Session.load storage ~scope ~now in 281 + let content = Zulip_bot.Message.content msg in 282 + let sender = Zulip_bot.Message.sender_full_name msg in 283 + (* Include sender name in the accumulated content for context *) 284 + let annotated_content = Printf.sprintf "[%s]: %s" sender content in 285 + let session = Session.add_user_message session ~content:annotated_content ~now in 286 + Session.save storage ~scope session; 287 + Log.debug (fun m -> m "Accumulated message from %s into session for %s" 288 + sender (Session.scope_to_string scope)) 289 + 85 290 let handle_help () = 86 291 Zulip_bot.Response.reply 87 292 {|**Poe Bot Commands:** ··· 91 296 - `status` - Show bot configuration and tracked verse users with repo links 92 297 - `broadcast` / `post` / `changes` - Generate and broadcast changelog with Claude 93 298 - `refresh` / `pull` / `sync` / `update` - Pull from remote and broadcast changes 299 + - `clear` / `new` / `reset` - Clear conversation session and start fresh 94 300 95 301 **Admin Commands:** (require authorization) 96 302 - `admin last-broadcast` - Show last broadcast time and git HEAD ··· 99 305 - `admin storage get <key>` - Get value for a storage key 100 306 - `admin storage delete <key>` - Delete a storage key 101 307 308 + **Conversation Sessions:** 309 + Poe maintains separate conversation sessions for each channel topic and DM. 310 + Your conversation history is preserved within each context, allowing multi-turn 311 + conversations with Claude. Sessions expire after 1 hour of inactivity. 312 + Use `clear` to start a fresh conversation in the current context. 313 + 102 314 **Other Messages:** 103 315 Any other message will be interpreted by Claude to help you understand or modify the bot. 104 316 ··· 134 346 | None -> None 135 347 ) subdirs 136 348 137 - let handle_status env config = 349 + let format_duration seconds = 350 + if seconds < 60.0 then Printf.sprintf "%.0fs" seconds 351 + else if seconds < 3600.0 then Printf.sprintf "%.0fm" (seconds /. 60.0) 352 + else Printf.sprintf "%.1fh" (seconds /. 3600.0) 353 + 354 + let handle_status env ~storage config = 138 355 let admin_list = if config.Config.admin_emails = [] then "none configured" 139 356 else String.concat ", " config.Config.admin_emails 140 357 in ··· 155 372 handle mono_url opam_url) 156 373 |> String.concat "\n") 157 374 in 375 + (* Build active sessions section *) 376 + let active_sessions = Active_sessions.list_all () in 377 + let now = Unix.gettimeofday () in 378 + let sessions_section = 379 + if active_sessions = [] then 380 + "- Active sessions: none" 381 + else 382 + let session_lines = active_sessions |> List.map (fun (scope, activated_at) -> 383 + let session = Session.load storage ~scope ~now in 384 + let scope_mention = Session.scope_to_mention scope in 385 + let active_for = format_duration (now -. activated_at) in 386 + let stats = Session.stats session in 387 + Printf.sprintf " - %s: %s (active for %s)" scope_mention stats active_for 388 + ) in 389 + Printf.sprintf "- Active sessions (%d):\n%s" 390 + (List.length active_sessions) 391 + (String.concat "\n" session_lines) 392 + in 158 393 Zulip_bot.Response.reply 159 394 (Printf.sprintf 160 395 {|**Poe Bot Status:** ··· 163 398 - Topic: `%s` 164 399 - Verse path: `%s` 165 400 - Admin emails: %s 401 + %s 166 402 %s|} 167 403 config.Config.channel config.Config.topic 168 - verse_path admin_list users_section) 404 + verse_path admin_list users_section sessions_section) 169 405 170 406 let handle_refresh env ~client ~storage ~config = 171 407 let monorepo_path = Eio.Path.(env.fs / config.Config.monorepo_path) in ··· 215 451 ~content:(Printf.sprintf "**Refresh triggered manually**\n\n%s" content) 216 452 end 217 453 218 - let handle_claude_query env msg = 454 + let handle_claude_query env ~zulip_client ~storage msg = 219 455 let content = Zulip_bot.Message.content msg in 220 456 Log.info (fun m -> m "Asking Claude: %s" content); 221 - let prompt = 222 - Printf.sprintf 223 - {|The user sent this message to the Poe Zulip bot: 224 - 225 - %s 226 - 227 - Please help them. If they're asking about adding features to the bot, read the bot's source code in the poe/ directory first. 228 - If they're asking about the monorepo or daily changes, help them understand the content. 229 - Keep your response concise and suitable for a Zulip message.|} 230 - content 231 - in 232 - let response = ask_claude env prompt in 457 + let response = ask_claude_with_session_streaming env ~zulip_client ~storage msg content in 233 458 Log.info (fun m -> m "Claude response: %s" response); 234 459 Zulip_bot.Response.reply response 460 + 461 + let handle_clear_session ~storage msg = 462 + let scope = Session.scope_of_message msg in 463 + Session.clear storage ~scope; 464 + Zulip_bot.Response.reply 465 + (Printf.sprintf "Session cleared for %s. Starting fresh conversation." 466 + (Session.scope_to_string scope)) 235 467 236 468 let is_admin config ~storage msg = 237 469 let sender_id = Zulip_bot.Message.sender_id msg in ··· 253 485 List.mem sender_email config.Config.admin_emails 254 486 255 487 let make_handler env config = 256 - fun ~storage ~identity msg -> 488 + fun ~storage ~identity ~flags msg -> 257 489 let bot_email = identity.Zulip_bot.Bot.email in 258 490 let sender_email = Zulip_bot.Message.sender_email msg in 491 + (* Ignore messages from the bot itself *) 259 492 if sender_email = bot_email then Zulip_bot.Response.silent 260 493 else 261 - let client = Zulip_bot.Storage.client storage in 262 - let content = 263 - Zulip_bot.Message.strip_mention msg ~user_email:bot_email 264 - |> String.trim 265 - in 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 273 - | Commands.Refresh -> 274 - handle_refresh env ~client ~storage ~config 275 - | Commands.Admin cmd -> 276 - if is_admin config ~storage msg then 277 - Zulip_bot.Response.reply (Admin.handle ~storage cmd) 278 - else 279 - Zulip_bot.Response.reply "Admin commands require authorization. Contact an admin to be added to the admin_emails list." 280 - | Commands.Unknown _ -> handle_claude_query env msg 494 + let scope = Session.scope_of_message msg in 495 + let is_mentioned = List.mem "mentioned" flags in 496 + let is_private = Zulip_bot.Message.is_private msg in 497 + 498 + (* Check if this is a message we should respond to *) 499 + if is_mentioned || is_private then begin 500 + (* Activate the session on first @mention or DM *) 501 + Active_sessions.activate scope; 502 + 503 + let client = Zulip_bot.Storage.client storage in 504 + let content = 505 + Zulip_bot.Message.content msg 506 + |> strip_leading_mention 507 + in 508 + Log.info (fun m -> m "Received message (mentioned): %s" content); 509 + match Commands.parse content with 510 + | Commands.Help -> handle_help () 511 + | Commands.Status -> handle_status env ~storage config 512 + | Commands.Broadcast -> 513 + Broadcast.run ~sw:env.sw ~proc:env.process_mgr ~clock:env.clock 514 + ~fs:env.fs ~client ~storage ~config 515 + | Commands.Refresh -> 516 + handle_refresh env ~client ~storage ~config 517 + | Commands.Admin cmd -> 518 + if is_admin config ~storage msg then 519 + Zulip_bot.Response.reply (Admin.handle ~storage cmd) 520 + else 521 + Zulip_bot.Response.reply "Admin commands require authorization. Contact an admin to be added to the admin_emails list." 522 + | Commands.Clear_session -> 523 + (* Also deactivate the in-memory session *) 524 + Active_sessions.deactivate scope; 525 + handle_clear_session ~storage msg 526 + | Commands.Unknown _ -> handle_claude_query env ~zulip_client:client ~storage msg 527 + end 528 + else if Active_sessions.is_active scope then begin 529 + (* Session is active but bot not mentioned - accumulate silently *) 530 + Log.debug (fun m -> m "Accumulating message in active session for %s" 531 + (Session.scope_to_string scope)); 532 + accumulate_message_silently ~storage msg; 533 + Zulip_bot.Response.silent 534 + end 535 + else begin 536 + (* Session not active and not mentioned - ignore *) 537 + Log.debug (fun m -> m "Ignoring message (session not active for %s)" 538 + (Session.scope_to_string scope)); 539 + Zulip_bot.Response.silent 540 + end
+74 -3
lib/loop.ml
··· 136 136 let resp = Zulip.Messages.send client msg in 137 137 Log.info (fun m -> m "Broadcast sent, message ID: %d" (Zulip.Message_response.id resp)) 138 138 139 + (* Detect fork relationships: check if this user's affected repos appear as 140 + forks in other users' sources.toml, or vice versa *) 141 + let detect_fork_context ~fs ~verse_path ~handle ~affected_repos users = 142 + (* For each other user, load their sources.toml and check for upstream refs *) 143 + let forks = List.filter_map (fun (other : verse_user) -> 144 + if other.handle = handle then None 145 + else 146 + let sources_path = Fpath.(v verse_path / other.handle / "sources.toml") in 147 + match Monopam.Sources_registry.load ~fs sources_path with 148 + | Error _ -> None 149 + | Ok registry -> 150 + (* Check if any of the other user's entries have upstream pointing to 151 + repos that this user also has *) 152 + let forked_repos = List.filter_map (fun (subtree, entry) -> 153 + match entry.Monopam.Sources_registry.upstream with 154 + | Some _upstream when List.mem subtree affected_repos -> 155 + Some subtree 156 + | _ -> 157 + (* Also check if this user's sources.toml has entries with 158 + upstream pointing to the other user's repos *) 159 + None 160 + ) (Monopam.Sources_registry.to_list registry) in 161 + match forked_repos with 162 + | [] -> None 163 + | repos -> Some { Changelog.source_handle = handle; 164 + target_handle = other.handle; 165 + repos } 166 + ) users in 167 + (* Also check the reverse: if this user has sources with upstream pointing 168 + to other users *) 169 + let own_sources_path = Fpath.(v verse_path / handle / "sources.toml") in 170 + let reverse_forks = match Monopam.Sources_registry.load ~fs own_sources_path with 171 + | Error _ -> [] 172 + | Ok registry -> 173 + List.filter_map (fun (subtree, entry) -> 174 + match entry.Monopam.Sources_registry.upstream with 175 + | Some upstream_url -> 176 + (* Try to match upstream URL to a verse user *) 177 + let matching_user = List.find_opt (fun (other : verse_user) -> 178 + other.handle <> handle && 179 + (String.starts_with ~prefix:other.handle upstream_url || 180 + String.starts_with ~prefix:other.monorepo_url upstream_url) 181 + ) users in 182 + (match matching_user with 183 + | Some other when List.mem subtree affected_repos -> 184 + Some { Changelog.source_handle = other.handle; 185 + target_handle = handle; 186 + repos = [subtree] } 187 + | _ -> None) 188 + | None -> None 189 + ) (Monopam.Sources_registry.to_list registry) 190 + in 191 + (* Merge: group by (source, target) pair *) 192 + let all = forks @ reverse_forks in 193 + let merged = Hashtbl.create 8 in 194 + List.iter (fun (fc : Changelog.fork_context) -> 195 + let key = (fc.source_handle, fc.target_handle) in 196 + let existing = try Hashtbl.find merged key with Not_found -> [] in 197 + Hashtbl.replace merged key (fc.repos @ existing) 198 + ) all; 199 + Hashtbl.fold (fun (source_handle, target_handle) repos acc -> 200 + let repos = List.sort_uniq String.compare repos in 201 + { Changelog.source_handle; target_handle; repos } :: acc 202 + ) merged [] 203 + 139 204 (* Process a single verse user: pull, check HEAD, generate changelog if needed *) 140 - let process_verse_user ~sw ~proc ~clock ~fs ~storage ~client ~config user = 205 + let process_verse_user ~sw ~proc ~clock ~fs ~storage ~client ~config ~verse_path ~all_users user = 141 206 let handle = user.handle in 142 207 Log.info (fun m -> m "Checking %s for changes..." handle); 143 208 ··· 177 242 (* Get channel members for @mentions *) 178 243 let members = Changelog.get_channel_members ~client ~channel:config.Config.channel in 179 244 245 + (* Detect fork relationships *) 246 + let affected = Changelog.affected_subprojects commits in 247 + let fork_context = detect_fork_context ~fs ~verse_path 248 + ~handle:user.handle ~affected_repos:affected all_users in 249 + 180 250 (* Generate narrative changelog with Claude *) 181 251 match Changelog.generate ~sw ~proc ~clock ~fs ~commits ~members 182 - ?opamrepo_path:user.opamrepo_path () with 252 + ~fork_context ?opamrepo_path:user.opamrepo_path () with 183 253 | None -> 184 254 Log.info (fun m -> m "[%s] No changelog generated" handle); 185 255 Option.iter (Admin.set_user_git_head storage ~handle) current_head ··· 241 311 (* Process each user *) 242 312 List.iter (fun user -> 243 313 try 244 - process_verse_user ~sw ~proc ~clock ~fs ~storage ~client ~config user 314 + process_verse_user ~sw ~proc ~clock ~fs ~storage ~client ~config 315 + ~verse_path ~all_users:users user 245 316 with e -> 246 317 Log.warn (fun m -> m "[%s] Error processing user: %s" 247 318 user.handle (Printexc.to_string e))
+1
lib/poe.ml
··· 12 12 module Changelog = Changelog 13 13 module Loop = Loop 14 14 module Handler = Handler 15 + module Session = Session
+178
lib/session.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2026 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Per-channel and per-DM Claude session management. 7 + 8 + Sessions maintain conversation context independently for each Zulip 9 + channel or DM thread, enabling multi-turn conversations with Claude. *) 10 + 11 + let src = Logs.Src.create "poe.session" ~doc:"Poe session management" 12 + 13 + module Log = (val Logs.src_log src : Logs.LOG) 14 + 15 + (** A conversation turn in a session *) 16 + type role = User | Assistant 17 + 18 + type turn = { role : role; content : string; timestamp : float } 19 + 20 + let role_of_string = function 21 + | "user" -> User 22 + | "assistant" -> Assistant 23 + | _ -> User 24 + 25 + let role_to_string = function 26 + | User -> "user" 27 + | Assistant -> "assistant" 28 + 29 + let turn_jsont : turn Jsont.t = 30 + Jsont.Object.map ~kind:"Turn" (fun role_str content timestamp -> 31 + { role = role_of_string role_str; content; timestamp }) 32 + |> Jsont.Object.mem "role" Jsont.string ~enc:(fun t -> role_to_string t.role) 33 + |> Jsont.Object.mem "content" Jsont.string ~enc:(fun t -> t.content) 34 + |> Jsont.Object.mem "timestamp" Jsont.number ~enc:(fun t -> t.timestamp) 35 + |> Jsont.Object.finish 36 + 37 + (** Session scope - either a channel+topic or a DM with a user *) 38 + type scope = 39 + | Channel of { stream : string; topic : string } 40 + | Direct of { user_email : string; user_full_name : string } 41 + 42 + let scope_to_key = function 43 + | Channel { stream; topic } -> 44 + Printf.sprintf "poe:session:channel:%s:%s" stream topic 45 + | Direct { user_email; _ } -> Printf.sprintf "poe:session:dm:%s" user_email 46 + 47 + let scope_to_string = function 48 + | Channel { stream; topic } -> Printf.sprintf "channel %s > %s" stream topic 49 + | Direct { user_full_name; _ } -> Printf.sprintf "DM with %s" user_full_name 50 + 51 + let scope_to_mention = function 52 + | Channel { stream; topic } -> Printf.sprintf "#**%s>%s**" stream topic 53 + | Direct { user_full_name; _ } -> Printf.sprintf "@**%s**" user_full_name 54 + 55 + (** Session data stored in Zulip bot storage *) 56 + type t = { turns : turn list; created_at : float; updated_at : float } 57 + 58 + let session_jsont : t Jsont.t = 59 + Jsont.Object.map ~kind:"Session" (fun turns created_at updated_at -> 60 + { turns; created_at; updated_at }) 61 + |> Jsont.Object.mem "turns" (Jsont.list turn_jsont) ~enc:(fun t -> t.turns) 62 + |> Jsont.Object.mem "created_at" Jsont.number ~enc:(fun t -> t.created_at) 63 + |> Jsont.Object.mem "updated_at" Jsont.number ~enc:(fun t -> t.updated_at) 64 + |> Jsont.Object.finish 65 + 66 + let empty ~now = { turns = []; created_at = now; updated_at = now } 67 + 68 + let max_turns = 20 69 + (** Maximum turns to keep in a session for context window management *) 70 + 71 + (* Sessions no longer expire automatically - only cleared via explicit command *) 72 + 73 + (** Extract session scope from a Zulip bot message *) 74 + let scope_of_message (msg : Zulip_bot.Message.t) : scope = 75 + match msg with 76 + | Zulip_bot.Message.Private { common; _ } -> 77 + Direct { user_email = common.sender_email; user_full_name = common.sender_full_name } 78 + | Zulip_bot.Message.Stream { common = _; display_recipient; subject; _ } -> 79 + Channel { stream = display_recipient; topic = subject } 80 + | Zulip_bot.Message.Unknown { common; _ } -> 81 + (* Fall back to treating as DM *) 82 + Direct { user_email = common.sender_email; user_full_name = common.sender_full_name } 83 + 84 + (** Load session from storage *) 85 + let load storage ~scope ~now : t = 86 + let key = scope_to_key scope in 87 + match Zulip_bot.Storage.get storage key with 88 + | None -> 89 + Log.debug (fun m -> m "No existing session for %s" (scope_to_string scope)); 90 + empty ~now 91 + | Some "" -> 92 + Log.debug (fun m -> m "Empty session for %s" (scope_to_string scope)); 93 + empty ~now 94 + | Some json_str -> ( 95 + match Jsont_bytesrw.decode_string' session_jsont json_str with 96 + | Error err -> 97 + Log.warn (fun m -> 98 + m "Failed to parse session for %s: %s" (scope_to_string scope) 99 + (Jsont.Error.to_string err)); 100 + empty ~now 101 + | Ok session -> 102 + (* Sessions no longer expire - only cleared via explicit command *) 103 + Log.debug (fun m -> 104 + m "Loaded session for %s with %d turns" (scope_to_string scope) 105 + (List.length session.turns)); 106 + session) 107 + 108 + (** Save session to storage *) 109 + let save storage ~scope session = 110 + let key = scope_to_key scope in 111 + match Jsont_bytesrw.encode_string' session_jsont session with 112 + | Error err -> 113 + Log.err (fun m -> 114 + m "Failed to encode session: %s" (Jsont.Error.to_string err)) 115 + | Ok json_str -> 116 + Zulip_bot.Storage.set storage key json_str; 117 + Log.debug (fun m -> 118 + m "Saved session for %s with %d turns" (scope_to_string scope) 119 + (List.length session.turns)) 120 + 121 + (** Add a user message to the session *) 122 + let add_user_message session ~content ~now = 123 + let turn = { role = User; content; timestamp = now } in 124 + let turns = session.turns @ [ turn ] in 125 + (* Trim to max_turns, keeping most recent *) 126 + let turns = 127 + if List.length turns > max_turns then 128 + let drop = List.length turns - max_turns in 129 + List.filteri (fun i _ -> i >= drop) turns 130 + else turns 131 + in 132 + { session with turns; updated_at = now } 133 + 134 + (** Add an assistant response to the session *) 135 + let add_assistant_message session ~content ~now = 136 + let turn = { role = Assistant; content; timestamp = now } in 137 + let turns = session.turns @ [ turn ] in 138 + let turns = 139 + if List.length turns > max_turns then 140 + let drop = List.length turns - max_turns in 141 + List.filteri (fun i _ -> i >= drop) turns 142 + else turns 143 + in 144 + { session with turns; updated_at = now } 145 + 146 + (** Clear a session *) 147 + let clear storage ~scope = 148 + let key = scope_to_key scope in 149 + Zulip_bot.Storage.remove storage key; 150 + Log.info (fun m -> m "Cleared session for %s" (scope_to_string scope)) 151 + 152 + (** Build conversation context for Claude from session history *) 153 + let build_context session = 154 + if session.turns = [] then None 155 + else 156 + let history = 157 + session.turns 158 + |> List.map (fun turn -> 159 + let role_str = 160 + match turn.role with User -> "User" | Assistant -> "Assistant" 161 + in 162 + Printf.sprintf "%s: %s" role_str turn.content) 163 + |> String.concat "\n\n" 164 + in 165 + Some 166 + (Printf.sprintf 167 + {|Previous conversation in this session: 168 + 169 + %s 170 + 171 + Continue the conversation naturally, taking into account the context above.|} 172 + history) 173 + 174 + (** Get session statistics *) 175 + let stats session = 176 + Printf.sprintf "%d turns, last updated %.0fs ago" 177 + (List.length session.turns) 178 + (Unix.gettimeofday () -. session.updated_at)
+67
lib/session.mli
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2026 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Per-channel and per-DM Claude session management. 7 + 8 + Sessions maintain conversation context independently for each Zulip 9 + channel or DM thread, enabling multi-turn conversations with Claude. *) 10 + 11 + val src : Logs.Src.t 12 + (** Log source for session management. *) 13 + 14 + (** Role in a conversation turn *) 15 + type role = User | Assistant 16 + 17 + (** A conversation turn in a session *) 18 + type turn = { role : role; content : string; timestamp : float } 19 + 20 + (** Session scope - either a channel+topic or a DM with a user *) 21 + type scope = 22 + | Channel of { stream : string; topic : string } 23 + | Direct of { user_email : string; user_full_name : string } 24 + 25 + val scope_to_string : scope -> string 26 + (** [scope_to_string scope] returns a human-readable description of the scope. *) 27 + 28 + val scope_to_mention : scope -> string 29 + (** [scope_to_mention scope] returns a Zulip-compatible linked mention. 30 + For channels, returns [#**stream>topic**] format. 31 + For DMs, returns [DM with `email`] format. *) 32 + 33 + (** Session data *) 34 + type t 35 + 36 + val empty : now:float -> t 37 + (** [empty ~now] creates an empty session. *) 38 + 39 + val max_turns : int 40 + (** Maximum turns to keep in a session for context window management. *) 41 + 42 + val scope_of_message : Zulip_bot.Message.t -> scope 43 + (** [scope_of_message msg] extracts the session scope from a Zulip message. 44 + Channel messages use stream+topic as scope, DMs use sender email. *) 45 + 46 + val load : Zulip_bot.Storage.t -> scope:scope -> now:float -> t 47 + (** [load storage ~scope ~now] loads a session from storage. 48 + Returns an empty session if none exists or if the session has expired. *) 49 + 50 + val save : Zulip_bot.Storage.t -> scope:scope -> t -> unit 51 + (** [save storage ~scope session] persists the session to storage. *) 52 + 53 + val add_user_message : t -> content:string -> now:float -> t 54 + (** [add_user_message session ~content ~now] adds a user message to the session. *) 55 + 56 + val add_assistant_message : t -> content:string -> now:float -> t 57 + (** [add_assistant_message session ~content ~now] adds an assistant response. *) 58 + 59 + val clear : Zulip_bot.Storage.t -> scope:scope -> unit 60 + (** [clear storage ~scope] removes the session from storage. *) 61 + 62 + val build_context : t -> string option 63 + (** [build_context session] builds a context string from the session history 64 + for inclusion in Claude prompts. Returns [None] if the session is empty. *) 65 + 66 + val stats : t -> string 67 + (** [stats session] returns human-readable session statistics. *)