-253

claudeio/TODO.md

reviewed

··· 1 1 - # TODO: Missing Features from Python SDK 2 2 - 3 3 - ## 1. Hook Support 4 4 - 5 5 - ### Overview 6 6 - Hooks allow users to intercept and modify Claude's behavior at specific points during execution. The Python SDK supports several hook events that are not yet implemented in the OCaml library. 7 7 - 8 8 - ### Required Components 9 9 - 10 10 - #### Hook Events 11 11 - ```ocaml 12 12 - type hook_event = 13 13 - | Pre_tool_use (* Before a tool is invoked *) 14 14 - | Post_tool_use (* After a tool completes *) 15 15 - | User_prompt_submit (* When user submits a prompt *) 16 16 - | Stop (* When stopping execution *) 17 17 - | Subagent_stop (* When a subagent stops *) 18 18 - | Pre_compact (* Before context compaction *) 19 19 - ``` 20 20 - 21 21 - #### Hook Context 22 22 - ```ocaml 23 23 - module Hook_context : sig 24 24 - type t = { 25 25 - signal : [ `Abort ] option; (* Future: abort signal support *) 26 26 - } 27 27 - end 28 28 - ``` 29 29 - 30 30 - #### Hook Output 31 31 - ```ocaml 32 32 - module Hook_output : sig 33 33 - type t = { 34 34 - decision : [ `Block | `Continue ] option; 35 35 - system_message : string option; 36 36 - hook_specific_output : Ezjsonm.value option; 37 37 - } 38 38 - end 39 39 - ``` 40 40 - 41 41 - #### Hook Callback 42 42 - ```ocaml 43 43 - type hook_callback = 44 44 - input:Ezjsonm.value -> 45 45 - tool_use_id:string option -> 46 46 - context:Hook_context.t -> 47 47 - Hook_output.t Eio.Promise.t 48 48 - ``` 49 49 - 50 50 - #### Hook Matcher 51 51 - ```ocaml 52 52 - module Hook_matcher : sig 53 53 - type t = { 54 54 - matcher : string option; (* e.g., "Bash" or "Write|MultiEdit|Edit" *) 55 55 - hooks : hook_callback list; 56 56 - } 57 57 - end 58 58 - ``` 59 59 - 60 60 - ### Implementation Plan 61 61 - 62 62 - 1. **Add hook types to a new `lib/hooks.mli` module** 63 63 - 2. **Integrate hooks into `Options.t`**: 64 64 - - Add `hooks : (hook_event * Hook_matcher.t list) list` field 65 65 - 3. **Update `Client` module to handle hook callbacks**: 66 66 - - Intercept tool use events 67 67 - - Call registered hooks before/after operations 68 68 - - Handle hook responses (block, modify, continue) 69 69 - 4. **Update SDK control protocol** to support hook registration via `SDKControlInitializeRequest` 70 70 - 71 71 - ### Usage Example 72 72 - ```ocaml 73 73 - let pre_tool_hook ~input ~tool_use_id:_ ~context:_ = 74 74 - match Ezjsonm.find input ["name"] |> Ezjsonm.get_string with 75 75 - | "Bash" -> 76 76 - Eio.Promise.resolve Hook_output.{ 77 77 - decision = Some `Block; 78 78 - system_message = Some "Bash commands blocked by hook"; 79 79 - hook_specific_output = None; 80 80 - } 81 81 - | _ -> 82 82 - Eio.Promise.resolve Hook_output.{ 83 83 - decision = Some `Continue; 84 84 - system_message = None; 85 85 - hook_specific_output = None; 86 86 - } 87 87 - 88 88 - let options = Options.create 89 89 - ~hooks:[ 90 90 - Pre_tool_use, [{ 91 91 - matcher = Some "Bash"; 92 92 - hooks = [pre_tool_hook] 93 93 - }] 94 94 - ] 95 95 - () 96 96 - ``` 97 97 - 98 98 - ## 2. MCP (Model Context Protocol) Server Support 99 99 - 100 100 - ### Overview 101 101 - MCP servers allow Claude to interact with external services and tools. The Python SDK supports multiple MCP server configurations. 102 102 - 103 103 - ### Required Components 104 104 - 105 105 - #### MCP Server Types 106 106 - ```ocaml 107 107 - module Mcp_server : sig 108 108 - type stdio_config = { 109 109 - command : string; 110 110 - args : string list option; 111 111 - env : (string * string) list option; 112 112 - } 113 113 - 114 114 - type sse_config = { 115 115 - url : string; 116 116 - headers : (string * string) list option; 117 117 - } 118 118 - 119 119 - type http_config = { 120 120 - url : string; 121 121 - headers : (string * string) list option; 122 122 - } 123 123 - 124 124 - type sdk_config = { 125 125 - name : string; 126 126 - (* In OCaml, we'd need to define an MCP server interface *) 127 127 - instance : mcp_server; 128 128 - } 129 129 - 130 130 - and mcp_server = < 131 131 - (* MCP server methods would go here *) 132 132 - > 133 133 - 134 134 - type config = 135 135 - | Stdio of stdio_config 136 136 - | SSE of sse_config 137 137 - | HTTP of http_config 138 138 - | SDK of sdk_config 139 139 - end 140 140 - ``` 141 141 - 142 142 - ### Implementation Plan 143 143 - 144 144 - 1. **Create `lib/mcp.mli` module** with server configuration types 145 145 - 2. **Add MCP support to `Options.t`**: 146 146 - - Add `mcp_servers : (string * Mcp_server.config) list` field 147 147 - 3. **Create MCP transport layer**: 148 148 - - Stdio: Use Eio.Process for subprocess communication 149 149 - - SSE: Use Cohttp and event stream parsing 150 150 - - HTTP: Use Cohttp for REST API calls 151 151 - - SDK: Direct OCaml object interface 152 152 - 4. **Update SDK control protocol** to handle `SDKControlMcpMessageRequest` 153 153 - 5. **Implement MCP message routing** in Client module 154 154 - 155 155 - ### Usage Example 156 156 - ```ocaml 157 157 - let stdio_server = Mcp_server.Stdio { 158 158 - command = "calculator-server"; 159 159 - args = Some ["--mode", "advanced"]; 160 160 - env = None; 161 161 - } 162 162 - 163 163 - let http_server = Mcp_server.HTTP { 164 164 - url = "https://api.example.com/mcp"; 165 165 - headers = Some [("Authorization", "Bearer token")]; 166 166 - } 167 167 - 168 168 - let options = Options.create 169 169 - ~mcp_servers:[ 170 170 - "calculator", stdio_server; 171 171 - "api", http_server; 172 172 - ] 173 173 - () 174 174 - ``` 175 175 - 176 176 - ### MCP Message Flow 177 177 - 178 178 - 1. Claude requests tool use from MCP server 179 179 - 2. Client sends `mcp_message` control request 180 180 - 3. SDK routes message to appropriate MCP server 181 181 - 4. MCP server responds with result 182 182 - 5. Client forwards result back to Claude 183 183 - 184 184 - ## 3. Integration with SDK Control Protocol 185 185 - 186 186 - Both hooks and MCP will require updates to the SDK control protocol: 187 187 - 188 188 - ### Control Request Types 189 189 - ```ocaml 190 190 - module Sdk_control : sig 191 191 - type interrupt_request = { 192 192 - subtype : [`Interrupt]; 193 193 - } 194 194 - 195 195 - type permission_request = { 196 196 - subtype : [`Can_use_tool]; 197 197 - tool_name : string; 198 198 - input : Ezjsonm.value; 199 199 - permission_suggestions : Permissions.Update.t list option; 200 200 - blocked_path : string option; 201 201 - } 202 202 - 203 203 - type initialize_request = { 204 204 - subtype : [`Initialize]; 205 205 - hooks : (hook_event * Ezjsonm.value) list option; 206 206 - } 207 207 - 208 208 - type set_permission_mode_request = { 209 209 - subtype : [`Set_permission_mode]; 210 210 - mode : Permissions.Mode.t; 211 211 - } 212 212 - 213 213 - type hook_callback_request = { 214 214 - subtype : [`Hook_callback]; 215 215 - callback_id : string; 216 216 - input : Ezjsonm.value; 217 217 - tool_use_id : string option; 218 218 - } 219 219 - 220 220 - type mcp_message_request = { 221 221 - subtype : [`Mcp_message]; 222 222 - server_name : string; 223 223 - message : Ezjsonm.value; 224 224 - } 225 225 - 226 226 - type request = 227 227 - | Interrupt of interrupt_request 228 228 - | Permission of permission_request 229 229 - | Initialize of initialize_request 230 230 - | Set_permission_mode of set_permission_mode_request 231 231 - | Hook_callback of hook_callback_request 232 232 - | Mcp_message of mcp_message_request 233 233 - end 234 234 - ``` 235 235 - 236 236 - ## Implementation Priority 237 237 - 238 238 - 1. **Phase 1**: Implement typed SDK control protocol (prerequisite for both) 239 239 - 2. **Phase 2**: Implement hook support (simpler, self-contained) 240 240 - 3. **Phase 3**: Implement MCP server support (requires external dependencies) 241 241 - 242 242 - ## Testing Strategy 243 243 - 244 244 - ### Hooks 245 245 - - Unit tests for hook registration and matching 246 246 - - Integration tests with mock tool invocations 247 247 - - Test hook blocking, modification, and pass-through scenarios 248 248 - 249 249 - ### MCP 250 250 - - Unit tests for configuration parsing 251 251 - - Mock MCP server for integration testing 252 252 - - Test different transport types (stdio, HTTP, SSE) 253 253 - - Test message routing and error handling

+1 -1

claudeio/claude.opam

reviewed

··· 9 9 "eio" 10 10 "fmt" 11 11 "logs" 12 12 - "ezjsonm" 13 12 "jsont" {>= "0.2.0"} 13 13 + "jsont_bytesrw" {>= "0.2.0"} 14 14 "alcotest" {with-test} 15 15 "odoc" {with-doc} 16 16 ]

+1 -1

claudeio/dune-project

reviewed

··· 12 12 eio 13 13 fmt 14 14 logs 15 15 - ezjsonm 16 15 (jsont (>= 0.2.0)) 16 16 + (jsont_bytesrw (>= 0.2.0)) 17 17 (alcotest :with-test)))

+1

claudeio/lib/claude.ml

reviewed

··· 5 5 module Permissions = Permissions 6 6 module Hooks = Hooks 7 7 module Sdk_control = Sdk_control 8 8 + module Incoming = Incoming 8 9 module Structured_output = Structured_output 9 10 module Options = Options 10 11 module Transport = Transport

+3

claudeio/lib/claude.mli

reviewed

··· 174 174 module Sdk_control = Sdk_control 175 175 (** SDK control protocol for dynamic configuration. *) 176 176 177 177 + module Incoming = Incoming 178 178 + (** Discriminated union of all incoming message types from Claude CLI. *) 179 179 + 177 180 module Structured_output = Structured_output 178 181 (** Structured output support using JSON Schema. *) 179 182

+184 -104

claudeio/lib/client.ml

reviewed

··· 1 1 let src = Logs.Src.create "claude.client" ~doc:"Claude client" 2 2 module Log = (val Logs.src_log src : Logs.LOG) 3 3 4 4 + (* Helper functions for JSON manipulation *) 5 5 + let json_to_string json = 6 6 + match Jsont_bytesrw.encode_string' Jsont.json json with 7 7 + | Ok s -> s 8 8 + | Error err -> failwith (Jsont.Error.to_string err) 9 9 + 10 10 + let json_of_string s = 11 11 + match Jsont_bytesrw.decode_string' Jsont.json s with 12 12 + | Ok j -> j 13 13 + | Error err -> failwith (Jsont.Error.to_string err) 14 14 + 15 15 + let get_field json key = 16 16 + match json with 17 17 + | Jsont.Object (members, _) -> 18 18 + List.find_map (fun ((name, _), value) -> 19 19 + if name = key then Some value else None 20 20 + ) members 21 21 + | _ -> None 22 22 + 23 23 + let rec find json path = 24 24 + match path with 25 25 + | [] -> json 26 26 + | key :: rest -> 27 27 + match get_field json key with 28 28 + | Some value -> find value rest 29 29 + | None -> raise Not_found 30 30 + 31 31 + let find_string json path = 32 32 + let value = find json path in 33 33 + match value with 34 34 + | Jsont.String (s, _) -> s 35 35 + | _ -> raise (Invalid_argument "Expected string value") 36 36 + 37 37 + let json_string s = Jsont.String (s, Jsont.Meta.none) 38 38 + let json_null = Jsont.Null ((), Jsont.Meta.none) 39 39 + 40 40 + let json_dict pairs = 41 41 + let members = List.map (fun (k, v) -> ((k, Jsont.Meta.none), v)) pairs in 42 42 + Jsont.Object (members, Jsont.Meta.none) 43 43 + 4 44 type t = { 5 45 transport : Transport.t; 6 46 permission_callback : Permissions.callback option; ··· 8 48 hook_callbacks : (string, Hooks.callback) Hashtbl.t; 9 49 mutable next_callback_id : int; 10 50 mutable session_id : string option; 11 11 - control_responses : (string, Ezjsonm.value) Hashtbl.t; 51 51 + control_responses : (string, Jsont.json) Hashtbl.t; 12 52 control_mutex : Eio.Mutex.t; 13 53 control_condition : Eio.Condition.t; 14 54 } 15 55 16 56 let handle_control_request t control_msg = 17 17 - let open Ezjsonm in 18 57 let data = Control.data control_msg in 19 58 Log.info (fun m -> m "Handling control request: %s" (Control.subtype control_msg)); 20 20 - Log.info (fun m -> m "Control request data: %s" (value_to_string data)); 21 21 - match Json_utils.find_string data ["request"; "subtype"] with 59 59 + Log.info (fun m -> m "Control request data: %s" (json_to_string data)); 60 60 + match find_string data ["request"; "subtype"] with 22 61 | "can_use_tool" -> 23 23 - let tool_name = Json_utils.find_string data ["request"; "tool_name"] in 62 62 + let tool_name = find_string data ["request"; "tool_name"] in 24 63 let input = find data ["request"; "input"] in 25 64 Log.info (fun m -> m "Permission request for tool '%s' with input: %s" 26 26 - tool_name (value_to_string input)); 65 65 + tool_name (json_to_string input)); 27 66 let suggestions = 28 67 try 29 68 let sugg_json = find data ["request"; "permission_suggestions"] in 30 69 match sugg_json with 31 31 - | `A _ -> 70 70 + | Jsont.Array _ -> 32 71 (* TODO: Parse permission suggestions *) 33 72 [] 34 73 | _ -> [] ··· 52 91 53 92 (* Convert permission result to CLI format: {"behavior": "allow", "updatedInput": ...} or {"behavior": "deny", "message": ...} *) 54 93 let response_data = match result with 55 55 - | Permissions.Result.Allow { updated_input; updated_permissions = _ } -> 94 94 + | Permissions.Result.Allow { updated_input; updated_permissions = _; unknown = _ } -> 56 95 (* updatedInput is required when allowing - use original input if not modified *) 57 96 let updated_input = match updated_input with 58 97 | Some inp -> inp 59 98 | None -> input (* Use original input *) 60 99 in 61 61 - dict [ 62 62 - ("behavior", string "allow"); 100 100 + json_dict [ 101 101 + ("behavior", json_string "allow"); 63 102 ("updatedInput", updated_input); 64 103 ] 65 65 - | Permissions.Result.Deny { message; interrupt = _ } -> 66 66 - dict [ 67 67 - ("behavior", string "deny"); 68 68 - ("message", string message); 104 104 + | Permissions.Result.Deny { message; interrupt = _; unknown = _ } -> 105 105 + json_dict [ 106 106 + ("behavior", json_string "deny"); 107 107 + ("message", json_string message); 69 108 ] 70 109 in 71 110 72 72 - let response = dict [ 73 73 - "type", string "control_response"; 74 74 - "response", dict [ 75 75 - "subtype", string "success"; 76 76 - "request_id", string (Control.request_id control_msg); 111 111 + let response = json_dict [ 112 112 + "type", json_string "control_response"; 113 113 + "response", json_dict [ 114 114 + "subtype", json_string "success"; 115 115 + "request_id", json_string (Control.request_id control_msg); 77 116 "response", response_data 78 117 ] 79 118 ] in 80 80 - Log.info (fun m -> m "Sending control response: %s" (value_to_string response)); 119 119 + Log.info (fun m -> m "Sending control response: %s" (json_to_string response)); 81 120 Transport.send t.transport response 82 121 83 122 | "hook_callback" -> 84 84 - let callback_id = Json_utils.find_string data ["request"; "callback_id"] in 123 123 + let callback_id = find_string data ["request"; "callback_id"] in 85 124 let input = find data ["request"; "input"] in 86 125 let tool_use_id = 87 87 - try Some (Json_utils.find_string data ["request"; "tool_use_id"]) 126 126 + try Some (find_string data ["request"; "tool_use_id"]) 88 127 with Not_found -> None 89 128 in 90 129 Log.info (fun m -> m "Hook callback request for callback_id: %s" callback_id); ··· 94 133 let context = Hooks.Context.create () in 95 134 let result = callback ~input ~tool_use_id ~context in 96 135 97 97 - let response = dict [ 98 98 - "type", string "control_response"; 99 99 - "response", dict [ 100 100 - "subtype", string "success"; 101 101 - "request_id", string (Control.request_id control_msg); 102 102 - "response", Hooks.result_to_json result 136 136 + let result_json = match Jsont.Json.encode Hooks.result_jsont result with 137 137 + | Ok j -> j 138 138 + | Error msg -> failwith ("Failed to encode hook result: " ^ msg) 139 139 + in 140 140 + 141 141 + let response = json_dict [ 142 142 + "type", json_string "control_response"; 143 143 + "response", json_dict [ 144 144 + "subtype", json_string "success"; 145 145 + "request_id", json_string (Control.request_id control_msg); 146 146 + "response", result_json 103 147 ] 104 148 ] in 105 149 Log.info (fun m -> m "Hook callback succeeded, sending response"); ··· 108 152 | Not_found -> 109 153 let error_msg = Printf.sprintf "Hook callback not found: %s" callback_id in 110 154 Log.err (fun m -> m "%s" error_msg); 111 111 - let response = dict [ 112 112 - "type", string "control_response"; 113 113 - "response", dict [ 114 114 - "subtype", string "error"; 115 115 - "request_id", string (Control.request_id control_msg); 116 116 - "error", string error_msg 155 155 + let response = json_dict [ 156 156 + "type", json_string "control_response"; 157 157 + "response", json_dict [ 158 158 + "subtype", json_string "error"; 159 159 + "request_id", json_string (Control.request_id control_msg); 160 160 + "error", json_string error_msg 117 161 ] 118 162 ] in 119 163 Transport.send t.transport response 120 164 | exn -> 121 165 let error_msg = Printf.sprintf "Hook callback error: %s" (Printexc.to_string exn) in 122 166 Log.err (fun m -> m "%s" error_msg); 123 123 - let response = dict [ 124 124 - "type", string "control_response"; 125 125 - "response", dict [ 126 126 - "subtype", string "error"; 127 127 - "request_id", string (Control.request_id control_msg); 128 128 - "error", string error_msg 167 167 + let response = json_dict [ 168 168 + "type", json_string "control_response"; 169 169 + "response", json_dict [ 170 170 + "subtype", json_string "error"; 171 171 + "request_id", json_string (Control.request_id control_msg); 172 172 + "error", json_string error_msg 129 173 ] 130 174 ] in 131 175 Transport.send t.transport response) 132 176 133 177 | subtype -> 134 178 (* Respond with error for unknown control requests *) 135 135 - let response = dict [ 136 136 - "type", string "control_response"; 137 137 - "response", dict [ 138 138 - "subtype", string "error"; 139 139 - "request_id", string (Control.request_id control_msg); 140 140 - "error", string (Printf.sprintf "Unsupported control request: %s" subtype) 179 179 + let response = json_dict [ 180 180 + "type", json_string "control_response"; 181 181 + "response", json_dict [ 182 182 + "subtype", json_string "error"; 183 183 + "request_id", json_string (Control.request_id control_msg); 184 184 + "error", json_string (Printf.sprintf "Unsupported control request: %s" subtype) 141 185 ] 142 186 ] in 143 187 Transport.send t.transport response 144 188 189 189 + let handle_control_response t control_resp = 190 190 + let request_id = match control_resp.Sdk_control.response with 191 191 + | Sdk_control.Response.Success s -> s.request_id 192 192 + | Sdk_control.Response.Error e -> e.request_id 193 193 + in 194 194 + Log.debug (fun m -> m "Received control response for request_id: %s" request_id); 195 195 + 196 196 + (* Store the response as JSON and signal waiting threads *) 197 197 + let json = match Jsont.Json.encode Sdk_control.control_response_jsont control_resp with 198 198 + | Ok j -> j 199 199 + | Error err -> failwith ("Failed to encode control response: " ^ err) 200 200 + in 201 201 + Eio.Mutex.use_rw ~protect:false t.control_mutex (fun () -> 202 202 + Hashtbl.replace t.control_responses request_id json; 203 203 + Eio.Condition.broadcast t.control_condition 204 204 + ) 205 205 + 145 206 let handle_messages t = 146 207 let rec loop () = 147 208 match Transport.receive_line t.transport with 148 148 - | None -> 209 209 + | None -> 149 210 (* EOF *) 150 211 Log.debug (fun m -> m "Handle messages: EOF received"); 151 212 Seq.Nil 152 213 | Some line -> 153 214 try 154 154 - let json = Ezjsonm.value_from_string line in 155 155 - 156 156 - (* Check if it's a control request or response *) 157 157 - match Json_utils.find_string json ["type"] with 215 215 + (* First check if it's a control_request (special case, not in Incoming) *) 216 216 + let json = json_of_string line in 217 217 + match find_string json ["type"] with 158 218 | "control_request" -> 159 219 let control_msg = Control.create 160 160 - ~request_id:(Json_utils.find_string json ["request_id"]) 161 161 - ~subtype:(Json_utils.find_string json ["request"; "subtype"]) 220 220 + ~request_id:(find_string json ["request_id"]) 221 221 + ~subtype:(find_string json ["request"; "subtype"]) 162 222 ~data:json in 163 163 - Log.info (fun m -> m "🎯 Received control request: %s (request_id: %s)" 223 223 + Log.info (fun m -> m "Received control request: %s (request_id: %s)" 164 224 (Control.subtype control_msg) (Control.request_id control_msg)); 165 225 handle_control_request t control_msg; 166 226 loop () 167 227 168 168 - | "control_response" -> 169 169 - (* Handle control responses (e.g., initialize response) *) 170 170 - let request_id = Json_utils.find_string json ["response"; "request_id"] in 171 171 - Log.debug (fun m -> m "Received control response for request_id: %s" request_id); 172 172 - (* Store the response and signal waiting threads *) 173 173 - Eio.Mutex.use_rw ~protect:false t.control_mutex (fun () -> 174 174 - Hashtbl.replace t.control_responses request_id json; 175 175 - Eio.Condition.broadcast t.control_condition 176 176 - ); 177 177 - loop () 178 178 - 179 228 | _ -> 180 180 - (* Regular message *) 181 181 - let msg = Message.of_json json in 182 182 - Log.info (fun m -> m "← %a" Message.pp msg); 183 183 - 184 184 - (* Extract session ID from system messages *) 185 185 - (match msg with 186 186 - | Message.System sys when Message.System.subtype sys = "init" -> 187 187 - (match Message.System.Data.get_string (Message.System.data sys) "session_id" with 188 188 - | Some session_id -> 189 189 - t.session_id <- Some session_id; 190 190 - Log.debug (fun m -> m "Stored session ID: %s" session_id) 191 191 - | None -> ()) 192 192 - | _ -> ()); 193 193 - 194 194 - Seq.Cons (msg, loop) 229 229 + (* Use Incoming codec for all other message types *) 230 230 + match Jsont_bytesrw.decode_string' Incoming.jsont line with 231 231 + | Ok (Incoming.Message msg) -> 232 232 + Log.info (fun m -> m "← %a" Message.pp msg); 233 233 + 234 234 + (* Extract session ID from system messages *) 235 235 + (match msg with 236 236 + | Message.System sys when Message.System.subtype sys = "init" -> 237 237 + (match Message.System.Data.get_string (Message.System.data sys) "session_id" with 238 238 + | Some session_id -> 239 239 + t.session_id <- Some session_id; 240 240 + Log.debug (fun m -> m "Stored session ID: %s" session_id) 241 241 + | None -> ()) 242 242 + | _ -> ()); 243 243 + 244 244 + Seq.Cons (msg, loop) 245 245 + 246 246 + | Ok (Incoming.Control_response resp) -> 247 247 + handle_control_response t resp; 248 248 + loop () 249 249 + 250 250 + | Error err -> 251 251 + Log.err (fun m -> m "Failed to decode incoming message: %s\nLine: %s" 252 252 + (Jsont.Error.to_string err) line); 253 253 + loop () 195 254 with 196 255 | exn -> 197 197 - Log.err (fun m -> m "Failed to parse message: %s\nLine: %s" 256 256 + Log.err (fun m -> m "Failed to parse message: %s\nLine: %s" 198 257 (Printexc.to_string exn) line); 199 258 loop () 200 259 in ··· 245 304 Log.debug (fun m -> m "Registered callback: %s for event: %s" callback_id event_name); 246 305 callback_id 247 306 ) matcher.Hooks.callbacks in 248 248 - Ezjsonm.dict [ 307 307 + json_dict [ 249 308 "matcher", (match matcher.Hooks.matcher with 250 250 - | Some p -> Ezjsonm.string p 251 251 - | None -> `Null); 252 252 - "hookCallbackIds", `A (List.map (fun id -> Ezjsonm.string id) callback_ids); 309 309 + | Some p -> json_string p 310 310 + | None -> json_null); 311 311 + "hookCallbackIds", Jsont.Array (List.map (fun id -> json_string id) callback_ids, Jsont.Meta.none); 253 312 ] 254 313 ) matchers in 255 255 - (event_name, `A matchers_json) :: acc 314 314 + (event_name, Jsont.Array (matchers_json, Jsont.Meta.none)) :: acc 256 315 ) [] hooks_config in 257 316 258 317 (* Send initialize control request *) 259 259 - let initialize_msg = Ezjsonm.dict [ 260 260 - "type", Ezjsonm.string "control_request"; 261 261 - "request_id", Ezjsonm.string "init_hooks"; 262 262 - "request", Ezjsonm.dict [ 263 263 - "subtype", Ezjsonm.string "initialize"; 264 264 - "hooks", Ezjsonm.dict hooks_json; 318 318 + let initialize_msg = json_dict [ 319 319 + "type", json_string "control_request"; 320 320 + "request_id", json_string "init_hooks"; 321 321 + "request", json_dict [ 322 322 + "subtype", json_string "initialize"; 323 323 + "hooks", json_dict hooks_json; 265 324 ] 266 325 ] in 267 326 Log.info (fun m -> m "Sending hooks initialize request"); ··· 274 333 let query t prompt = 275 334 let msg = Message.user_string prompt in 276 335 Log.info (fun m -> m "→ %a" Message.pp msg); 277 277 - Transport.send t.transport (Message.to_json msg) 336 336 + let json = match Jsont.Json.encode Message.jsont msg with 337 337 + | Ok j -> j 338 338 + | Error err -> failwith ("Failed to encode message: " ^ err) 339 339 + in 340 340 + Transport.send t.transport json 278 341 279 342 let send_message t msg = 280 343 Log.info (fun m -> m "→ %a" Message.pp msg); 281 281 - Transport.send t.transport (Message.to_json msg) 344 344 + let json = match Jsont.Json.encode Message.jsont msg with 345 345 + | Ok j -> j 346 346 + | Error err -> failwith ("Failed to encode message: " ^ err) 347 347 + in 348 348 + Transport.send t.transport json 282 349 283 350 let send_user_message t user_msg = 284 351 let msg = Message.User user_msg in 285 352 Log.info (fun m -> m "→ %a" Message.pp msg); 286 286 - Transport.send t.transport (Message.User.to_json user_msg) 353 353 + let json = match Jsont.Json.encode Message.User.jsont user_msg with 354 354 + | Ok j -> j 355 355 + | Error err -> failwith ("Failed to encode user message: " ^ err) 356 356 + in 357 357 + Transport.send t.transport json 287 358 288 359 let receive t = 289 360 handle_messages t ··· 323 394 324 395 (* Helper to send a control request and wait for response *) 325 396 let send_control_request t ~request_id request = 326 326 - let open Ezjsonm in 327 397 (* Send the control request *) 328 328 - let control_msg = Sdk_control.create_request ~request_id ~request in 329 329 - let json = Sdk_control.to_json control_msg in 330 330 - Log.info (fun m -> m "Sending control request: %s" (value_to_string json)); 398 398 + let control_msg = Sdk_control.create_request ~request_id ~request () in 399 399 + let json = match Jsont.Json.encode Sdk_control.jsont control_msg with 400 400 + | Ok j -> j 401 401 + | Error msg -> failwith ("Failed to encode control request: " ^ msg) 402 402 + in 403 403 + Log.info (fun m -> m "Sending control request: %s" (json_to_string json)); 331 404 Transport.send t.transport json; 332 405 333 406 (* Wait for the response with timeout *) ··· 354 427 in 355 428 356 429 let response_json = wait_for_response () in 357 357 - Log.debug (fun m -> m "Received control response: %s" (value_to_string response_json)); 430 430 + Log.debug (fun m -> m "Received control response: %s" (json_to_string response_json)); 358 431 359 432 (* Parse the response *) 360 360 - let response = find response_json ["response"] |> Sdk_control.Response.of_json in 433 433 + let response_data = find response_json ["response"] in 434 434 + let response = match Jsont.Json.decode Sdk_control.Response.jsont response_data with 435 435 + | Ok r -> r 436 436 + | Error msg -> raise (Invalid_argument ("Failed to decode response: " ^ msg)) 437 437 + in 361 438 match response with 362 439 | Sdk_control.Response.Success s -> s.response 363 440 | Sdk_control.Response.Error e -> ··· 365 442 366 443 let set_permission_mode t mode = 367 444 let request_id = Printf.sprintf "set_perm_mode_%f" (Unix.gettimeofday ()) in 368 368 - let request = Sdk_control.Request.set_permission_mode ~mode in 445 445 + let request = Sdk_control.Request.set_permission_mode ~mode () in 369 446 let _response = send_control_request t ~request_id request in 370 447 Log.info (fun m -> m "Permission mode set to: %a" Permissions.Mode.pp mode) 371 448 372 449 let set_model t model = 373 450 let model_str = Model.to_string model in 374 451 let request_id = Printf.sprintf "set_model_%f" (Unix.gettimeofday ()) in 375 375 - let request = Sdk_control.Request.set_model ~model:model_str in 452 452 + let request = Sdk_control.Request.set_model ~model:model_str () in 376 453 let _response = send_control_request t ~request_id request in 377 454 Log.info (fun m -> m "Model set to: %a" Model.pp model) 378 455 ··· 384 461 let request = Sdk_control.Request.get_server_info () in 385 462 match send_control_request t ~request_id request with 386 463 | Some response_data -> 387 387 - let server_info = Sdk_control.Server_info.of_json response_data in 464 464 + let server_info = match Jsont.Json.decode Sdk_control.Server_info.jsont response_data with 465 465 + | Ok si -> si 466 466 + | Error msg -> raise (Invalid_argument ("Failed to decode server info: " ^ msg)) 467 467 + in 388 468 Log.info (fun m -> m "Retrieved server info: %a" Sdk_control.Server_info.pp server_info); 389 469 server_info 390 470 | None ->

+215 -130

claudeio/lib/content_block.ml

reviewed

··· 1 1 - open Ezjsonm 2 2 - module JU = Json_utils 3 3 - 4 1 let src = Logs.Src.create "claude.content_block" ~doc:"Claude content blocks" 5 2 module Log = (val Logs.src_log src : Logs.LOG) 6 3 7 4 8 5 module Text = struct 9 9 - type t = { text : string } 10 10 - 11 11 - let create text = { text } 6 6 + module Unknown = struct 7 7 + type t = Jsont.json 8 8 + let empty = Jsont.Object ([], Jsont.Meta.none) 9 9 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 10 10 + let jsont = Jsont.json 11 11 + end 12 12 + 13 13 + type t = { 14 14 + text : string; 15 15 + unknown : Unknown.t; 16 16 + } 17 17 + 18 18 + let create text = { text; unknown = Unknown.empty } 19 19 + 20 20 + let make text unknown = { text; unknown } 12 21 let text t = t.text 13 13 - 14 14 - let to_json t = 15 15 - `O [("type", `String "text"); ("text", `String t.text)] 16 16 - 17 17 - let of_json = function 18 18 - | `O fields -> 19 19 - let text = JU.assoc_string "text" fields in 20 20 - { text } 21 21 - | _ -> raise (Invalid_argument "Text.of_json: expected object") 22 22 - 23 23 - let pp fmt t = 22 22 + let unknown t = t.unknown 23 23 + 24 24 + let jsont : t Jsont.t = 25 25 + Jsont.Object.map ~kind:"Text" make 26 26 + |> Jsont.Object.mem "text" Jsont.string ~enc:text 27 27 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 28 28 + |> Jsont.Object.finish 29 29 + 30 30 + let to_json t = 31 31 + match Jsont.Json.encode jsont t with 32 32 + | Ok json -> json 33 33 + | Error msg -> failwith ("Text.to_json: " ^ msg) 34 34 + 35 35 + let of_json json = 36 36 + match Jsont.Json.decode jsont json with 37 37 + | Ok v -> v 38 38 + | Error msg -> raise (Invalid_argument ("Text.of_json: " ^ msg)) 39 39 + 40 40 + let pp fmt t = 24 41 if String.length t.text > 60 then 25 42 let truncated = String.sub t.text 0 57 in 26 43 Fmt.pf fmt "Text[%s...]" truncated ··· 30 47 31 48 module Tool_use = struct 32 49 module Input = struct 33 33 - type t = value 34 34 - 50 50 + type t = Jsont.json 51 51 + 52 52 + let jsont = Jsont.json 53 53 + 35 54 let of_string_pairs pairs = 36 36 - `O (List.map (fun (k, v) -> (k, `String v)) pairs) 37 37 - 38 38 - let of_assoc assoc = `O assoc 39 39 - 40 40 - let get_string t key = JU.get_field_string_opt t key 41 41 - 42 42 - let get_int t key = JU.get_field_int_opt t key 43 43 - 44 44 - let get_bool t key = JU.get_field_bool_opt t key 45 45 - 46 46 - let get_float t key = JU.get_field_float_opt t key 47 47 - 55 55 + Jsont.Object ( 56 56 + List.map (fun (k, v) -> 57 57 + ((Jsont.Json.name k), Jsont.String (v, Jsont.Meta.none)) 58 58 + ) pairs, 59 59 + Jsont.Meta.none 60 60 + ) 61 61 + 62 62 + let of_assoc (assoc : (string * Jsont.json) list) : t = 63 63 + Jsont.Object ( 64 64 + List.map (fun (k, v) -> (Jsont.Json.name k, v)) assoc, 65 65 + Jsont.Meta.none 66 66 + ) 67 67 + 68 68 + let get_field t key = 69 69 + match t with 70 70 + | Jsont.Object (members, _) -> 71 71 + List.find_map (fun ((name, _), value) -> 72 72 + if name = key then Some value else None 73 73 + ) members 74 74 + | _ -> None 75 75 + 76 76 + let get_string t key = 77 77 + match get_field t key with 78 78 + | Some (Jsont.String (s, _)) -> Some s 79 79 + | _ -> None 80 80 + 81 81 + let get_int t key = 82 82 + match get_field t key with 83 83 + | Some (Jsont.Number (f, _)) -> 84 84 + let i = int_of_float f in 85 85 + if float_of_int i = f then Some i else None 86 86 + | _ -> None 87 87 + 88 88 + let get_bool t key = 89 89 + match get_field t key with 90 90 + | Some (Jsont.Bool (b, _)) -> Some b 91 91 + | _ -> None 92 92 + 93 93 + let get_float t key = 94 94 + match get_field t key with 95 95 + | Some (Jsont.Number (f, _)) -> Some f 96 96 + | _ -> None 97 97 + 48 98 let keys t = 49 99 match t with 50 50 - | `O fields -> List.map fst fields 100 100 + | Jsont.Object (members, _) -> List.map (fun ((name, _), _) -> name) members 51 101 | _ -> [] 52 52 - 102 102 + 53 103 let to_json t = t 54 104 let of_json json = json 55 105 end 56 56 - 106 106 + 107 107 + module Unknown = struct 108 108 + type t = Jsont.json 109 109 + let empty = Jsont.Object ([], Jsont.Meta.none) 110 110 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 111 111 + let jsont = Jsont.json 112 112 + end 113 113 + 57 114 type t = { 58 115 id : string; 59 116 name : string; 60 117 input : Input.t; 118 118 + unknown : Unknown.t; 61 119 } 62 62 - 63 63 - let create ~id ~name ~input = { id; name; input } 120 120 + 121 121 + let create ~id ~name ~input = { id; name; input; unknown = Unknown.empty } 122 122 + 123 123 + let make id name input unknown = { id; name; input; unknown } 64 124 let id t = t.id 65 125 let name t = t.name 66 126 let input t = t.input 67 67 - 127 127 + let unknown t = t.unknown 128 128 + 129 129 + let jsont : t Jsont.t = 130 130 + Jsont.Object.map ~kind:"Tool_use" make 131 131 + |> Jsont.Object.mem "id" Jsont.string ~enc:id 132 132 + |> Jsont.Object.mem "name" Jsont.string ~enc:name 133 133 + |> Jsont.Object.mem "input" Input.jsont ~enc:input 134 134 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 135 135 + |> Jsont.Object.finish 136 136 + 68 137 let to_json t = 69 69 - `O [ 70 70 - ("type", `String "tool_use"); 71 71 - ("id", `String t.id); 72 72 - ("name", `String t.name); 73 73 - ("input", Input.to_json t.input); 74 74 - ] 75 75 - 76 76 - let of_json = function 77 77 - | `O fields -> 78 78 - let id = JU.assoc_string "id" fields in 79 79 - let name = JU.assoc_string "name" fields in 80 80 - let input = Input.of_json (List.assoc "input" fields) in 81 81 - { id; name; input } 82 82 - | _ -> raise (Invalid_argument "Tool_use.of_json: expected object") 83 83 - 138 138 + match Jsont.Json.encode jsont t with 139 139 + | Ok json -> json 140 140 + | Error msg -> failwith ("Tool_use.to_json: " ^ msg) 141 141 + 142 142 + let of_json json = 143 143 + match Jsont.Json.decode jsont json with 144 144 + | Ok v -> v 145 145 + | Error msg -> raise (Invalid_argument ("Tool_use.of_json: " ^ msg)) 146 146 + 84 147 let pp fmt t = 85 148 let keys = Input.keys t.input in 86 149 let key_info = match keys with ··· 92 155 end 93 156 94 157 module Tool_result = struct 158 158 + module Unknown = struct 159 159 + type t = Jsont.json 160 160 + let empty = Jsont.Object ([], Jsont.Meta.none) 161 161 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 162 162 + let jsont = Jsont.json 163 163 + end 164 164 + 95 165 type t = { 96 166 tool_use_id : string; 97 167 content : string option; 98 168 is_error : bool option; 169 169 + unknown : Unknown.t; 99 170 } 100 100 - 101 101 - let create ~tool_use_id ?content ?is_error () = 102 102 - { tool_use_id; content; is_error } 103 103 - 171 171 + 172 172 + let create ~tool_use_id ?content ?is_error () = 173 173 + { tool_use_id; content; is_error; unknown = Unknown.empty } 174 174 + 175 175 + let make tool_use_id content is_error unknown = 176 176 + { tool_use_id; content; is_error; unknown } 104 177 let tool_use_id t = t.tool_use_id 105 178 let content t = t.content 106 179 let is_error t = t.is_error 107 107 - 180 180 + let unknown t = t.unknown 181 181 + 182 182 + let jsont : t Jsont.t = 183 183 + Jsont.Object.map ~kind:"Tool_result" make 184 184 + |> Jsont.Object.mem "tool_use_id" Jsont.string ~enc:tool_use_id 185 185 + |> Jsont.Object.opt_mem "content" Jsont.string ~enc:content 186 186 + |> Jsont.Object.opt_mem "is_error" Jsont.bool ~enc:is_error 187 187 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 188 188 + |> Jsont.Object.finish 189 189 + 108 190 let to_json t = 109 109 - let fields = [ 110 110 - ("type", `String "tool_result"); 111 111 - ("tool_use_id", `String t.tool_use_id); 112 112 - ] in 113 113 - let fields = match t.content with 114 114 - | Some c -> ("content", `String c) :: fields 115 115 - | None -> fields 116 116 - in 117 117 - let fields = match t.is_error with 118 118 - | Some e -> ("is_error", `Bool e) :: fields 119 119 - | None -> fields 120 120 - in 121 121 - `O fields 122 122 - 123 123 - let of_json = function 124 124 - | `O fields -> 125 125 - let tool_use_id = JU.assoc_string "tool_use_id" fields in 126 126 - let content = 127 127 - match List.assoc_opt "content" fields with 128 128 - | Some (`String s) -> Some s 129 129 - | Some (`A blocks) -> 130 130 - (* Handle content as array of blocks - extract text *) 131 131 - let texts = List.filter_map (function 132 132 - | `O block_fields -> 133 133 - (match List.assoc_opt "type" block_fields with 134 134 - | Some (`String "text") -> 135 135 - (match List.assoc_opt "text" block_fields with 136 136 - | Some (`String text) -> Some text 137 137 - | _ -> None) 138 138 - | _ -> None) 139 139 - | _ -> None 140 140 - ) blocks in 141 141 - if texts = [] then None else Some (String.concat "\n" texts) 142 142 - | _ -> None 143 143 - in 144 144 - let is_error = JU.assoc_bool_opt "is_error" fields in 145 145 - { tool_use_id; content; is_error } 146 146 - | _ -> raise (Invalid_argument "Tool_result.of_json: expected object") 147 147 - 191 191 + match Jsont.Json.encode jsont t with 192 192 + | Ok json -> json 193 193 + | Error msg -> failwith ("Tool_result.to_json: " ^ msg) 194 194 + 195 195 + let of_json json = 196 196 + match Jsont.Json.decode jsont json with 197 197 + | Ok v -> v 198 198 + | Error msg -> raise (Invalid_argument ("Tool_result.of_json: " ^ msg)) 199 199 + 148 200 let pp fmt t = 149 201 match t.is_error, t.content with 150 150 - | Some true, Some c -> 202 202 + | Some true, Some c -> 151 203 if String.length c > 40 then 152 204 let truncated = String.sub c 0 37 in 153 205 Fmt.pf fmt "ToolResult[error: %s...]" truncated ··· 163 215 end 164 216 165 217 module Thinking = struct 218 218 + module Unknown = struct 219 219 + type t = Jsont.json 220 220 + let empty = Jsont.Object ([], Jsont.Meta.none) 221 221 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 222 222 + let jsont = Jsont.json 223 223 + end 224 224 + 166 225 type t = { 167 226 thinking : string; 168 227 signature : string; 228 228 + unknown : Unknown.t; 169 229 } 170 170 - 171 171 - let create ~thinking ~signature = { thinking; signature } 230 230 + 231 231 + let create ~thinking ~signature = { thinking; signature; unknown = Unknown.empty } 232 232 + 233 233 + let make thinking signature unknown = { thinking; signature; unknown } 172 234 let thinking t = t.thinking 173 235 let signature t = t.signature 174 174 - 236 236 + let unknown t = t.unknown 237 237 + 238 238 + let jsont : t Jsont.t = 239 239 + Jsont.Object.map ~kind:"Thinking" make 240 240 + |> Jsont.Object.mem "thinking" Jsont.string ~enc:thinking 241 241 + |> Jsont.Object.mem "signature" Jsont.string ~enc:signature 242 242 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 243 243 + |> Jsont.Object.finish 244 244 + 175 245 let to_json t = 176 176 - `O [ 177 177 - ("type", `String "thinking"); 178 178 - ("thinking", `String t.thinking); 179 179 - ("signature", `String t.signature); 180 180 - ] 181 181 - 182 182 - let of_json = function 183 183 - | `O fields -> 184 184 - let thinking = JU.assoc_string "thinking" fields in 185 185 - let signature = JU.assoc_string "signature" fields in 186 186 - { thinking; signature } 187 187 - | _ -> raise (Invalid_argument "Thinking.of_json: expected object") 188 188 - 246 246 + match Jsont.Json.encode jsont t with 247 247 + | Ok json -> json 248 248 + | Error msg -> failwith ("Thinking.to_json: " ^ msg) 249 249 + 250 250 + let of_json json = 251 251 + match Jsont.Json.decode jsont json with 252 252 + | Ok v -> v 253 253 + | Error msg -> raise (Invalid_argument ("Thinking.of_json: " ^ msg)) 254 254 + 189 255 let pp fmt t = 190 256 if String.length t.thinking > 50 then 191 257 let truncated = String.sub t.thinking 0 47 in ··· 202 268 203 269 let text s = Text (Text.create s) 204 270 let tool_use ~id ~name ~input = Tool_use (Tool_use.create ~id ~name ~input) 205 205 - let tool_result ~tool_use_id ?content ?is_error () = 271 271 + let tool_result ~tool_use_id ?content ?is_error () = 206 272 Tool_result (Tool_result.create ~tool_use_id ?content ?is_error ()) 207 207 - let thinking ~thinking ~signature = 273 273 + let thinking ~thinking ~signature = 208 274 Thinking (Thinking.create ~thinking ~signature) 209 275 210 210 - let to_json = function 211 211 - | Text t -> Text.to_json t 212 212 - | Tool_use t -> Tool_use.to_json t 213 213 - | Tool_result t -> Tool_result.to_json t 214 214 - | Thinking t -> Thinking.to_json t 276 276 + let jsont : t Jsont.t = 277 277 + let case_map kind obj dec = Jsont.Object.Case.map kind obj ~dec in 278 278 + 279 279 + let case_text = case_map "text" Text.jsont (fun v -> Text v) in 280 280 + let case_tool_use = case_map "tool_use" Tool_use.jsont (fun v -> Tool_use v) in 281 281 + let case_tool_result = case_map "tool_result" Tool_result.jsont (fun v -> Tool_result v) in 282 282 + let case_thinking = case_map "thinking" Thinking.jsont (fun v -> Thinking v) in 283 283 + 284 284 + let enc_case = function 285 285 + | Text v -> Jsont.Object.Case.value case_text v 286 286 + | Tool_use v -> Jsont.Object.Case.value case_tool_use v 287 287 + | Tool_result v -> Jsont.Object.Case.value case_tool_result v 288 288 + | Thinking v -> Jsont.Object.Case.value case_thinking v 289 289 + in 290 290 + 291 291 + let cases = Jsont.Object.Case.[ 292 292 + make case_text; 293 293 + make case_tool_use; 294 294 + make case_tool_result; 295 295 + make case_thinking 296 296 + ] in 297 297 + 298 298 + Jsont.Object.map ~kind:"Content_block" Fun.id 299 299 + |> Jsont.Object.case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases 300 300 + ~tag_to_string:Fun.id ~tag_compare:String.compare 301 301 + |> Jsont.Object.finish 302 302 + 303 303 + let to_json t = 304 304 + match Jsont.Json.encode jsont t with 305 305 + | Ok json -> json 306 306 + | Error msg -> failwith ("Content_block.to_json: " ^ msg) 215 307 216 308 let of_json json = 217 217 - match json with 218 218 - | `O fields -> ( 219 219 - match List.assoc_opt "type" fields with 220 220 - | Some (`String "text") -> Text (Text.of_json json) 221 221 - | Some (`String "tool_use") -> Tool_use (Tool_use.of_json json) 222 222 - | Some (`String "tool_result") -> Tool_result (Tool_result.of_json json) 223 223 - | Some (`String "thinking") -> Thinking (Thinking.of_json json) 224 224 - | _ -> raise (Invalid_argument "Content_block.of_json: unknown type") 225 225 - ) 226 226 - | _ -> raise (Invalid_argument "Content_block.of_json: expected object") 309 309 + match Jsont.Json.decode jsont json with 310 310 + | Ok v -> v 311 311 + | Error msg -> raise (Invalid_argument ("Content_block.of_json: " ^ msg)) 227 312 228 313 let pp fmt = function 229 314 | Text t -> Text.pp fmt t

+102 -56

claudeio/lib/content_block.mli

reviewed

··· 1 1 (** Content blocks for Claude messages. 2 2 - 2 2 + 3 3 This module defines the various types of content blocks that can appear 4 4 in Claude messages, including text, tool use, tool results, and thinking blocks. *) 5 5 ··· 10 10 11 11 module Text : sig 12 12 (** Plain text content blocks. *) 13 13 - 13 13 + 14 14 + module Unknown : sig 15 15 + type t = Jsont.json 16 16 + val empty : t 17 17 + val is_empty : t -> bool 18 18 + val jsont : t Jsont.t 19 19 + end 20 20 + 14 21 type t 15 22 (** The type of text blocks. *) 16 16 - 23 23 + 17 24 val create : string -> t 18 25 (** [create text] creates a new text block with the given text content. *) 19 19 - 26 26 + 20 27 val text : t -> string 21 28 (** [text t] returns the text content of the block. *) 22 22 - 23 23 - val to_json : t -> Ezjsonm.value 29 29 + 30 30 + val jsont : t Jsont.t 31 31 + (** [jsont] is the Jsont codec for text blocks. *) 32 32 + 33 33 + val to_json : t -> Jsont.json 24 34 (** [to_json t] converts the text block to its JSON representation. *) 25 25 - 26 26 - val of_json : Ezjsonm.value -> t 27 27 - (** [of_json json] parses a text block from JSON. 35 35 + 36 36 + val of_json : Jsont.json -> t 37 37 + (** [of_json json] parses a text block from JSON. 28 38 @raise Invalid_argument if the JSON is not a valid text block. *) 29 29 - 39 39 + 30 40 val pp : Format.formatter -> t -> unit 31 41 (** [pp fmt t] pretty-prints the text block. *) 32 42 end ··· 35 45 36 46 module Tool_use : sig 37 47 (** Tool invocation requests from the assistant. *) 38 38 - 48 48 + 39 49 module Input : sig 40 50 (** Tool input parameters. *) 41 41 - 51 51 + 42 52 type t 43 43 - (** Abstract type for tool inputs. *) 44 44 - 53 53 + (** Abstract type for tool inputs (opaque JSON). *) 54 54 + 55 55 + val jsont : t Jsont.t 56 56 + (** [jsont] is the Jsont codec for tool inputs. *) 57 57 + 45 58 val of_string_pairs : (string * string) list -> t 46 59 (** [of_string_pairs pairs] creates tool input from string key-value pairs. *) 47 47 - 48 48 - val of_assoc : (string * Ezjsonm.value) list -> t 60 60 + 61 61 + val of_assoc : (string * Jsont.json) list -> t 49 62 (** [of_assoc assoc] creates tool input from an association list. *) 50 50 - 63 63 + 51 64 val get_string : t -> string -> string option 52 65 (** [get_string t key] returns the string value for [key], if present. *) 53 53 - 66 66 + 54 67 val get_int : t -> string -> int option 55 68 (** [get_int t key] returns the integer value for [key], if present. *) 56 56 - 69 69 + 57 70 val get_bool : t -> string -> bool option 58 71 (** [get_bool t key] returns the boolean value for [key], if present. *) 59 59 - 72 72 + 60 73 val get_float : t -> string -> float option 61 74 (** [get_float t key] returns the float value for [key], if present. *) 62 62 - 75 75 + 63 76 val keys : t -> string list 64 77 (** [keys t] returns all keys in the input. *) 65 65 - 66 66 - val to_json : t -> Ezjsonm.value 78 78 + 79 79 + val to_json : t -> Jsont.json 67 80 (** [to_json t] converts to JSON representation. Internal use only. *) 68 68 - 69 69 - val of_json : Ezjsonm.value -> t 81 81 + 82 82 + val of_json : Jsont.json -> t 70 83 (** [of_json json] parses from JSON. Internal use only. *) 71 84 end 72 72 - 85 85 + 86 86 + module Unknown : sig 87 87 + type t = Jsont.json 88 88 + val empty : t 89 89 + val is_empty : t -> bool 90 90 + val jsont : t Jsont.t 91 91 + end 92 92 + 73 93 type t 74 94 (** The type of tool use blocks. *) 75 75 - 95 95 + 76 96 val create : id:string -> name:string -> input:Input.t -> t 77 97 (** [create ~id ~name ~input] creates a new tool use block. 78 98 @param id Unique identifier for this tool invocation 79 99 @param name Name of the tool to invoke 80 100 @param input Parameters for the tool *) 81 81 - 101 101 + 82 102 val id : t -> string 83 103 (** [id t] returns the unique identifier of the tool use. *) 84 84 - 104 104 + 85 105 val name : t -> string 86 106 (** [name t] returns the name of the tool being invoked. *) 87 87 - 107 107 + 88 108 val input : t -> Input.t 89 109 (** [input t] returns the input parameters for the tool. *) 90 90 - 91 91 - val to_json : t -> Ezjsonm.value 110 110 + 111 111 + val jsont : t Jsont.t 112 112 + (** [jsont] is the Jsont codec for tool use blocks. *) 113 113 + 114 114 + val to_json : t -> Jsont.json 92 115 (** [to_json t] converts the tool use block to its JSON representation. *) 93 93 - 94 94 - val of_json : Ezjsonm.value -> t 116 116 + 117 117 + val of_json : Jsont.json -> t 95 118 (** [of_json json] parses a tool use block from JSON. 96 119 @raise Invalid_argument if the JSON is not a valid tool use block. *) 97 97 - 120 120 + 98 121 val pp : Format.formatter -> t -> unit 99 122 (** [pp fmt t] pretty-prints the tool use block. *) 100 123 end ··· 103 126 104 127 module Tool_result : sig 105 128 (** Results from tool invocations. *) 106 106 - 129 129 + 130 130 + module Unknown : sig 131 131 + type t = Jsont.json 132 132 + val empty : t 133 133 + val is_empty : t -> bool 134 134 + val jsont : t Jsont.t 135 135 + end 136 136 + 107 137 type t 108 138 (** The type of tool result blocks. *) 109 109 - 139 139 + 110 140 val create : tool_use_id:string -> ?content:string -> ?is_error:bool -> unit -> t 111 141 (** [create ~tool_use_id ?content ?is_error ()] creates a new tool result block. 112 142 @param tool_use_id The ID of the corresponding tool use block 113 143 @param content Optional result content 114 144 @param is_error Whether the tool execution resulted in an error *) 115 115 - 145 145 + 116 146 val tool_use_id : t -> string 117 147 (** [tool_use_id t] returns the ID of the corresponding tool use. *) 118 118 - 148 148 + 119 149 val content : t -> string option 120 150 (** [content t] returns the optional result content. *) 121 121 - 151 151 + 122 152 val is_error : t -> bool option 123 153 (** [is_error t] returns whether this result represents an error. *) 124 124 - 125 125 - val to_json : t -> Ezjsonm.value 154 154 + 155 155 + val jsont : t Jsont.t 156 156 + (** [jsont] is the Jsont codec for tool result blocks. *) 157 157 + 158 158 + val to_json : t -> Jsont.json 126 159 (** [to_json t] converts the tool result block to its JSON representation. *) 127 127 - 128 128 - val of_json : Ezjsonm.value -> t 160 160 + 161 161 + val of_json : Jsont.json -> t 129 162 (** [of_json json] parses a tool result block from JSON. 130 163 @raise Invalid_argument if the JSON is not a valid tool result block. *) 131 131 - 164 164 + 132 165 val pp : Format.formatter -> t -> unit 133 166 (** [pp fmt t] pretty-prints the tool result block. *) 134 167 end ··· 137 170 138 171 module Thinking : sig 139 172 (** Assistant's internal reasoning blocks. *) 140 140 - 173 173 + 174 174 + module Unknown : sig 175 175 + type t = Jsont.json 176 176 + val empty : t 177 177 + val is_empty : t -> bool 178 178 + val jsont : t Jsont.t 179 179 + end 180 180 + 141 181 type t 142 182 (** The type of thinking blocks. *) 143 143 - 183 183 + 144 184 val create : thinking:string -> signature:string -> t 145 185 (** [create ~thinking ~signature] creates a new thinking block. 146 186 @param thinking The assistant's internal reasoning 147 187 @param signature Cryptographic signature for verification *) 148 148 - 188 188 + 149 189 val thinking : t -> string 150 190 (** [thinking t] returns the thinking content. *) 151 151 - 191 191 + 152 192 val signature : t -> string 153 193 (** [signature t] returns the cryptographic signature. *) 154 154 - 155 155 - val to_json : t -> Ezjsonm.value 194 194 + 195 195 + val jsont : t Jsont.t 196 196 + (** [jsont] is the Jsont codec for thinking blocks. *) 197 197 + 198 198 + val to_json : t -> Jsont.json 156 199 (** [to_json t] converts the thinking block to its JSON representation. *) 157 157 - 158 158 - val of_json : Ezjsonm.value -> t 200 200 + 201 201 + val of_json : Jsont.json -> t 159 202 (** [of_json json] parses a thinking block from JSON. 160 203 @raise Invalid_argument if the JSON is not a valid thinking block. *) 161 161 - 204 204 + 162 205 val pp : Format.formatter -> t -> unit 163 206 (** [pp fmt t] pretty-prints the thinking block. *) 164 207 end ··· 184 227 val thinking : thinking:string -> signature:string -> t 185 228 (** [thinking ~thinking ~signature] creates a thinking content block. *) 186 229 187 187 - val to_json : t -> Ezjsonm.value 230 230 + val jsont : t Jsont.t 231 231 + (** [jsont] is the Jsont codec for content blocks. *) 232 232 + 233 233 + val to_json : t -> Jsont.json 188 234 (** [to_json t] converts any content block to its JSON representation. *) 189 235 190 190 - val of_json : Ezjsonm.value -> t 236 236 + val of_json : Jsont.json -> t 191 237 (** [of_json json] parses a content block from JSON. 192 238 @raise Invalid_argument if the JSON is not a valid content block. *) 193 239

+38 -18

claudeio/lib/control.ml

reviewed

··· 1 1 - open Ezjsonm 2 2 - 3 1 let src = Logs.Src.create "claude.control" ~doc:"Claude control messages" 4 2 module Log = (val Logs.src_log src : Logs.LOG) 5 3 6 4 (* Helper for pretty-printing JSON *) 7 5 let pp_json fmt json = 8 8 - Fmt.string fmt (value_to_string json) 6 6 + let s = match Jsont_bytesrw.encode_string' Jsont.json json with 7 7 + | Ok s -> s 8 8 + | Error err -> Jsont.Error.to_string err 9 9 + in 10 10 + Fmt.string fmt s 11 11 + 12 12 + module Unknown = struct 13 13 + type t = Jsont.json 14 14 + let empty = Jsont.Object ([], Jsont.Meta.none) 15 15 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 16 16 + let jsont = Jsont.json 17 17 + end 9 18 10 19 type t = { 11 20 request_id : string; 12 21 subtype : string; 13 13 - data : value; 22 22 + data : Jsont.json; 23 23 + unknown : Unknown.t; 14 24 } 15 25 16 16 - let create ~request_id ~subtype ~data = { request_id; subtype; data } 26 26 + let jsont = 27 27 + Jsont.Object.map ~kind:"Control" 28 28 + (fun request_id subtype data unknown -> {request_id; subtype; data; unknown}) 29 29 + |> Jsont.Object.mem "request_id" Jsont.string ~enc:(fun t -> t.request_id) 30 30 + |> Jsont.Object.mem "subtype" Jsont.string ~enc:(fun t -> t.subtype) 31 31 + |> Jsont.Object.mem "data" Jsont.json ~enc:(fun t -> t.data) 32 32 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown) 33 33 + |> Jsont.Object.finish 34 34 + 35 35 + let create ~request_id ~subtype ~data = 36 36 + { request_id; subtype; data; unknown = Unknown.empty } 17 37 18 38 let request_id t = t.request_id 19 39 let subtype t = t.subtype 20 40 let data t = t.data 21 41 22 42 let to_json t = 23 23 - `O [ 24 24 - ("type", `String "control"); 25 25 - ("request_id", `String t.request_id); 26 26 - ("subtype", `String t.subtype); 27 27 - ("data", t.data); 28 28 - ] 43 43 + match Jsont_bytesrw.encode_string ~format:Jsont.Minify jsont t with 44 44 + | Ok s -> 45 45 + (match Jsont_bytesrw.decode_string' Jsont.json s with 46 46 + | Ok json -> json 47 47 + | Error e -> failwith (Jsont.Error.to_string e)) 48 48 + | Error e -> failwith e 29 49 30 30 - let of_json = function 31 31 - | `O fields -> 32 32 - let request_id = get_string (List.assoc "request_id" fields) in 33 33 - let subtype = get_string (List.assoc "subtype" fields) in 34 34 - let data = List.assoc "data" fields in 35 35 - { request_id; subtype; data } 36 36 - | _ -> raise (Invalid_argument "Control.of_json: expected object") 50 50 + let of_json json = 51 51 + match Jsont_bytesrw.encode_string ~format:Jsont.Minify Jsont.json json with 52 52 + | Ok s -> 53 53 + (match Jsont_bytesrw.decode_string jsont s with 54 54 + | Ok t -> t 55 55 + | Error e -> raise (Invalid_argument ("Control.of_json: " ^ e))) 56 56 + | Error e -> raise (Invalid_argument ("Control.of_json: " ^ e)) 37 57 38 58 let pp fmt t = 39 59 Fmt.pf fmt "@[<2>Control@ { request_id = %S;@ subtype = %S;@ data = %a }@]"

+16 -7

claudeio/lib/control.mli

reviewed

··· 1 1 (** Control messages for Claude session management. 2 2 - 2 2 + 3 3 Control messages are used to manage the interaction flow with Claude, 4 4 including session control, cancellation requests, and other operational 5 5 commands. *) 6 6 7 7 - open Ezjsonm 8 8 - 9 7 (** The log source for control message operations *) 10 8 val src : Logs.Src.t 9 9 + 10 10 + (** Unknown field preservation *) 11 11 + module Unknown : sig 12 12 + type t = Jsont.json 13 13 + val empty : t 14 14 + val is_empty : t -> bool 15 15 + val jsont : t Jsont.t 16 16 + end 11 17 12 18 type t 13 19 (** The type of control messages. *) 14 20 15 15 - val create : request_id:string -> subtype:string -> data:value -> t 21 21 + val jsont : t Jsont.t 22 22 + (** [jsont] is the jsont codec for control messages. *) 23 23 + 24 24 + val create : request_id:string -> subtype:string -> data:Jsont.json -> t 16 25 (** [create ~request_id ~subtype ~data] creates a new control message. 17 26 @param request_id Unique identifier for this control request 18 27 @param subtype The specific type of control message ··· 24 33 val subtype : t -> string 25 34 (** [subtype t] returns the control message subtype. *) 26 35 27 27 - val data : t -> value 36 36 + val data : t -> Jsont.json 28 37 (** [data t] returns the additional data associated with the control message. *) 29 38 30 30 - val to_json : t -> value 39 39 + val to_json : t -> Jsont.json 31 40 (** [to_json t] converts the control message to its JSON representation. *) 32 41 33 33 - val of_json : value -> t 42 42 + val of_json : Jsont.json -> t 34 43 (** [of_json json] parses a control message from JSON. 35 44 @raise Invalid_argument if the JSON is not a valid control message. *) 36 45

+1 -1

claudeio/lib/dune

reviewed

··· 1 1 (library 2 2 (public_name claude) 3 3 (name claude) 4 4 - (libraries eio eio.unix ezjsonm fmt logs jsont)) 4 4 + (libraries eio eio.unix fmt logs jsont jsont.bytesrw))

+478 -201

claudeio/lib/hooks.ml

reviewed

··· 1 1 - open Ezjsonm 2 2 - 3 1 let src = Logs.Src.create "claude.hooks" ~doc:"Claude hooks system" 4 2 module Log = (val Logs.src_log src : Logs.LOG) 5 3 ··· 29 27 | "PreCompact" -> Pre_compact 30 28 | s -> raise (Invalid_argument (Printf.sprintf "Unknown hook event: %s" s)) 31 29 30 30 + let event_jsont : event Jsont.t = 31 31 + Jsont.enum [ 32 32 + "PreToolUse", Pre_tool_use; 33 33 + "PostToolUse", Post_tool_use; 34 34 + "UserPromptSubmit", User_prompt_submit; 35 35 + "Stop", Stop; 36 36 + "SubagentStop", Subagent_stop; 37 37 + "PreCompact", Pre_compact; 38 38 + ] 39 39 + 32 40 (** Context provided to hook callbacks *) 33 41 module Context = struct 42 42 + module Unknown = struct 43 43 + type t = Jsont.json 44 44 + let empty = Jsont.Object ([], Jsont.Meta.none) 45 45 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 46 46 + let jsont = Jsont.json 47 47 + end 48 48 + 34 49 type t = { 35 50 signal: unit option; (* Future: abort signal support *) 51 51 + unknown : Unknown.t; 36 52 } 37 53 38 38 - let create ?(signal = None) () = { signal } 54 54 + let create ?(signal = None) ?(unknown = Unknown.empty) () = { signal; unknown } 55 55 + 56 56 + let signal t = t.signal 57 57 + let unknown t = t.unknown 58 58 + 59 59 + let jsont : t Jsont.t = 60 60 + let make unknown = { signal = None; unknown } in 61 61 + Jsont.Object.map ~kind:"Context" make 62 62 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 63 63 + |> Jsont.Object.finish 39 64 end 40 65 41 66 (** Hook decision control *) ··· 43 68 | Continue 44 69 | Block 45 70 71 71 + let decision_jsont : decision Jsont.t = 72 72 + Jsont.enum [ 73 73 + "continue", Continue; 74 74 + "block", Block; 75 75 + ] 76 76 + 46 77 (** Generic hook result *) 78 78 + module Result_unknown = struct 79 79 + type t = Jsont.json 80 80 + let empty = Jsont.Object ([], Jsont.Meta.none) 81 81 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 82 82 + let jsont = Jsont.json 83 83 + end 84 84 + 47 85 type result = { 48 86 decision: decision option; 49 87 system_message: string option; 50 50 - hook_specific_output: value option; 88 88 + hook_specific_output: Jsont.json option; 89 89 + unknown : Result_unknown.t; 51 90 } 52 91 92 92 + let result_jsont : result Jsont.t = 93 93 + let make decision system_message hook_specific_output unknown = 94 94 + { decision; system_message; hook_specific_output; unknown } 95 95 + in 96 96 + Jsont.Object.map ~kind:"Result" make 97 97 + |> Jsont.Object.opt_mem "decision" decision_jsont ~enc:(fun r -> r.decision) 98 98 + |> Jsont.Object.opt_mem "systemMessage" Jsont.string ~enc:(fun r -> r.system_message) 99 99 + |> Jsont.Object.opt_mem "hookSpecificOutput" Jsont.json ~enc:(fun r -> r.hook_specific_output) 100 100 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown) 101 101 + |> Jsont.Object.finish 102 102 + 53 103 (** {1 PreToolUse Hook} *) 54 104 module PreToolUse = struct 55 55 - type t = { 105 105 + module Input_unknown = struct 106 106 + type t = Jsont.json 107 107 + let empty = Jsont.Object ([], Jsont.Meta.none) 108 108 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 109 109 + let jsont = Jsont.json 110 110 + end 111 111 + 112 112 + type input = { 56 113 session_id: string; 57 114 transcript_path: string; 58 115 tool_name: string; 59 59 - tool_input: value; 116 116 + tool_input: Jsont.json; 117 117 + unknown : Input_unknown.t; 60 118 } 61 119 62 62 - type permission_decision = Allow | Deny | Ask 120 120 + let get_field json key = 121 121 + match json with 122 122 + | Jsont.Object (members, _) -> 123 123 + List.find_map (fun ((name, _), value) -> 124 124 + if name = key then Some value else None 125 125 + ) members 126 126 + | _ -> None 63 127 64 64 - type output = { 65 65 - permission_decision: permission_decision option; 66 66 - permission_decision_reason: string option; 67 67 - } 128 128 + let get_string json key = 129 129 + match get_field json key with 130 130 + | Some (Jsont.String (s, _)) -> Some s 131 131 + | _ -> None 68 132 69 133 let of_json json = 70 70 - { 71 71 - session_id = get_string (find json ["session_id"]); 72 72 - transcript_path = get_string (find json ["transcript_path"]); 73 73 - tool_name = get_string (find json ["tool_name"]); 74 74 - tool_input = find json ["tool_input"]; 75 75 - } 134 134 + match get_string json "session_id" with 135 135 + | None -> raise (Invalid_argument "PreToolUse: missing session_id") 136 136 + | Some session_id -> 137 137 + match get_string json "transcript_path" with 138 138 + | None -> raise (Invalid_argument "PreToolUse: missing transcript_path") 139 139 + | Some transcript_path -> 140 140 + match get_string json "tool_name" with 141 141 + | None -> raise (Invalid_argument "PreToolUse: missing tool_name") 142 142 + | Some tool_name -> 143 143 + match get_field json "tool_input" with 144 144 + | None -> raise (Invalid_argument "PreToolUse: missing tool_input") 145 145 + | Some tool_input -> 146 146 + { session_id; transcript_path; tool_name; tool_input; unknown = json } 147 147 + 148 148 + type t = input 76 149 77 150 let session_id t = t.session_id 78 151 let transcript_path t = t.transcript_path 79 152 let tool_name t = t.tool_name 80 153 let tool_input t = t.tool_input 81 81 - let raw_json t = 82 82 - dict [ 83 83 - "session_id", string t.session_id; 84 84 - "transcript_path", string t.transcript_path; 85 85 - "hook_event_name", string "PreToolUse"; 86 86 - "tool_name", string t.tool_name; 87 87 - "tool_input", t.tool_input; 154 154 + let unknown t = t.unknown 155 155 + 156 156 + let input_jsont : input Jsont.t = 157 157 + let make session_id transcript_path tool_name tool_input unknown = 158 158 + { session_id; transcript_path; tool_name; tool_input; unknown } 159 159 + in 160 160 + Jsont.Object.map ~kind:"PreToolUseInput" make 161 161 + |> Jsont.Object.mem "session_id" Jsont.string ~enc:session_id 162 162 + |> Jsont.Object.mem "transcript_path" Jsont.string ~enc:transcript_path 163 163 + |> Jsont.Object.mem "tool_name" Jsont.string ~enc:tool_name 164 164 + |> Jsont.Object.mem "tool_input" Jsont.json ~enc:tool_input 165 165 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 166 166 + |> Jsont.Object.finish 167 167 + 168 168 + type permission_decision = [ `Allow | `Deny | `Ask ] 169 169 + 170 170 + let permission_decision_jsont : permission_decision Jsont.t = 171 171 + Jsont.enum [ 172 172 + "allow", `Allow; 173 173 + "deny", `Deny; 174 174 + "ask", `Ask; 88 175 ] 89 176 90 90 - let permission_decision_to_string = function 91 91 - | Allow -> "allow" 92 92 - | Deny -> "deny" 93 93 - | Ask -> "ask" 177 177 + module Output_unknown = struct 178 178 + type t = Jsont.json 179 179 + let empty = Jsont.Object ([], Jsont.Meta.none) 180 180 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 181 181 + let jsont = Jsont.json 182 182 + end 94 183 95 95 - let output_to_json output = 96 96 - let fields = [("hookEventName", string "PreToolUse")] in 97 97 - let fields = match output.permission_decision with 98 98 - | Some pd -> ("permissionDecision", string (permission_decision_to_string pd)) :: fields 99 99 - | None -> fields 184 184 + type output = { 185 185 + permission_decision: permission_decision option; 186 186 + permission_decision_reason: string option; 187 187 + updated_input: Jsont.json option; 188 188 + unknown : Output_unknown.t; 189 189 + } 190 190 + 191 191 + let output_jsont : output Jsont.t = 192 192 + let make permission_decision permission_decision_reason updated_input unknown = 193 193 + { permission_decision; permission_decision_reason; updated_input; unknown } 100 194 in 101 101 - let fields = match output.permission_decision_reason with 102 102 - | Some reason -> ("permissionDecisionReason", string reason) :: fields 103 103 - | None -> fields 104 104 - in 105 105 - dict fields 195 195 + Jsont.Object.map ~kind:"PreToolUseOutput" make 196 196 + |> Jsont.Object.opt_mem "permissionDecision" permission_decision_jsont ~enc:(fun o -> o.permission_decision) 197 197 + |> Jsont.Object.opt_mem "permissionDecisionReason" Jsont.string ~enc:(fun o -> o.permission_decision_reason) 198 198 + |> Jsont.Object.opt_mem "updatedInput" Jsont.json ~enc:(fun o -> o.updated_input) 199 199 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun o -> o.unknown) 200 200 + |> Jsont.Object.finish 106 201 107 107 - let allow ?reason () = 108 108 - { permission_decision = Some Allow; permission_decision_reason = reason } 202 202 + let output_to_json output = 203 203 + match Jsont.Json.encode output_jsont output with 204 204 + | Ok json -> json 205 205 + | Error msg -> failwith ("PreToolUse.output_to_json: " ^ msg) 109 206 110 110 - let deny ?reason () = 111 111 - { permission_decision = Some Deny; permission_decision_reason = reason } 207 207 + let allow ?reason ?updated_input ?(unknown = Output_unknown.empty) () = 208 208 + { permission_decision = Some `Allow; permission_decision_reason = reason; 209 209 + updated_input; unknown } 112 210 113 113 - let ask ?reason () = 114 114 - { permission_decision = Some Ask; permission_decision_reason = reason } 211 211 + let deny ?reason ?(unknown = Output_unknown.empty) () = 212 212 + { permission_decision = Some `Deny; permission_decision_reason = reason; 213 213 + updated_input = None; unknown } 214 214 + 215 215 + let ask ?reason ?(unknown = Output_unknown.empty) () = 216 216 + { permission_decision = Some `Ask; permission_decision_reason = reason; 217 217 + updated_input = None; unknown } 115 218 116 116 - let continue () = 117 117 - { permission_decision = None; permission_decision_reason = None } 219 219 + let continue ?(unknown = Output_unknown.empty) () = 220 220 + { permission_decision = None; permission_decision_reason = None; 221 221 + updated_input = None; unknown } 118 222 end 119 223 120 224 (** {1 PostToolUse Hook} *) 121 225 module PostToolUse = struct 122 122 - type t = { 226 226 + module Input_unknown = struct 227 227 + type t = Jsont.json 228 228 + let empty = Jsont.Object ([], Jsont.Meta.none) 229 229 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 230 230 + let jsont = Jsont.json 231 231 + end 232 232 + 233 233 + type input = { 123 234 session_id: string; 124 235 transcript_path: string; 125 236 tool_name: string; 126 126 - tool_input: value; 127 127 - tool_response: value; 237 237 + tool_input: Jsont.json; 238 238 + tool_response: Jsont.json; 239 239 + unknown : Input_unknown.t; 128 240 } 129 241 130 130 - type output = { 131 131 - decision: decision option; 132 132 - reason: string option; 133 133 - additional_context: string option; 134 134 - } 242 242 + let get_field json key = 243 243 + match json with 244 244 + | Jsont.Object (members, _) -> 245 245 + List.find_map (fun ((name, _), value) -> 246 246 + if name = key then Some value else None 247 247 + ) members 248 248 + | _ -> None 249 249 + 250 250 + let get_string json key = 251 251 + match get_field json key with 252 252 + | Some (Jsont.String (s, _)) -> Some s 253 253 + | _ -> None 135 254 136 255 let of_json json = 137 137 - { 138 138 - session_id = get_string (find json ["session_id"]); 139 139 - transcript_path = get_string (find json ["transcript_path"]); 140 140 - tool_name = get_string (find json ["tool_name"]); 141 141 - tool_input = find json ["tool_input"]; 142 142 - tool_response = find json ["tool_response"]; 143 143 - } 256 256 + match get_string json "session_id" with 257 257 + | None -> raise (Invalid_argument "PostToolUse: missing session_id") 258 258 + | Some session_id -> 259 259 + match get_string json "transcript_path" with 260 260 + | None -> raise (Invalid_argument "PostToolUse: missing transcript_path") 261 261 + | Some transcript_path -> 262 262 + match get_string json "tool_name" with 263 263 + | None -> raise (Invalid_argument "PostToolUse: missing tool_name") 264 264 + | Some tool_name -> 265 265 + match get_field json "tool_input" with 266 266 + | None -> raise (Invalid_argument "PostToolUse: missing tool_input") 267 267 + | Some tool_input -> 268 268 + match get_field json "tool_response" with 269 269 + | None -> raise (Invalid_argument "PostToolUse: missing tool_response") 270 270 + | Some tool_response -> 271 271 + { session_id; transcript_path; tool_name; tool_input; tool_response; unknown = json } 272 272 + 273 273 + type t = input 144 274 145 275 let session_id t = t.session_id 146 276 let transcript_path t = t.transcript_path 147 277 let tool_name t = t.tool_name 148 278 let tool_input t = t.tool_input 149 279 let tool_response t = t.tool_response 150 150 - let raw_json t = 151 151 - dict [ 152 152 - "session_id", string t.session_id; 153 153 - "transcript_path", string t.transcript_path; 154 154 - "hook_event_name", string "PostToolUse"; 155 155 - "tool_name", string t.tool_name; 156 156 - "tool_input", t.tool_input; 157 157 - "tool_response", t.tool_response; 158 158 - ] 280 280 + let unknown t = t.unknown 159 281 160 160 - let output_to_json output = 161 161 - let fields = [("hookEventName", string "PostToolUse")] in 162 162 - let fields = match output.decision with 163 163 - | Some Block -> ("decision", string "block") :: fields 164 164 - | Some Continue | None -> fields 282 282 + let input_jsont : input Jsont.t = 283 283 + let make session_id transcript_path tool_name tool_input tool_response unknown = 284 284 + { session_id; transcript_path; tool_name; tool_input; tool_response; unknown } 165 285 in 166 166 - let fields = match output.reason with 167 167 - | Some r -> ("reason", string r) :: fields 168 168 - | None -> fields 286 286 + Jsont.Object.map ~kind:"PostToolUseInput" make 287 287 + |> Jsont.Object.mem "session_id" Jsont.string ~enc:session_id 288 288 + |> Jsont.Object.mem "transcript_path" Jsont.string ~enc:transcript_path 289 289 + |> Jsont.Object.mem "tool_name" Jsont.string ~enc:tool_name 290 290 + |> Jsont.Object.mem "tool_input" Jsont.json ~enc:tool_input 291 291 + |> Jsont.Object.mem "tool_response" Jsont.json ~enc:tool_response 292 292 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 293 293 + |> Jsont.Object.finish 294 294 + 295 295 + module Output_unknown = struct 296 296 + type t = Jsont.json 297 297 + let empty = Jsont.Object ([], Jsont.Meta.none) 298 298 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 299 299 + let jsont = Jsont.json 300 300 + end 301 301 + 302 302 + type output = { 303 303 + decision: decision option; 304 304 + reason: string option; 305 305 + additional_context: string option; 306 306 + unknown : Output_unknown.t; 307 307 + } 308 308 + 309 309 + let output_jsont : output Jsont.t = 310 310 + let make decision reason additional_context unknown = 311 311 + { decision; reason; additional_context; unknown } 169 312 in 170 170 - let fields = match output.additional_context with 171 171 - | Some ctx -> ("additionalContext", string ctx) :: fields 172 172 - | None -> fields 173 173 - in 174 174 - dict fields 313 313 + Jsont.Object.map ~kind:"PostToolUseOutput" make 314 314 + |> Jsont.Object.opt_mem "decision" decision_jsont ~enc:(fun o -> o.decision) 315 315 + |> Jsont.Object.opt_mem "reason" Jsont.string ~enc:(fun o -> o.reason) 316 316 + |> Jsont.Object.opt_mem "additionalContext" Jsont.string ~enc:(fun o -> o.additional_context) 317 317 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun o -> o.unknown) 318 318 + |> Jsont.Object.finish 175 319 176 176 - let continue ?additional_context () = 177 177 - { decision = None; reason = None; additional_context } 320 320 + let output_to_json output = 321 321 + match Jsont.Json.encode output_jsont output with 322 322 + | Ok json -> json 323 323 + | Error msg -> failwith ("PostToolUse.output_to_json: " ^ msg) 178 324 179 179 - let block ?reason ?additional_context () = 180 180 - { decision = Some Block; reason; additional_context } 325 325 + let continue ?additional_context ?(unknown = Output_unknown.empty) () = 326 326 + { decision = None; reason = None; additional_context; unknown } 327 327 + 328 328 + let block ?reason ?additional_context ?(unknown = Output_unknown.empty) () = 329 329 + { decision = Some Block; reason; additional_context; unknown } 181 330 end 182 331 183 332 (** {1 UserPromptSubmit Hook} *) 184 333 module UserPromptSubmit = struct 185 185 - type t = { 334 334 + module Input_unknown = struct 335 335 + type t = Jsont.json 336 336 + let empty = Jsont.Object ([], Jsont.Meta.none) 337 337 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 338 338 + let jsont = Jsont.json 339 339 + end 340 340 + 341 341 + type input = { 186 342 session_id: string; 187 343 transcript_path: string; 188 344 prompt: string; 345 345 + unknown : Input_unknown.t; 189 346 } 190 347 191 191 - type output = { 192 192 - decision: decision option; 193 193 - reason: string option; 194 194 - additional_context: string option; 195 195 - } 348 348 + let get_field json key = 349 349 + match json with 350 350 + | Jsont.Object (members, _) -> 351 351 + List.find_map (fun ((name, _), value) -> 352 352 + if name = key then Some value else None 353 353 + ) members 354 354 + | _ -> None 355 355 + 356 356 + let get_string json key = 357 357 + match get_field json key with 358 358 + | Some (Jsont.String (s, _)) -> Some s 359 359 + | _ -> None 196 360 197 361 let of_json json = 198 198 - { 199 199 - session_id = get_string (find json ["session_id"]); 200 200 - transcript_path = get_string (find json ["transcript_path"]); 201 201 - prompt = get_string (find json ["prompt"]); 202 202 - } 362 362 + match get_string json "session_id" with 363 363 + | None -> raise (Invalid_argument "UserPromptSubmit: missing session_id") 364 364 + | Some session_id -> 365 365 + match get_string json "transcript_path" with 366 366 + | None -> raise (Invalid_argument "UserPromptSubmit: missing transcript_path") 367 367 + | Some transcript_path -> 368 368 + match get_string json "prompt" with 369 369 + | None -> raise (Invalid_argument "UserPromptSubmit: missing prompt") 370 370 + | Some prompt -> 371 371 + { session_id; transcript_path; prompt; unknown = json } 372 372 + 373 373 + type t = input 203 374 204 375 let session_id t = t.session_id 205 376 let transcript_path t = t.transcript_path 206 377 let prompt t = t.prompt 207 207 - let raw_json t = 208 208 - dict [ 209 209 - "session_id", string t.session_id; 210 210 - "transcript_path", string t.transcript_path; 211 211 - "hook_event_name", string "UserPromptSubmit"; 212 212 - "prompt", string t.prompt; 213 213 - ] 378 378 + let unknown t = t.unknown 214 379 215 215 - let output_to_json output = 216 216 - let fields = [("hookEventName", string "UserPromptSubmit")] in 217 217 - let fields = match output.decision with 218 218 - | Some Block -> ("decision", string "block") :: fields 219 219 - | Some Continue | None -> fields 380 380 + let input_jsont : input Jsont.t = 381 381 + let make session_id transcript_path prompt unknown = 382 382 + { session_id; transcript_path; prompt; unknown } 220 383 in 221 221 - let fields = match output.reason with 222 222 - | Some r -> ("reason", string r) :: fields 223 223 - | None -> fields 224 224 - in 225 225 - let fields = match output.additional_context with 226 226 - | Some ctx -> ("additionalContext", string ctx) :: fields 227 227 - | None -> fields 384 384 + Jsont.Object.map ~kind:"UserPromptSubmitInput" make 385 385 + |> Jsont.Object.mem "session_id" Jsont.string ~enc:session_id 386 386 + |> Jsont.Object.mem "transcript_path" Jsont.string ~enc:transcript_path 387 387 + |> Jsont.Object.mem "prompt" Jsont.string ~enc:prompt 388 388 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 389 389 + |> Jsont.Object.finish 390 390 + 391 391 + module Output_unknown = struct 392 392 + type t = Jsont.json 393 393 + let empty = Jsont.Object ([], Jsont.Meta.none) 394 394 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 395 395 + let jsont = Jsont.json 396 396 + end 397 397 + 398 398 + type output = { 399 399 + decision: decision option; 400 400 + reason: string option; 401 401 + additional_context: string option; 402 402 + unknown : Output_unknown.t; 403 403 + } 404 404 + 405 405 + let output_jsont : output Jsont.t = 406 406 + let make decision reason additional_context unknown = 407 407 + { decision; reason; additional_context; unknown } 228 408 in 229 229 - dict fields 409 409 + Jsont.Object.map ~kind:"UserPromptSubmitOutput" make 410 410 + |> Jsont.Object.opt_mem "decision" decision_jsont ~enc:(fun o -> o.decision) 411 411 + |> Jsont.Object.opt_mem "reason" Jsont.string ~enc:(fun o -> o.reason) 412 412 + |> Jsont.Object.opt_mem "additionalContext" Jsont.string ~enc:(fun o -> o.additional_context) 413 413 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun o -> o.unknown) 414 414 + |> Jsont.Object.finish 230 415 231 231 - let continue ?additional_context () = 232 232 - { decision = None; reason = None; additional_context } 416 416 + let output_to_json output = 417 417 + match Jsont.Json.encode output_jsont output with 418 418 + | Ok json -> json 419 419 + | Error msg -> failwith ("UserPromptSubmit.output_to_json: " ^ msg) 233 420 234 234 - let block ?reason () = 235 235 - { decision = Some Block; reason; additional_context = None } 421 421 + let continue ?additional_context ?(unknown = Output_unknown.empty) () = 422 422 + { decision = None; reason = None; additional_context; unknown } 423 423 + 424 424 + let block ?reason ?(unknown = Output_unknown.empty) () = 425 425 + { decision = Some Block; reason; additional_context = None; unknown } 236 426 end 237 427 238 428 (** {1 Stop Hook} *) 239 429 module Stop = struct 240 240 - type t = { 430 430 + module Input_unknown = struct 431 431 + type t = Jsont.json 432 432 + let empty = Jsont.Object ([], Jsont.Meta.none) 433 433 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 434 434 + let jsont = Jsont.json 435 435 + end 436 436 + 437 437 + type input = { 241 438 session_id: string; 242 439 transcript_path: string; 243 440 stop_hook_active: bool; 441 441 + unknown : Input_unknown.t; 244 442 } 245 443 246 246 - type output = { 247 247 - decision: decision option; 248 248 - reason: string option; 249 249 - } 444 444 + let get_field json key = 445 445 + match json with 446 446 + | Jsont.Object (members, _) -> 447 447 + List.find_map (fun ((name, _), value) -> 448 448 + if name = key then Some value else None 449 449 + ) members 450 450 + | _ -> None 451 451 + 452 452 + let get_string json key = 453 453 + match get_field json key with 454 454 + | Some (Jsont.String (s, _)) -> Some s 455 455 + | _ -> None 456 456 + 457 457 + let get_bool json key = 458 458 + match get_field json key with 459 459 + | Some (Jsont.Bool (b, _)) -> Some b 460 460 + | _ -> None 250 461 251 462 let of_json json = 252 252 - { 253 253 - session_id = get_string (find json ["session_id"]); 254 254 - transcript_path = get_string (find json ["transcript_path"]); 255 255 - stop_hook_active = get_bool (find json ["stop_hook_active"]); 256 256 - } 463 463 + match get_string json "session_id" with 464 464 + | None -> raise (Invalid_argument "Stop: missing session_id") 465 465 + | Some session_id -> 466 466 + match get_string json "transcript_path" with 467 467 + | None -> raise (Invalid_argument "Stop: missing transcript_path") 468 468 + | Some transcript_path -> 469 469 + match get_bool json "stop_hook_active" with 470 470 + | None -> raise (Invalid_argument "Stop: missing stop_hook_active") 471 471 + | Some stop_hook_active -> 472 472 + { session_id; transcript_path; stop_hook_active; unknown = json } 473 473 + 474 474 + type t = input 257 475 258 476 let session_id t = t.session_id 259 477 let transcript_path t = t.transcript_path 260 478 let stop_hook_active t = t.stop_hook_active 261 261 - let raw_json t = 262 262 - dict [ 263 263 - "session_id", string t.session_id; 264 264 - "transcript_path", string t.transcript_path; 265 265 - "hook_event_name", string "Stop"; 266 266 - "stop_hook_active", bool t.stop_hook_active; 267 267 - ] 479 479 + let unknown t = t.unknown 268 480 269 269 - let output_to_json output = 270 270 - let fields = [] in 271 271 - let fields = match output.decision with 272 272 - | Some Block -> ("decision", string "block") :: fields 273 273 - | Some Continue | None -> fields 481 481 + let input_jsont : input Jsont.t = 482 482 + let make session_id transcript_path stop_hook_active unknown = 483 483 + { session_id; transcript_path; stop_hook_active; unknown } 274 484 in 275 275 - let fields = match output.reason with 276 276 - | Some r -> ("reason", string r) :: fields 277 277 - | None -> fields 485 485 + Jsont.Object.map ~kind:"StopInput" make 486 486 + |> Jsont.Object.mem "session_id" Jsont.string ~enc:session_id 487 487 + |> Jsont.Object.mem "transcript_path" Jsont.string ~enc:transcript_path 488 488 + |> Jsont.Object.mem "stop_hook_active" Jsont.bool ~enc:stop_hook_active 489 489 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 490 490 + |> Jsont.Object.finish 491 491 + 492 492 + module Output_unknown = struct 493 493 + type t = Jsont.json 494 494 + let empty = Jsont.Object ([], Jsont.Meta.none) 495 495 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 496 496 + let jsont = Jsont.json 497 497 + end 498 498 + 499 499 + type output = { 500 500 + decision: decision option; 501 501 + reason: string option; 502 502 + unknown : Output_unknown.t; 503 503 + } 504 504 + 505 505 + let output_jsont : output Jsont.t = 506 506 + let make decision reason unknown = 507 507 + { decision; reason; unknown } 278 508 in 279 279 - dict fields 509 509 + Jsont.Object.map ~kind:"StopOutput" make 510 510 + |> Jsont.Object.opt_mem "decision" decision_jsont ~enc:(fun o -> o.decision) 511 511 + |> Jsont.Object.opt_mem "reason" Jsont.string ~enc:(fun o -> o.reason) 512 512 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun o -> o.unknown) 513 513 + |> Jsont.Object.finish 514 514 + 515 515 + let output_to_json output = 516 516 + match Jsont.Json.encode output_jsont output with 517 517 + | Ok json -> json 518 518 + | Error msg -> failwith ("Stop.output_to_json: " ^ msg) 280 519 281 281 - let continue () = { decision = None; reason = None } 282 282 - let block ?reason () = { decision = Some Block; reason } 520 520 + let continue ?(unknown = Output_unknown.empty) () = { decision = None; reason = None; unknown } 521 521 + let block ?reason ?(unknown = Output_unknown.empty) () = { decision = Some Block; reason; unknown } 283 522 end 284 523 285 524 (** {1 SubagentStop Hook} - Same structure as Stop *) 286 525 module SubagentStop = struct 287 526 include Stop 288 527 528 528 + let get_field json key = 529 529 + match json with 530 530 + | Jsont.Object (members, _) -> 531 531 + List.find_map (fun ((name, _), value) -> 532 532 + if name = key then Some value else None 533 533 + ) members 534 534 + | _ -> None 535 535 + 536 536 + let get_string json key = 537 537 + match get_field json key with 538 538 + | Some (Jsont.String (s, _)) -> Some s 539 539 + | _ -> None 540 540 + 541 541 + let get_bool json key = 542 542 + match get_field json key with 543 543 + | Some (Jsont.Bool (b, _)) -> Some b 544 544 + | _ -> None 545 545 + 289 546 let of_json json = 290 290 - { 291 291 - session_id = get_string (find json ["session_id"]); 292 292 - transcript_path = get_string (find json ["transcript_path"]); 293 293 - stop_hook_active = get_bool (find json ["stop_hook_active"]); 294 294 - } 295 295 - 296 296 - let raw_json t = 297 297 - dict [ 298 298 - "session_id", string t.session_id; 299 299 - "transcript_path", string t.transcript_path; 300 300 - "hook_event_name", string "SubagentStop"; 301 301 - "stop_hook_active", bool t.stop_hook_active; 302 302 - ] 547 547 + match get_string json "session_id" with 548 548 + | None -> raise (Invalid_argument "SubagentStop: missing session_id") 549 549 + | Some session_id -> 550 550 + match get_string json "transcript_path" with 551 551 + | None -> raise (Invalid_argument "SubagentStop: missing transcript_path") 552 552 + | Some transcript_path -> 553 553 + match get_bool json "stop_hook_active" with 554 554 + | None -> raise (Invalid_argument "SubagentStop: missing stop_hook_active") 555 555 + | Some stop_hook_active -> 556 556 + { session_id; transcript_path; stop_hook_active; unknown = json } 303 557 end 304 558 305 559 (** {1 PreCompact Hook} *) 306 560 module PreCompact = struct 307 307 - type t = { 561 561 + module Input_unknown = struct 562 562 + type t = Jsont.json 563 563 + let empty = Jsont.Object ([], Jsont.Meta.none) 564 564 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 565 565 + let jsont = Jsont.json 566 566 + end 567 567 + 568 568 + type input = { 308 569 session_id: string; 309 570 transcript_path: string; 571 571 + unknown : Input_unknown.t; 310 572 } 311 573 312 312 - type output = unit (* No specific output for PreCompact *) 574 574 + let get_field json key = 575 575 + match json with 576 576 + | Jsont.Object (members, _) -> 577 577 + List.find_map (fun ((name, _), value) -> 578 578 + if name = key then Some value else None 579 579 + ) members 580 580 + | _ -> None 581 581 + 582 582 + let get_string json key = 583 583 + match get_field json key with 584 584 + | Some (Jsont.String (s, _)) -> Some s 585 585 + | _ -> None 313 586 314 587 let of_json json = 315 315 - { 316 316 - session_id = get_string (find json ["session_id"]); 317 317 - transcript_path = get_string (find json ["transcript_path"]); 318 318 - } 588 588 + match get_string json "session_id" with 589 589 + | None -> raise (Invalid_argument "PreCompact: missing session_id") 590 590 + | Some session_id -> 591 591 + match get_string json "transcript_path" with 592 592 + | None -> raise (Invalid_argument "PreCompact: missing transcript_path") 593 593 + | Some transcript_path -> 594 594 + { session_id; transcript_path; unknown = json } 595 595 + 596 596 + type t = input 319 597 320 598 let session_id t = t.session_id 321 599 let transcript_path t = t.transcript_path 322 322 - let raw_json t = 323 323 - dict [ 324 324 - "session_id", string t.session_id; 325 325 - "transcript_path", string t.transcript_path; 326 326 - "hook_event_name", string "PreCompact"; 327 327 - ] 600 600 + let unknown t = t.unknown 601 601 + 602 602 + let input_jsont : input Jsont.t = 603 603 + let make session_id transcript_path unknown = 604 604 + { session_id; transcript_path; unknown } 605 605 + in 606 606 + Jsont.Object.map ~kind:"PreCompactInput" make 607 607 + |> Jsont.Object.mem "session_id" Jsont.string ~enc:session_id 608 608 + |> Jsont.Object.mem "transcript_path" Jsont.string ~enc:transcript_path 609 609 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 610 610 + |> Jsont.Object.finish 611 611 + 612 612 + type output = unit (* No specific output for PreCompact *) 328 613 329 329 - let output_to_json () = dict [] 614 614 + let output_to_json () = Jsont.Object ([], Jsont.Meta.none) 330 615 331 616 let continue () = () 332 617 end 333 618 334 619 (** {1 Generic Callback Type} *) 335 620 type callback = 336 336 - input:value -> 621 621 + input:Jsont.json -> 337 622 tool_use_id:string option -> 338 623 context:Context.t -> 339 624 result ··· 347 632 type config = (event * matcher list) list 348 633 349 634 (** {1 Result Builders} *) 350 350 - let continue ?system_message ?hook_specific_output () = 351 351 - { decision = None; system_message; hook_specific_output } 635 635 + let continue ?system_message ?hook_specific_output ?(unknown = Result_unknown.empty) () = 636 636 + { decision = None; system_message; hook_specific_output; unknown } 352 637 353 353 - let block ?system_message ?hook_specific_output () = 354 354 - { decision = Some Block; system_message; hook_specific_output } 638 638 + let block ?system_message ?hook_specific_output ?(unknown = Result_unknown.empty) () = 639 639 + { decision = Some Block; system_message; hook_specific_output; unknown } 355 640 356 641 (** {1 Matcher Builders} *) 357 642 let matcher ?pattern callbacks = { matcher = pattern; callbacks } ··· 364 649 365 650 (** {1 JSON Conversion} *) 366 651 let result_to_json result = 367 367 - let fields = [] in 368 368 - let fields = match result.decision with 369 369 - | Some Block -> ("decision", string "block") :: fields 370 370 - | Some Continue | None -> fields 371 371 - in 372 372 - let fields = match result.system_message with 373 373 - | Some msg -> ("systemMessage", string msg) :: fields 374 374 - | None -> fields 375 375 - in 376 376 - let fields = match result.hook_specific_output with 377 377 - | Some output -> ("hookSpecificOutput", output) :: fields 378 378 - | None -> fields 379 379 - in 380 380 - dict fields 652 652 + match Jsont.Json.encode result_jsont result with 653 653 + | Ok json -> json 654 654 + | Error msg -> failwith ("result_to_json: " ^ msg) 381 655 382 656 let config_to_protocol_format config = 383 657 let hooks_dict = List.map (fun (event, matchers) -> 384 658 let event_name = event_to_string event in 385 659 let matchers_json = List.map (fun m -> 386 660 (* matcher and hookCallbackIds will be filled in by client *) 387 387 - dict [ 388 388 - "matcher", (match m.matcher with Some p -> string p | None -> `Null); 389 389 - "callbacks", `A []; (* Placeholder, filled by client *) 390 390 - ] 661 661 + let mems = [ 662 662 + Jsont.Json.mem (Jsont.Json.name "matcher") (match m.matcher with 663 663 + | Some p -> Jsont.Json.string p 664 664 + | None -> Jsont.Json.null ()); 665 665 + Jsont.Json.mem (Jsont.Json.name "callbacks") (Jsont.Json.list []); (* Placeholder, filled by client *) 666 666 + ] in 667 667 + Jsont.Json.object' mems 391 668 ) matchers in 392 392 - (event_name, `A matchers_json) 669 669 + Jsont.Json.mem (Jsont.Json.name event_name) (Jsont.Json.list matchers_json) 393 670 ) config in 394 394 - dict hooks_dict 671 671 + Jsont.Json.object' hooks_dict

+228 -64

claudeio/lib/hooks.mli

reviewed

··· 16 16 open Eio.Std 17 17 18 18 (* Block dangerous bash commands *) 19 19 + let get_string json key = 20 20 + match json with 21 21 + | Jsont.Object (members, _) -> 22 22 + List.find_map (fun ((name, _), value) -> 23 23 + if name = key then 24 24 + match value with 25 25 + | Jsont.String (s, _) -> Some s 26 26 + | _ -> None 27 27 + else None 28 28 + ) members 29 29 + | _ -> None 30 30 + in 19 31 let block_rm_rf ~input ~tool_use_id:_ ~context:_ = 20 32 let hook = Hooks.PreToolUse.of_json input in 21 33 if Hooks.PreToolUse.tool_name hook = "Bash" then 22 34 let tool_input = Hooks.PreToolUse.tool_input hook in 23 23 - match Ezjsonm.find tool_input ["command"] with 24 24 - | `String cmd when String.contains cmd "rm -rf" -> 35 35 + match get_string tool_input "command" with 36 36 + | Some cmd when String.contains cmd "rm -rf" -> 25 37 let output = Hooks.PreToolUse.deny ~reason:"Dangerous command" () in 26 38 Hooks.continue 27 39 ~hook_specific_output:(Hooks.PreToolUse.output_to_json output) ··· 56 68 57 69 val event_to_string : event -> string 58 70 val event_of_string : string -> event 71 71 + val event_jsont : event Jsont.t 59 72 60 73 (** {1 Context} *) 61 74 62 75 module Context : sig 63 63 - type t 64 64 - val create : ?signal:unit option -> unit -> t 76 76 + module Unknown : sig 77 77 + type t = Jsont.json 78 78 + val empty : t 79 79 + val is_empty : t -> bool 80 80 + val jsont : t Jsont.t 81 81 + end 82 82 + 83 83 + type t = { 84 84 + signal: unit option; 85 85 + unknown : Unknown.t; 86 86 + } 87 87 + 88 88 + val create : ?signal:unit option -> ?unknown:Unknown.t -> unit -> t 89 89 + val signal : t -> unit option 90 90 + val unknown : t -> Unknown.t 91 91 + val jsont : t Jsont.t 65 92 end 66 93 67 94 (** {1 Decisions} *) ··· 69 96 type decision = 70 97 | Continue (** Allow the action to proceed *) 71 98 | Block (** Block the action *) 99 99 + 100 100 + val decision_jsont : decision Jsont.t 72 101 73 102 (** {1 Generic Hook Result} *) 74 103 104 104 + module Result_unknown : sig 105 105 + type t = Jsont.json 106 106 + val empty : t 107 107 + val is_empty : t -> bool 108 108 + val jsont : t Jsont.t 109 109 + end 110 110 + 75 111 (** Generic result structure for hooks *) 76 112 type result = { 77 113 decision: decision option; 78 114 system_message: string option; 79 79 - hook_specific_output: Ezjsonm.value option; 115 115 + hook_specific_output: Jsont.json option; 116 116 + unknown: Result_unknown.t; 80 117 } 118 118 + 119 119 + val result_jsont : result Jsont.t 81 120 82 121 (** {1 Typed Hook Modules} *) 83 122 84 123 (** PreToolUse hook - fires before tool execution *) 85 124 module PreToolUse : sig 125 125 + module Input_unknown : sig 126 126 + type t = Jsont.json 127 127 + val empty : t 128 128 + val is_empty : t -> bool 129 129 + val jsont : t Jsont.t 130 130 + end 131 131 + 86 132 (** Typed input for PreToolUse hooks *) 87 87 - type t 133 133 + type input = { 134 134 + session_id: string; 135 135 + transcript_path: string; 136 136 + tool_name: string; 137 137 + tool_input: Jsont.json; 138 138 + unknown: Input_unknown.t; 139 139 + } 140 140 + 141 141 + type t = input 142 142 + 143 143 + (** Parse hook input from JSON *) 144 144 + val of_json : Jsont.json -> t 145 145 + 146 146 + (** {2 Accessors} *) 147 147 + val session_id : t -> string 148 148 + val transcript_path : t -> string 149 149 + val tool_name : t -> string 150 150 + val tool_input : t -> Jsont.json 151 151 + val unknown : t -> Input_unknown.t 152 152 + 153 153 + val input_jsont : input Jsont.t 88 154 89 155 (** Permission decision for tool usage *) 90 90 - type permission_decision = Allow | Deny | Ask 156 156 + type permission_decision = [ `Allow | `Deny | `Ask ] 157 157 + 158 158 + val permission_decision_jsont : permission_decision Jsont.t 159 159 + 160 160 + module Output_unknown : sig 161 161 + type t = Jsont.json 162 162 + val empty : t 163 163 + val is_empty : t -> bool 164 164 + val jsont : t Jsont.t 165 165 + end 91 166 92 167 (** Typed output for PreToolUse hooks *) 93 168 type output = { 94 169 permission_decision: permission_decision option; 95 170 permission_decision_reason: string option; 171 171 + updated_input: Jsont.json option; 172 172 + unknown: Output_unknown.t; 96 173 } 97 174 98 98 - (** Parse hook input from JSON *) 99 99 - val of_json : Ezjsonm.value -> t 100 100 - 101 101 - (** {2 Accessors} *) 102 102 - val session_id : t -> string 103 103 - val transcript_path : t -> string 104 104 - val tool_name : t -> string 105 105 - val tool_input : t -> Ezjsonm.value 106 106 - val raw_json : t -> Ezjsonm.value 175 175 + val output_jsont : output Jsont.t 107 176 108 177 (** {2 Response Builders} *) 109 109 - val allow : ?reason:string -> unit -> output 110 110 - val deny : ?reason:string -> unit -> output 111 111 - val ask : ?reason:string -> unit -> output 112 112 - val continue : unit -> output 178 178 + val allow : ?reason:string -> ?updated_input:Jsont.json -> ?unknown:Output_unknown.t -> unit -> output 179 179 + val deny : ?reason:string -> ?unknown:Output_unknown.t -> unit -> output 180 180 + val ask : ?reason:string -> ?unknown:Output_unknown.t -> unit -> output 181 181 + val continue : ?unknown:Output_unknown.t -> unit -> output 113 182 114 183 (** Convert output to JSON for hook_specific_output *) 115 115 - val output_to_json : output -> Ezjsonm.value 184 184 + val output_to_json : output -> Jsont.json 116 185 end 117 186 118 187 (** PostToolUse hook - fires after tool execution *) 119 188 module PostToolUse : sig 120 120 - type t 189 189 + module Input_unknown : sig 190 190 + type t = Jsont.json 191 191 + val empty : t 192 192 + val is_empty : t -> bool 193 193 + val jsont : t Jsont.t 194 194 + end 121 195 122 122 - type output = { 123 123 - decision: decision option; 124 124 - reason: string option; 125 125 - additional_context: string option; 196 196 + type input = { 197 197 + session_id: string; 198 198 + transcript_path: string; 199 199 + tool_name: string; 200 200 + tool_input: Jsont.json; 201 201 + tool_response: Jsont.json; 202 202 + unknown: Input_unknown.t; 126 203 } 127 204 128 128 - val of_json : Ezjsonm.value -> t 205 205 + type t = input 206 206 + 207 207 + val of_json : Jsont.json -> t 129 208 130 209 val session_id : t -> string 131 210 val transcript_path : t -> string 132 211 val tool_name : t -> string 133 133 - val tool_input : t -> Ezjsonm.value 134 134 - val tool_response : t -> Ezjsonm.value 135 135 - val raw_json : t -> Ezjsonm.value 212 212 + val tool_input : t -> Jsont.json 213 213 + val tool_response : t -> Jsont.json 214 214 + val unknown : t -> Input_unknown.t 136 215 137 137 - val continue : ?additional_context:string -> unit -> output 138 138 - val block : ?reason:string -> ?additional_context:string -> unit -> output 139 139 - val output_to_json : output -> Ezjsonm.value 140 140 - end 216 216 + val input_jsont : input Jsont.t 141 217 142 142 - (** UserPromptSubmit hook - fires when user submits a prompt *) 143 143 - module UserPromptSubmit : sig 144 144 - type t 218 218 + module Output_unknown : sig 219 219 + type t = Jsont.json 220 220 + val empty : t 221 221 + val is_empty : t -> bool 222 222 + val jsont : t Jsont.t 223 223 + end 145 224 146 225 type output = { 147 226 decision: decision option; 148 227 reason: string option; 149 228 additional_context: string option; 229 229 + unknown: Output_unknown.t; 150 230 } 151 231 152 152 - val of_json : Ezjsonm.value -> t 232 232 + val output_jsont : output Jsont.t 233 233 + 234 234 + val continue : ?additional_context:string -> ?unknown:Output_unknown.t -> unit -> output 235 235 + val block : ?reason:string -> ?additional_context:string -> ?unknown:Output_unknown.t -> unit -> output 236 236 + val output_to_json : output -> Jsont.json 237 237 + end 238 238 + 239 239 + (** UserPromptSubmit hook - fires when user submits a prompt *) 240 240 + module UserPromptSubmit : sig 241 241 + module Input_unknown : sig 242 242 + type t = Jsont.json 243 243 + val empty : t 244 244 + val is_empty : t -> bool 245 245 + val jsont : t Jsont.t 246 246 + end 247 247 + 248 248 + type input = { 249 249 + session_id: string; 250 250 + transcript_path: string; 251 251 + prompt: string; 252 252 + unknown: Input_unknown.t; 253 253 + } 254 254 + 255 255 + type t = input 256 256 + 257 257 + val of_json : Jsont.json -> t 153 258 154 259 val session_id : t -> string 155 260 val transcript_path : t -> string 156 261 val prompt : t -> string 157 157 - val raw_json : t -> Ezjsonm.value 262 262 + val unknown : t -> Input_unknown.t 158 263 159 159 - val continue : ?additional_context:string -> unit -> output 160 160 - val block : ?reason:string -> unit -> output 161 161 - val output_to_json : output -> Ezjsonm.value 162 162 - end 264 264 + val input_jsont : input Jsont.t 163 265 164 164 - (** Stop hook - fires when conversation stops *) 165 165 - module Stop : sig 166 166 - type t 266 266 + module Output_unknown : sig 267 267 + type t = Jsont.json 268 268 + val empty : t 269 269 + val is_empty : t -> bool 270 270 + val jsont : t Jsont.t 271 271 + end 167 272 168 273 type output = { 169 274 decision: decision option; 170 275 reason: string option; 276 276 + additional_context: string option; 277 277 + unknown: Output_unknown.t; 171 278 } 172 279 173 173 - val of_json : Ezjsonm.value -> t 280 280 + val output_jsont : output Jsont.t 281 281 + 282 282 + val continue : ?additional_context:string -> ?unknown:Output_unknown.t -> unit -> output 283 283 + val block : ?reason:string -> ?unknown:Output_unknown.t -> unit -> output 284 284 + val output_to_json : output -> Jsont.json 285 285 + end 286 286 + 287 287 + (** Stop hook - fires when conversation stops *) 288 288 + module Stop : sig 289 289 + module Input_unknown : sig 290 290 + type t = Jsont.json 291 291 + val empty : t 292 292 + val is_empty : t -> bool 293 293 + val jsont : t Jsont.t 294 294 + end 295 295 + 296 296 + type input = { 297 297 + session_id: string; 298 298 + transcript_path: string; 299 299 + stop_hook_active: bool; 300 300 + unknown: Input_unknown.t; 301 301 + } 302 302 + 303 303 + type t = input 304 304 + 305 305 + val of_json : Jsont.json -> t 174 306 175 307 val session_id : t -> string 176 308 val transcript_path : t -> string 177 309 val stop_hook_active : t -> bool 178 178 - val raw_json : t -> Ezjsonm.value 310 310 + val unknown : t -> Input_unknown.t 311 311 + 312 312 + val input_jsont : input Jsont.t 313 313 + 314 314 + module Output_unknown : sig 315 315 + type t = Jsont.json 316 316 + val empty : t 317 317 + val is_empty : t -> bool 318 318 + val jsont : t Jsont.t 319 319 + end 320 320 + 321 321 + type output = { 322 322 + decision: decision option; 323 323 + reason: string option; 324 324 + unknown: Output_unknown.t; 325 325 + } 179 326 180 180 - val continue : unit -> output 181 181 - val block : ?reason:string -> unit -> output 182 182 - val output_to_json : output -> Ezjsonm.value 327 327 + val output_jsont : output Jsont.t 328 328 + 329 329 + val continue : ?unknown:Output_unknown.t -> unit -> output 330 330 + val block : ?reason:string -> ?unknown:Output_unknown.t -> unit -> output 331 331 + val output_to_json : output -> Jsont.json 183 332 end 184 333 185 334 (** SubagentStop hook - fires when a subagent stops *) 186 335 module SubagentStop : sig 187 336 include module type of Stop 188 188 - val of_json : Ezjsonm.value -> t 189 189 - val raw_json : t -> Ezjsonm.value 337 337 + val of_json : Jsont.json -> t 190 338 end 191 339 192 340 (** PreCompact hook - fires before message compaction *) 193 341 module PreCompact : sig 194 194 - type t 342 342 + module Input_unknown : sig 343 343 + type t = Jsont.json 344 344 + val empty : t 345 345 + val is_empty : t -> bool 346 346 + val jsont : t Jsont.t 347 347 + end 348 348 + 349 349 + type input = { 350 350 + session_id: string; 351 351 + transcript_path: string; 352 352 + unknown: Input_unknown.t; 353 353 + } 354 354 + 355 355 + type t = input 356 356 + 195 357 type output = unit 196 358 197 197 - val of_json : Ezjsonm.value -> t 359 359 + val of_json : Jsont.json -> t 198 360 199 361 val session_id : t -> string 200 362 val transcript_path : t -> string 201 201 - val raw_json : t -> Ezjsonm.value 363 363 + val unknown : t -> Input_unknown.t 364 364 + 365 365 + val input_jsont : input Jsont.t 202 366 203 367 val continue : unit -> output 204 204 - val output_to_json : output -> Ezjsonm.value 368 368 + val output_to_json : output -> Jsont.json 205 369 end 206 370 207 371 (** {1 Callbacks} *) ··· 216 380 And return a generic [result] with optional hook-specific output. 217 381 *) 218 382 type callback = 219 219 - input:Ezjsonm.value -> 383 383 + input:Jsont.json -> 220 384 tool_use_id:string option -> 221 385 context:Context.t -> 222 386 result ··· 234 398 235 399 (** {1 Generic Result Builders} *) 236 400 237 237 - (** [continue ?system_message ?hook_specific_output ()] creates a continue result *) 238 238 - val continue : ?system_message:string -> ?hook_specific_output:Ezjsonm.value -> unit -> result 401 401 + (** [continue ?system_message ?hook_specific_output ?unknown ()] creates a continue result *) 402 402 + val continue : ?system_message:string -> ?hook_specific_output:Jsont.json -> ?unknown:Result_unknown.t -> unit -> result 239 403 240 240 - (** [block ?system_message ?hook_specific_output ()] creates a block result *) 241 241 - val block : ?system_message:string -> ?hook_specific_output:Ezjsonm.value -> unit -> result 404 404 + (** [block ?system_message ?hook_specific_output ?unknown ()] creates a block result *) 405 405 + val block : ?system_message:string -> ?hook_specific_output:Jsont.json -> ?unknown:Result_unknown.t -> unit -> result 242 406 243 407 (** {1 Configuration Builders} *) 244 408 ··· 253 417 254 418 (** {1 JSON Serialization} *) 255 419 256 256 - val result_to_json : result -> Ezjsonm.value 257 257 - val config_to_protocol_format : config -> Ezjsonm.value 420 420 + val result_to_json : result -> Jsont.json 421 421 + val config_to_protocol_format : config -> Jsont.json

+55

claudeio/lib/incoming.ml

reviewed

··· 1 1 + let src = Logs.Src.create "claude.incoming" ~doc:"Incoming messages from Claude CLI" 2 2 + module Log = (val Logs.src_log src : Logs.LOG) 3 3 + 4 4 + type t = 5 5 + | Message of Message.t 6 6 + | Control_response of Sdk_control.control_response 7 7 + 8 8 + let jsont : t Jsont.t = 9 9 + (* Custom decoder that checks the type field and dispatches to the appropriate codec. 10 10 + 11 11 + The challenge is that Message can have multiple type values ("user", "assistant", 12 12 + "system", "result"), while control_response has only one type value. Jsont's 13 13 + case_mem discriminator doesn't support multiple tags per case, so we implement 14 14 + a custom decoder/encoder. *) 15 15 + 16 16 + let dec json = 17 17 + (* First check if it has a type field *) 18 18 + match json with 19 19 + | Jsont.Object (members, _meta) -> 20 20 + let type_field = List.find_map (fun ((name, _), value) -> 21 21 + if name = "type" then 22 22 + match value with 23 23 + | Jsont.String (s, _) -> Some s 24 24 + | _ -> None 25 25 + else None 26 26 + ) members in 27 27 + (match type_field with 28 28 + | Some "control_response" -> 29 29 + (match Jsont.Json.decode Sdk_control.control_response_jsont json with 30 30 + | Ok resp -> Control_response resp 31 31 + | Error err -> failwith ("Failed to decode control_response: " ^ err)) 32 32 + | Some ("user" | "assistant" | "system" | "result") | Some _ | None -> 33 33 + (* Try to decode as message *) 34 34 + (match Jsont.Json.decode Message.jsont json with 35 35 + | Ok msg -> Message msg 36 36 + | Error err -> failwith ("Failed to decode message: " ^ err))) 37 37 + | _ -> failwith "Expected JSON object for incoming message" 38 38 + in 39 39 + 40 40 + let enc = function 41 41 + | Message msg -> 42 42 + (match Jsont.Json.encode Message.jsont msg with 43 43 + | Ok json -> json 44 44 + | Error err -> failwith ("Failed to encode message: " ^ err)) 45 45 + | Control_response resp -> 46 46 + (match Jsont.Json.encode Sdk_control.control_response_jsont resp with 47 47 + | Ok json -> json 48 48 + | Error err -> failwith ("Failed to encode control response: " ^ err)) 49 49 + in 50 50 + 51 51 + Jsont.map ~kind:"Incoming" ~dec ~enc Jsont.json 52 52 + 53 53 + let pp fmt = function 54 54 + | Message msg -> Format.fprintf fmt "@[<2>Message@ %a@]" Message.pp msg 55 55 + | Control_response resp -> Format.fprintf fmt "@[<2>ControlResponse@ %a@]" Sdk_control.pp (Sdk_control.Response resp)

+22

claudeio/lib/incoming.mli

reviewed

··· 1 1 + (** Incoming messages from the Claude CLI. 2 2 + 3 3 + This module defines a discriminated union of all possible message types 4 4 + that can be received from the Claude CLI, with a single jsont codec. 5 5 + 6 6 + The codec uses the "type" field to discriminate between message types: 7 7 + - "user", "assistant", "system", "result" -> Message variant 8 8 + - "control_response" -> Control_response variant 9 9 + - "control_request" is handled separately in the client (not incoming to SDK user) 10 10 + 11 11 + This provides a clean, type-safe way to decode incoming messages in a single 12 12 + operation, avoiding the parse-then-switch-then-parse pattern. *) 13 13 + 14 14 + type t = 15 15 + | Message of Message.t 16 16 + | Control_response of Sdk_control.control_response 17 17 + 18 18 + val jsont : t Jsont.t 19 19 + (** Codec for incoming messages. Uses the "type" field to discriminate. *) 20 20 + 21 21 + val pp : Format.formatter -> t -> unit 22 22 + (** [pp fmt t] pretty-prints the incoming message. *)

-85

claudeio/lib/json_utils.ml

reviewed

··· 1 1 - open Ezjsonm 2 2 - 3 3 - (* Combinations of find + get_* that are commonly used *) 4 4 - let find_string json path = 5 5 - find json path |> get_string 6 6 - 7 7 - let find_int json path = 8 8 - find json path |> get_int 9 9 - 10 10 - let find_bool json path = 11 11 - find json path |> get_bool 12 12 - 13 13 - let find_float json path = 14 14 - find json path |> get_float 15 15 - 16 16 - (* Optional versions using Ezjsonm's find_opt *) 17 17 - let find_string_opt json path = 18 18 - Option.map get_string (find_opt json path) 19 19 - 20 20 - let find_int_opt json path = 21 21 - Option.map get_int (find_opt json path) 22 22 - 23 23 - let find_bool_opt json path = 24 24 - Option.map get_bool (find_opt json path) 25 25 - 26 26 - let find_float_opt json path = 27 27 - Option.map get_float (find_opt json path) 28 28 - 29 29 - let assoc_string key fields = 30 30 - List.assoc key fields |> get_string 31 31 - 32 32 - let assoc_int key fields = 33 33 - List.assoc key fields |> get_int 34 34 - 35 35 - let assoc_bool key fields = 36 36 - List.assoc key fields |> get_bool 37 37 - 38 38 - let assoc_float key fields = 39 39 - List.assoc key fields |> get_float 40 40 - 41 41 - let assoc_string_opt key fields = 42 42 - Option.map get_string (List.assoc_opt key fields) 43 43 - 44 44 - let assoc_int_opt key fields = 45 45 - Option.map get_int (List.assoc_opt key fields) 46 46 - 47 47 - let assoc_bool_opt key fields = 48 48 - Option.map get_bool (List.assoc_opt key fields) 49 49 - 50 50 - let assoc_float_opt key fields = 51 51 - Option.map get_float (List.assoc_opt key fields) 52 52 - 53 53 - (* Ezjsonm.get_dict extracts fields, but we keep get_fields as an alias for clarity *) 54 54 - let get_fields = get_dict 55 55 - 56 56 - (* Single field access - simpler than using find with a single-element path *) 57 57 - let get_field json key = 58 58 - List.assoc key (get_dict json) 59 59 - 60 60 - let get_field_opt json key = 61 61 - List.assoc_opt key (try get_dict json with _ -> []) 62 62 - 63 63 - let get_field_string json key = 64 64 - get_field json key |> get_string 65 65 - 66 66 - let get_field_int json key = 67 67 - get_field json key |> get_int 68 68 - 69 69 - let get_field_bool json key = 70 70 - get_field json key |> get_bool 71 71 - 72 72 - let get_field_float json key = 73 73 - get_field json key |> get_float 74 74 - 75 75 - let get_field_string_opt json key = 76 76 - Option.map get_string (get_field_opt json key) 77 77 - 78 78 - let get_field_int_opt json key = 79 79 - Option.map get_int (get_field_opt json key) 80 80 - 81 81 - let get_field_bool_opt json key = 82 82 - Option.map get_bool (get_field_opt json key) 83 83 - 84 84 - let get_field_float_opt json key = 85 85 - Option.map get_float (get_field_opt json key)

-51

claudeio/lib/json_utils.mli

reviewed

··· 1 1 - (** JSON utility functions for working with Ezjsonm. 2 2 - 3 3 - This module provides convenience combinators that combine common 4 4 - Ezjsonm operations. Most functions are thin wrappers that combine 5 5 - find/get operations or provide Option-based error handling. *) 6 6 - 7 7 - (** {2 Finding values by path} 8 8 - 9 9 - These combine [Ezjsonm.find] with type extraction functions. *) 10 10 - 11 11 - val find_string : Ezjsonm.value -> string list -> string 12 12 - val find_int : Ezjsonm.value -> string list -> int 13 13 - val find_bool : Ezjsonm.value -> string list -> bool 14 14 - val find_float : Ezjsonm.value -> string list -> float 15 15 - 16 16 - val find_string_opt : Ezjsonm.value -> string list -> string option 17 17 - val find_int_opt : Ezjsonm.value -> string list -> int option 18 18 - val find_bool_opt : Ezjsonm.value -> string list -> bool option 19 19 - val find_float_opt : Ezjsonm.value -> string list -> float option 20 20 - 21 21 - (** {2 Association list operations} *) 22 22 - 23 23 - val assoc_string : string -> (string * Ezjsonm.value) list -> string 24 24 - val assoc_int : string -> (string * Ezjsonm.value) list -> int 25 25 - val assoc_bool : string -> (string * Ezjsonm.value) list -> bool 26 26 - val assoc_float : string -> (string * Ezjsonm.value) list -> float 27 27 - 28 28 - val assoc_string_opt : string -> (string * Ezjsonm.value) list -> string option 29 29 - val assoc_int_opt : string -> (string * Ezjsonm.value) list -> int option 30 30 - val assoc_bool_opt : string -> (string * Ezjsonm.value) list -> bool option 31 31 - val assoc_float_opt : string -> (string * Ezjsonm.value) list -> float option 32 32 - 33 33 - (** {2 Object field operations} 34 34 - 35 35 - Direct field access without needing to build paths. *) 36 36 - 37 37 - (** Alias for [Ezjsonm.get_dict] *) 38 38 - val get_fields : Ezjsonm.value -> (string * Ezjsonm.value) list 39 39 - 40 40 - val get_field : Ezjsonm.value -> string -> Ezjsonm.value 41 41 - val get_field_opt : Ezjsonm.value -> string -> Ezjsonm.value option 42 42 - 43 43 - val get_field_string : Ezjsonm.value -> string -> string 44 44 - val get_field_int : Ezjsonm.value -> string -> int 45 45 - val get_field_bool : Ezjsonm.value -> string -> bool 46 46 - val get_field_float : Ezjsonm.value -> string -> float 47 47 - 48 48 - val get_field_string_opt : Ezjsonm.value -> string -> string option 49 49 - val get_field_int_opt : Ezjsonm.value -> string -> int option 50 50 - val get_field_bool_opt : Ezjsonm.value -> string -> bool option 51 51 - val get_field_float_opt : Ezjsonm.value -> string -> float option

+396 -179

claudeio/lib/message.ml

reviewed

··· 1 1 - open Ezjsonm 2 2 - module JU = Json_utils 3 3 - 4 1 let src = Logs.Src.create "claude.message" ~doc:"Claude messages" 5 2 module Log = (val Logs.src_log src : Logs.LOG) 6 3 7 4 8 5 module User = struct 9 9 - type content = 6 6 + type content = 10 7 | String of string 11 8 | Blocks of Content_block.t list 12 12 - 13 13 - type t = { content : content } 14 14 - 15 15 - let create_string s = { content = String s } 16 16 - let create_blocks blocks = { content = Blocks blocks } 17 17 - 9 9 + 10 10 + module Unknown = struct 11 11 + type t = Jsont.json 12 12 + let empty = Jsont.Object ([], Jsont.Meta.none) 13 13 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 14 14 + let jsont = Jsont.json 15 15 + end 16 16 + 17 17 + type t = { 18 18 + content : content; 19 19 + unknown : Unknown.t; 20 20 + } 21 21 + 22 22 + let create_string s = { content = String s; unknown = Unknown.empty } 23 23 + let create_blocks blocks = { content = Blocks blocks; unknown = Unknown.empty } 24 24 + 18 25 let create_with_tool_result ~tool_use_id ~content ?is_error () = 19 26 let tool_result = Content_block.tool_result ~tool_use_id ~content ?is_error () in 20 20 - { content = Blocks [tool_result] } 21 21 - 27 27 + { content = Blocks [tool_result]; unknown = Unknown.empty } 28 28 + 22 29 let create_mixed ~text ~tool_results = 23 23 - let blocks = 30 30 + let blocks = 24 31 let text_blocks = match text with 25 32 | Some t -> [Content_block.text t] 26 33 | None -> [] ··· 30 37 ) tool_results in 31 38 text_blocks @ tool_blocks 32 39 in 33 33 - { content = Blocks blocks } 34 34 - 40 40 + { content = Blocks blocks; unknown = Unknown.empty } 41 41 + 42 42 + let make content unknown = { content; unknown } 35 43 let content t = t.content 36 36 - 44 44 + let unknown t = t.unknown 45 45 + 37 46 let as_text t = match t.content with 38 47 | String s -> Some s 39 48 | Blocks _ -> None 40 40 - 49 49 + 41 50 let get_blocks t = match t.content with 42 51 | String s -> [Content_block.text s] 43 52 | Blocks blocks -> blocks 44 44 - 53 53 + 54 54 + (* Decode content from json value *) 55 55 + let decode_content json = match json with 56 56 + | Jsont.String (s, _) -> String s 57 57 + | Jsont.Array (items, _) -> 58 58 + let blocks = List.map (fun j -> 59 59 + match Jsont.Json.decode Content_block.jsont j with 60 60 + | Ok b -> b 61 61 + | Error msg -> failwith ("Invalid content block: " ^ msg) 62 62 + ) items in 63 63 + Blocks blocks 64 64 + | _ -> failwith "Content must be string or array" 65 65 + 66 66 + (* Encode content to json value *) 67 67 + let encode_content = function 68 68 + | String s -> Jsont.String (s, Jsont.Meta.none) 69 69 + | Blocks blocks -> Jsont.Array (List.map Content_block.to_json blocks, Jsont.Meta.none) 70 70 + 71 71 + let jsont : t Jsont.t = 72 72 + Jsont.Object.map ~kind:"User" (fun json_content unknown -> 73 73 + let content = decode_content json_content in 74 74 + make content unknown 75 75 + ) 76 76 + |> Jsont.Object.mem "content" Jsont.json ~enc:(fun t -> encode_content (content t)) 77 77 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 78 78 + |> Jsont.Object.finish 79 79 + 45 80 let to_json t = 46 81 let content_json = match t.content with 47 47 - | String s -> `String s 48 48 - | Blocks blocks -> 49 49 - `A (List.map Content_block.to_json blocks) 82 82 + | String s -> Jsont.String (s, Jsont.Meta.none) 83 83 + | Blocks blocks -> 84 84 + Jsont.Array (List.map Content_block.to_json blocks, Jsont.Meta.none) 50 85 in 51 51 - `O [ 52 52 - ("type", `String "user"); 53 53 - ("message", `O [ 54 54 - ("role", `String "user"); 55 55 - ("content", content_json); 56 56 - ]); 57 57 - ] 58 58 - 59 59 - let of_json = function 60 60 - | `O fields -> 61 61 - let message = List.assoc "message" fields in 86 86 + Jsont.Object ([ 87 87 + (Jsont.Json.name "type", Jsont.String ("user", Jsont.Meta.none)); 88 88 + (Jsont.Json.name "message", Jsont.Object ([ 89 89 + (Jsont.Json.name "role", Jsont.String ("user", Jsont.Meta.none)); 90 90 + (Jsont.Json.name "content", content_json); 91 91 + ], Jsont.Meta.none)); 92 92 + ], Jsont.Meta.none) 93 93 + 94 94 + let of_json json = 95 95 + match json with 96 96 + | Jsont.Object (fields, _) -> 97 97 + let message = List.assoc (Jsont.Json.name "message") fields in 62 98 let content = match message with 63 63 - | `O msg_fields -> 64 64 - (match List.assoc "content" msg_fields with 65 65 - | `String s -> String s 66 66 - | `A blocks -> Blocks (List.map Content_block.of_json blocks) 99 99 + | Jsont.Object (msg_fields, _) -> 100 100 + (match List.assoc (Jsont.Json.name "content") msg_fields with 101 101 + | Jsont.String (s, _) -> String s 102 102 + | Jsont.Array (items, _) -> 103 103 + Blocks (List.map Content_block.of_json items) 67 104 | _ -> raise (Invalid_argument "User.of_json: invalid content")) 68 105 | _ -> raise (Invalid_argument "User.of_json: invalid message") 69 106 in 70 70 - { content } 107 107 + { content; unknown = Unknown.empty } 71 108 | _ -> raise (Invalid_argument "User.of_json: expected object") 72 72 - 109 109 + 73 110 let pp fmt t = 74 111 match t.content with 75 75 - | String s -> 112 112 + | String s -> 76 113 if String.length s > 60 then 77 114 let truncated = String.sub s 0 57 in 78 115 Fmt.pf fmt "@[<2>User:@ %s...@]" truncated 79 116 else 80 117 Fmt.pf fmt "@[<2>User:@ %S@]" s 81 118 | Blocks blocks -> 82 82 - let text_count = List.length (List.filter (function 119 119 + let text_count = List.length (List.filter (function 83 120 | Content_block.Text _ -> true | _ -> false) blocks) in 84 84 - let tool_result_count = List.length (List.filter (function 121 121 + let tool_result_count = List.length (List.filter (function 85 122 | Content_block.Tool_result _ -> true | _ -> false) blocks) in 86 123 match text_count, tool_result_count with 87 87 - | 1, 0 -> 124 124 + | 1, 0 -> 88 125 let text = List.find_map (function 89 126 | Content_block.Text t -> Some (Content_block.Text.text t) 90 127 | _ -> None) blocks in ··· 123 160 | "server_error" -> `Server_error 124 161 | "unknown" | _ -> `Unknown 125 162 163 163 + let error_jsont : error Jsont.t = 164 164 + Jsont.enum [ 165 165 + ("authentication_failed", `Authentication_failed); 166 166 + ("billing_error", `Billing_error); 167 167 + ("rate_limit", `Rate_limit); 168 168 + ("invalid_request", `Invalid_request); 169 169 + ("server_error", `Server_error); 170 170 + ("unknown", `Unknown); 171 171 + ] 172 172 + 173 173 + module Unknown = struct 174 174 + type t = Jsont.json 175 175 + let empty = Jsont.Object ([], Jsont.Meta.none) 176 176 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 177 177 + let jsont = Jsont.json 178 178 + end 179 179 + 126 180 type t = { 127 181 content : Content_block.t list; 128 182 model : string; 129 183 error : error option; 184 184 + unknown : Unknown.t; 130 185 } 131 186 132 132 - let create ~content ~model ?error () = { content; model; error } 187 187 + let create ~content ~model ?error () = { content; model; error; unknown = Unknown.empty } 188 188 + let make content model error unknown = { content; model; error; unknown } 133 189 let content t = t.content 134 190 let model t = t.model 135 191 let error t = t.error 136 136 - 192 192 + let unknown t = t.unknown 193 193 + 137 194 let get_text_blocks t = 138 195 List.filter_map (function 139 196 | Content_block.Text text -> Some (Content_block.Text.text text) 140 197 | _ -> None 141 198 ) t.content 142 142 - 199 199 + 143 200 let get_tool_uses t = 144 201 List.filter_map (function 145 202 | Content_block.Tool_use tool -> Some tool 146 203 | _ -> None 147 204 ) t.content 148 148 - 205 205 + 149 206 let get_thinking t = 150 207 List.filter_map (function 151 208 | Content_block.Thinking thinking -> Some thinking 152 209 | _ -> None 153 210 ) t.content 154 154 - 211 211 + 155 212 let has_tool_use t = 156 213 List.exists (function 157 214 | Content_block.Tool_use _ -> true 158 215 | _ -> false 159 216 ) t.content 160 160 - 217 217 + 161 218 let combined_text t = 162 219 String.concat "\n" (get_text_blocks t) 163 163 - 220 220 + 221 221 + let jsont : t Jsont.t = 222 222 + Jsont.Object.map ~kind:"Assistant" make 223 223 + |> Jsont.Object.mem "content" (Jsont.list Content_block.jsont) ~enc:content 224 224 + |> Jsont.Object.mem "model" Jsont.string ~enc:model 225 225 + |> Jsont.Object.opt_mem "error" error_jsont ~enc:error 226 226 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 227 227 + |> Jsont.Object.finish 228 228 + 164 229 let to_json t = 165 230 let msg_fields = [ 166 166 - ("content", `A (List.map Content_block.to_json t.content)); 167 167 - ("model", `String t.model); 231 231 + (Jsont.Json.name "content", Jsont.Array (List.map Content_block.to_json t.content, Jsont.Meta.none)); 232 232 + (Jsont.Json.name "model", Jsont.String (t.model, Jsont.Meta.none)); 168 233 ] in 169 234 let msg_fields = match t.error with 170 170 - | Some err -> ("error", `String (error_to_string err)) :: msg_fields 235 235 + | Some err -> (Jsont.Json.name "error", Jsont.String (error_to_string err, Jsont.Meta.none)) :: msg_fields 171 236 | None -> msg_fields 172 237 in 173 173 - `O [ 174 174 - ("type", `String "assistant"); 175 175 - ("message", `O msg_fields); 176 176 - ] 177 177 - 178 178 - let of_json = function 179 179 - | `O fields -> 180 180 - let message = List.assoc "message" fields in 238 238 + Jsont.Object ([ 239 239 + (Jsont.Json.name "type", Jsont.String ("assistant", Jsont.Meta.none)); 240 240 + (Jsont.Json.name "message", Jsont.Object (msg_fields, Jsont.Meta.none)); 241 241 + ], Jsont.Meta.none) 242 242 + 243 243 + let of_json json = 244 244 + match json with 245 245 + | Jsont.Object (fields, _) -> 246 246 + let message = List.assoc (Jsont.Json.name "message") fields in 181 247 let content, model, error = match message with 182 182 - | `O msg_fields -> 248 248 + | Jsont.Object (msg_fields, _) -> 183 249 let content = 184 184 - match List.assoc "content" msg_fields with 185 185 - | `A blocks -> List.map Content_block.of_json blocks 250 250 + match List.assoc (Jsont.Json.name "content") msg_fields with 251 251 + | Jsont.Array (items, _) -> List.map Content_block.of_json items 186 252 | _ -> raise (Invalid_argument "Assistant.of_json: invalid content") 187 253 in 188 188 - let model = JU.assoc_string "model" msg_fields in 254 254 + let model = match List.assoc (Jsont.Json.name "model") msg_fields with 255 255 + | Jsont.String (s, _) -> s 256 256 + | _ -> raise (Invalid_argument "Assistant.of_json: invalid model") 257 257 + in 189 258 let error = 190 190 - match JU.assoc_string_opt "error" msg_fields with 191 191 - | Some err_str -> Some (error_of_string err_str) 259 259 + match List.assoc_opt (Jsont.Json.name "error") msg_fields with 260 260 + | Some (Jsont.String (err_str, _)) -> Some (error_of_string err_str) 261 261 + | Some _ -> raise (Invalid_argument "Assistant.of_json: invalid error") 192 262 | None -> None 193 263 in 194 264 content, model, error 195 265 | _ -> raise (Invalid_argument "Assistant.of_json: invalid message") 196 266 in 197 197 - { content; model; error } 267 267 + { content; model; error; unknown = Unknown.empty } 198 268 | _ -> raise (Invalid_argument "Assistant.of_json: expected object") 199 199 - 269 269 + 200 270 let pp fmt t = 201 271 let text_count = List.length (get_text_blocks t) in 202 272 let tool_count = List.length (get_tool_uses t) in ··· 219 289 | _ -> 220 290 (* Mixed content *) 221 291 let parts = [] in 222 222 - let parts = if text_count > 0 then 292 292 + let parts = if text_count > 0 then 223 293 Printf.sprintf "%d text" text_count :: parts else parts in 224 224 - let parts = if tool_count > 0 then 294 294 + let parts = if tool_count > 0 then 225 295 Printf.sprintf "%d tools" tool_count :: parts else parts in 226 226 - let parts = if thinking_count > 0 then 296 296 + let parts = if thinking_count > 0 then 227 297 Printf.sprintf "%d thinking" thinking_count :: parts else parts in 228 298 Fmt.pf fmt "@[<2>Assistant@ [%s]:@ %s@]" 229 299 t.model (String.concat ", " (List.rev parts)) ··· 231 301 232 302 module System = struct 233 303 module Data = struct 234 234 - (* Store both the raw JSON and provide typed accessors *) 235 235 - type t = value (* The full JSON data *) 236 236 - 237 237 - let empty = `O [] 238 238 - 239 239 - let of_assoc assoc = `O assoc 240 240 - 241 241 - let get_string t key = JU.get_field_string_opt t key 242 242 - 243 243 - let get_int t key = JU.get_field_int_opt t key 244 244 - 245 245 - let get_bool t key = JU.get_field_bool_opt t key 246 246 - 247 247 - let get_float t key = JU.get_field_float_opt t key 248 248 - 249 249 - let get_list t key = 250 250 - match t with 251 251 - | `O fields -> 252 252 - (match List.assoc_opt key fields with 253 253 - | Some (`A lst) -> Some lst 254 254 - | _ -> None) 255 255 - | _ -> None 256 256 - 304 304 + (* Opaque JSON type with typed accessors *) 305 305 + type t = Jsont.json 306 306 + 307 307 + let jsont = Jsont.json 308 308 + 309 309 + let empty = Jsont.Object ([], Jsont.Meta.none) 310 310 + 311 311 + let of_assoc (assoc : (string * Jsont.json) list) : t = 312 312 + Jsont.Object ( 313 313 + List.map (fun (k, v) -> (Jsont.Json.name k, v)) assoc, 314 314 + Jsont.Meta.none 315 315 + ) 316 316 + 257 317 let get_field t key = 258 318 match t with 259 259 - | `O fields -> List.assoc_opt key fields 319 319 + | Jsont.Object (members, _) -> 320 320 + List.find_map (fun ((name, _), value) -> 321 321 + if name = key then Some value else None 322 322 + ) members 260 323 | _ -> None 261 261 - 324 324 + 325 325 + let get_string t key = 326 326 + match get_field t key with 327 327 + | Some (Jsont.String (s, _)) -> Some s 328 328 + | _ -> None 329 329 + 330 330 + let get_int t key = 331 331 + match get_field t key with 332 332 + | Some (Jsont.Number (f, _)) -> 333 333 + let i = int_of_float f in 334 334 + if float_of_int i = f then Some i else None 335 335 + | _ -> None 336 336 + 337 337 + let get_bool t key = 338 338 + match get_field t key with 339 339 + | Some (Jsont.Bool (b, _)) -> Some b 340 340 + | _ -> None 341 341 + 342 342 + let get_float t key = 343 343 + match get_field t key with 344 344 + | Some (Jsont.Number (f, _)) -> Some f 345 345 + | _ -> None 346 346 + 347 347 + let get_list t key = 348 348 + match get_field t key with 349 349 + | Some (Jsont.Array (items, _)) -> Some items 350 350 + | _ -> None 351 351 + 262 352 let raw_json t = t 263 263 - 353 353 + 264 354 let to_json t = t 265 355 let of_json json = json 266 356 end 267 267 - 357 357 + 358 358 + module Unknown = struct 359 359 + type t = Jsont.json 360 360 + let empty = Jsont.Object ([], Jsont.Meta.none) 361 361 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 362 362 + let jsont = Jsont.json 363 363 + end 364 364 + 268 365 type t = { 269 366 subtype : string; 270 367 data : Data.t; 368 368 + unknown : Unknown.t; 271 369 } 272 272 - 273 273 - let create ~subtype ~data = { subtype; data } 370 370 + 371 371 + let create ~subtype ~data = { subtype; data; unknown = Unknown.empty } 372 372 + let make subtype data unknown = { subtype; data; unknown } 274 373 let subtype t = t.subtype 275 374 let data t = t.data 276 276 - 375 375 + let unknown t = t.unknown 376 376 + 377 377 + let jsont : t Jsont.t = 378 378 + Jsont.Object.map ~kind:"System" make 379 379 + |> Jsont.Object.mem "subtype" Jsont.string ~enc:subtype 380 380 + |> Jsont.Object.mem "data" Data.jsont ~enc:data 381 381 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 382 382 + |> Jsont.Object.finish 383 383 + 277 384 let to_json t = 278 278 - `O [ 279 279 - ("type", `String "system"); 280 280 - ("subtype", `String t.subtype); 281 281 - ("data", Data.to_json t.data); 282 282 - ] 283 283 - 284 284 - let of_json = function 285 285 - | `O fields -> 286 286 - let subtype = JU.assoc_string "subtype" fields in 287 287 - let data = Data.of_json (try List.assoc "data" fields with Not_found -> `O fields) in 288 288 - { subtype; data } 385 385 + Jsont.Object ([ 386 386 + (Jsont.Json.name "type", Jsont.String ("system", Jsont.Meta.none)); 387 387 + (Jsont.Json.name "subtype", Jsont.String (t.subtype, Jsont.Meta.none)); 388 388 + (Jsont.Json.name "data", Data.to_json t.data); 389 389 + ], Jsont.Meta.none) 390 390 + 391 391 + let of_json json = 392 392 + match json with 393 393 + | Jsont.Object (fields, _) -> 394 394 + let subtype = match List.assoc (Jsont.Json.name "subtype") fields with 395 395 + | Jsont.String (s, _) -> s 396 396 + | _ -> raise (Invalid_argument "System.of_json: invalid subtype") 397 397 + in 398 398 + let data = Data.of_json ( 399 399 + try List.assoc (Jsont.Json.name "data") fields 400 400 + with Not_found -> Jsont.Object (fields, Jsont.Meta.none) 401 401 + ) in 402 402 + { subtype; data; unknown = Unknown.empty } 289 403 | _ -> raise (Invalid_argument "System.of_json: expected object") 290 290 - 404 404 + 291 405 let pp fmt t = 292 406 match t.subtype with 293 407 | "init" -> ··· 308 422 309 423 module Result = struct 310 424 module Usage = struct 311 311 - type t = value 312 312 - 313 313 - let create ?input_tokens ?output_tokens ?total_tokens 425 425 + (* Opaque JSON type with typed accessors *) 426 426 + type t = Jsont.json 427 427 + 428 428 + let jsont = Jsont.json 429 429 + 430 430 + let create ?input_tokens ?output_tokens ?total_tokens 314 431 ?cache_creation_input_tokens ?cache_read_input_tokens () = 315 432 let fields = [] in 316 433 let fields = match input_tokens with 317 317 - | Some n -> ("input_tokens", `Float (float_of_int n)) :: fields 434 434 + | Some n -> (Jsont.Json.name "input_tokens", Jsont.Number (float_of_int n, Jsont.Meta.none)) :: fields 318 435 | None -> fields in 319 436 let fields = match output_tokens with 320 320 - | Some n -> ("output_tokens", `Float (float_of_int n)) :: fields 437 437 + | Some n -> (Jsont.Json.name "output_tokens", Jsont.Number (float_of_int n, Jsont.Meta.none)) :: fields 321 438 | None -> fields in 322 439 let fields = match total_tokens with 323 323 - | Some n -> ("total_tokens", `Float (float_of_int n)) :: fields 440 440 + | Some n -> (Jsont.Json.name "total_tokens", Jsont.Number (float_of_int n, Jsont.Meta.none)) :: fields 324 441 | None -> fields in 325 442 let fields = match cache_creation_input_tokens with 326 326 - | Some n -> ("cache_creation_input_tokens", `Float (float_of_int n)) :: fields 443 443 + | Some n -> (Jsont.Json.name "cache_creation_input_tokens", Jsont.Number (float_of_int n, Jsont.Meta.none)) :: fields 327 444 | None -> fields in 328 445 let fields = match cache_read_input_tokens with 329 329 - | Some n -> ("cache_read_input_tokens", `Float (float_of_int n)) :: fields 446 446 + | Some n -> (Jsont.Json.name "cache_read_input_tokens", Jsont.Number (float_of_int n, Jsont.Meta.none)) :: fields 330 447 | None -> fields in 331 331 - `O fields 332 332 - 333 333 - let input_tokens t = JU.get_field_int_opt t "input_tokens" 334 334 - 335 335 - let output_tokens t = JU.get_field_int_opt t "output_tokens" 336 336 - 337 337 - let total_tokens t = JU.get_field_int_opt t "total_tokens" 338 338 - 339 339 - let cache_creation_input_tokens t = JU.get_field_int_opt t "cache_creation_input_tokens" 340 340 - 341 341 - let cache_read_input_tokens t = JU.get_field_int_opt t "cache_read_input_tokens" 342 342 - 448 448 + Jsont.Object (fields, Jsont.Meta.none) 449 449 + 450 450 + let get_field t key = 451 451 + match t with 452 452 + | Jsont.Object (members, _) -> 453 453 + List.find_map (fun ((name, _), value) -> 454 454 + if name = key then Some value else None 455 455 + ) members 456 456 + | _ -> None 457 457 + 458 458 + let get_int t key = 459 459 + match get_field t key with 460 460 + | Some (Jsont.Number (f, _)) -> 461 461 + let i = int_of_float f in 462 462 + if float_of_int i = f then Some i else None 463 463 + | _ -> None 464 464 + 465 465 + let input_tokens t = get_int t "input_tokens" 466 466 + 467 467 + let output_tokens t = get_int t "output_tokens" 468 468 + 469 469 + let total_tokens t = get_int t "total_tokens" 470 470 + 471 471 + let cache_creation_input_tokens t = get_int t "cache_creation_input_tokens" 472 472 + 473 473 + let cache_read_input_tokens t = get_int t "cache_read_input_tokens" 474 474 + 343 475 let effective_input_tokens t = 344 476 match input_tokens t with 345 477 | None -> 0 346 478 | Some input -> 347 479 let cached = Option.value (cache_read_input_tokens t) ~default:0 in 348 480 max 0 (input - cached) 349 349 - 481 481 + 350 482 let total_cost_estimate t ~input_price ~output_price = 351 483 match input_tokens t, output_tokens t with 352 484 | Some input, Some output -> ··· 354 486 let output_cost = float_of_int output *. output_price /. 1_000_000. in 355 487 Some (input_cost +. output_cost) 356 488 | _ -> None 357 357 - 489 489 + 358 490 let pp fmt t = 359 491 Fmt.pf fmt "@[<2>Usage@ { input = %a;@ output = %a;@ total = %a;@ \ 360 492 cache_creation = %a;@ cache_read = %a }@]" ··· 363 495 Fmt.(option int) (total_tokens t) 364 496 Fmt.(option int) (cache_creation_input_tokens t) 365 497 Fmt.(option int) (cache_read_input_tokens t) 366 366 - 498 498 + 367 499 let to_json t = t 368 500 let of_json json = json 369 501 end 370 370 - 502 502 + 503 503 + module Unknown = struct 504 504 + type t = Jsont.json 505 505 + let empty = Jsont.Object ([], Jsont.Meta.none) 506 506 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 507 507 + let jsont = Jsont.json 508 508 + end 509 509 + 371 510 type t = { 372 511 subtype : string; 373 512 duration_ms : int; ··· 378 517 total_cost_usd : float option; 379 518 usage : Usage.t option; 380 519 result : string option; 381 381 - structured_output : value option; 520 520 + structured_output : Jsont.json option; 521 521 + unknown : Unknown.t; 382 522 } 383 383 - 523 523 + 384 524 let create ~subtype ~duration_ms ~duration_api_ms ~is_error ~num_turns 385 525 ~session_id ?total_cost_usd ?usage ?result ?structured_output () = 386 526 { subtype; duration_ms; duration_api_ms; is_error; num_turns; 387 387 - session_id; total_cost_usd; usage; result; structured_output } 388 388 - 527 527 + session_id; total_cost_usd; usage; result; structured_output; unknown = Unknown.empty } 528 528 + 529 529 + let make subtype duration_ms duration_api_ms is_error num_turns 530 530 + session_id total_cost_usd usage result structured_output unknown = 531 531 + { subtype; duration_ms; duration_api_ms; is_error; num_turns; 532 532 + session_id; total_cost_usd; usage; result; structured_output; unknown } 533 533 + 389 534 let subtype t = t.subtype 390 535 let duration_ms t = t.duration_ms 391 536 let duration_api_ms t = t.duration_api_ms ··· 396 541 let usage t = t.usage 397 542 let result t = t.result 398 543 let structured_output t = t.structured_output 399 399 - 544 544 + let unknown t = t.unknown 545 545 + 546 546 + let jsont : t Jsont.t = 547 547 + Jsont.Object.map ~kind:"Result" make 548 548 + |> Jsont.Object.mem "subtype" Jsont.string ~enc:subtype 549 549 + |> Jsont.Object.mem "duration_ms" Jsont.int ~enc:duration_ms 550 550 + |> Jsont.Object.mem "duration_api_ms" Jsont.int ~enc:duration_api_ms 551 551 + |> Jsont.Object.mem "is_error" Jsont.bool ~enc:is_error 552 552 + |> Jsont.Object.mem "num_turns" Jsont.int ~enc:num_turns 553 553 + |> Jsont.Object.mem "session_id" Jsont.string ~enc:session_id 554 554 + |> Jsont.Object.opt_mem "total_cost_usd" Jsont.number ~enc:total_cost_usd 555 555 + |> Jsont.Object.opt_mem "usage" Usage.jsont ~enc:usage 556 556 + |> Jsont.Object.opt_mem "result" Jsont.string ~enc:result 557 557 + |> Jsont.Object.opt_mem "structured_output" Jsont.json ~enc:structured_output 558 558 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 559 559 + |> Jsont.Object.finish 560 560 + 400 561 let to_json t = 401 562 let fields = [ 402 402 - ("type", `String "result"); 403 403 - ("subtype", `String t.subtype); 404 404 - ("duration_ms", `Float (float_of_int t.duration_ms)); 405 405 - ("duration_api_ms", `Float (float_of_int t.duration_api_ms)); 406 406 - ("is_error", `Bool t.is_error); 407 407 - ("num_turns", `Float (float_of_int t.num_turns)); 408 408 - ("session_id", `String t.session_id); 563 563 + (Jsont.Json.name "type", Jsont.String ("result", Jsont.Meta.none)); 564 564 + (Jsont.Json.name "subtype", Jsont.String (t.subtype, Jsont.Meta.none)); 565 565 + (Jsont.Json.name "duration_ms", Jsont.Number (float_of_int t.duration_ms, Jsont.Meta.none)); 566 566 + (Jsont.Json.name "duration_api_ms", Jsont.Number (float_of_int t.duration_api_ms, Jsont.Meta.none)); 567 567 + (Jsont.Json.name "is_error", Jsont.Bool (t.is_error, Jsont.Meta.none)); 568 568 + (Jsont.Json.name "num_turns", Jsont.Number (float_of_int t.num_turns, Jsont.Meta.none)); 569 569 + (Jsont.Json.name "session_id", Jsont.String (t.session_id, Jsont.Meta.none)); 409 570 ] in 410 571 let fields = match t.total_cost_usd with 411 411 - | Some cost -> ("total_cost_usd", `Float cost) :: fields 572 572 + | Some cost -> (Jsont.Json.name "total_cost_usd", Jsont.Number (cost, Jsont.Meta.none)) :: fields 412 573 | None -> fields 413 574 in 414 575 let fields = match t.usage with 415 415 - | Some usage -> ("usage", Usage.to_json usage) :: fields 576 576 + | Some usage -> (Jsont.Json.name "usage", Usage.to_json usage) :: fields 416 577 | None -> fields 417 578 in 418 579 let fields = match t.result with 419 419 - | Some result -> ("result", `String result) :: fields 580 580 + | Some result -> (Jsont.Json.name "result", Jsont.String (result, Jsont.Meta.none)) :: fields 420 581 | None -> fields 421 582 in 422 583 let fields = match t.structured_output with 423 423 - | Some output -> ("structured_output", output) :: fields 584 584 + | Some output -> (Jsont.Json.name "structured_output", output) :: fields 424 585 | None -> fields 425 586 in 426 426 - `O fields 427 427 - 428 428 - let of_json = function 429 429 - | `O fields -> 430 430 - let subtype = JU.assoc_string "subtype" fields in 431 431 - let duration_ms = int_of_float (JU.assoc_float "duration_ms" fields) in 432 432 - let duration_api_ms = int_of_float (JU.assoc_float "duration_api_ms" fields) in 433 433 - let is_error = JU.assoc_bool "is_error" fields in 434 434 - let num_turns = int_of_float (JU.assoc_float "num_turns" fields) in 435 435 - let session_id = JU.assoc_string "session_id" fields in 436 436 - let total_cost_usd = JU.assoc_float_opt "total_cost_usd" fields in 437 437 - let usage = Option.map Usage.of_json (List.assoc_opt "usage" fields) in 438 438 - let result = JU.assoc_string_opt "result" fields in 439 439 - let structured_output = List.assoc_opt "structured_output" fields in 587 587 + Jsont.Object (fields, Jsont.Meta.none) 588 588 + 589 589 + let of_json json = 590 590 + match json with 591 591 + | Jsont.Object (fields, _) -> 592 592 + let subtype = match List.assoc (Jsont.Json.name "subtype") fields with 593 593 + | Jsont.String (s, _) -> s 594 594 + | _ -> raise (Invalid_argument "Result.of_json: invalid subtype") 595 595 + in 596 596 + let duration_ms = match List.assoc (Jsont.Json.name "duration_ms") fields with 597 597 + | Jsont.Number (f, _) -> int_of_float f 598 598 + | _ -> raise (Invalid_argument "Result.of_json: invalid duration_ms") 599 599 + in 600 600 + let duration_api_ms = match List.assoc (Jsont.Json.name "duration_api_ms") fields with 601 601 + | Jsont.Number (f, _) -> int_of_float f 602 602 + | _ -> raise (Invalid_argument "Result.of_json: invalid duration_api_ms") 603 603 + in 604 604 + let is_error = match List.assoc (Jsont.Json.name "is_error") fields with 605 605 + | Jsont.Bool (b, _) -> b 606 606 + | _ -> raise (Invalid_argument "Result.of_json: invalid is_error") 607 607 + in 608 608 + let num_turns = match List.assoc (Jsont.Json.name "num_turns") fields with 609 609 + | Jsont.Number (f, _) -> int_of_float f 610 610 + | _ -> raise (Invalid_argument "Result.of_json: invalid num_turns") 611 611 + in 612 612 + let session_id = match List.assoc (Jsont.Json.name "session_id") fields with 613 613 + | Jsont.String (s, _) -> s 614 614 + | _ -> raise (Invalid_argument "Result.of_json: invalid session_id") 615 615 + in 616 616 + let total_cost_usd = match List.assoc_opt (Jsont.Json.name "total_cost_usd") fields with 617 617 + | Some (Jsont.Number (f, _)) -> Some f 618 618 + | Some _ -> raise (Invalid_argument "Result.of_json: invalid total_cost_usd") 619 619 + | None -> None 620 620 + in 621 621 + let usage = Option.map Usage.of_json (List.assoc_opt (Jsont.Json.name "usage") fields) in 622 622 + let result = match List.assoc_opt (Jsont.Json.name "result") fields with 623 623 + | Some (Jsont.String (s, _)) -> Some s 624 624 + | Some _ -> raise (Invalid_argument "Result.of_json: invalid result") 625 625 + | None -> None 626 626 + in 627 627 + let structured_output = List.assoc_opt (Jsont.Json.name "structured_output") fields in 440 628 { subtype; duration_ms; duration_api_ms; is_error; num_turns; 441 441 - session_id; total_cost_usd; usage; result; structured_output } 629 629 + session_id; total_cost_usd; usage; result; structured_output; unknown = Unknown.empty } 442 630 | _ -> raise (Invalid_argument "Result.of_json: expected object") 443 443 - 631 631 + 444 632 let pp fmt t = 445 633 if t.is_error then 446 634 Fmt.pf fmt "@[<2>Result.error@ { session = %S;@ result = %a }@]" ··· 461 649 | None -> "" 462 650 in 463 651 Fmt.pf fmt "@[<2>Result.%s@ { duration = %dms;@ cost = $%.4f%s }@]" 464 464 - t.subtype 652 652 + t.subtype 465 653 t.duration_ms 466 654 (Option.value t.total_cost_usd ~default:0.0) 467 655 tokens_info ··· 484 672 485 673 let system ~subtype ~data = System (System.create ~subtype ~data) 486 674 let system_init ~session_id = 487 487 - let data = System.Data.of_assoc [("session_id", `String session_id)] in 675 675 + let data = System.Data.of_assoc [(("session_id", Jsont.String (session_id, Jsont.Meta.none)))] in 488 676 System (System.create ~subtype:"init" ~data) 489 677 let system_error ~error = 490 490 - let data = System.Data.of_assoc [("error", `String error)] in 678 678 + let data = System.Data.of_assoc [(("error", Jsont.String (error, Jsont.Meta.none)))] in 491 679 System (System.create ~subtype:"error" ~data) 492 680 493 681 let result ~subtype ~duration_ms ~duration_api_ms ~is_error ~num_turns ··· 495 683 Result (Result.create ~subtype ~duration_ms ~duration_api_ms ~is_error 496 684 ~num_turns ~session_id ?total_cost_usd ?usage ?result ?structured_output ()) 497 685 686 686 + (* Jsont codec for the main Message variant type *) 687 687 + let jsont : t Jsont.t = 688 688 + let case_map kind obj dec = Jsont.Object.Case.map kind obj ~dec in 689 689 + 690 690 + let case_user = case_map "user" User.jsont (fun v -> User v) in 691 691 + let case_assistant = case_map "assistant" Assistant.jsont (fun v -> Assistant v) in 692 692 + let case_system = case_map "system" System.jsont (fun v -> System v) in 693 693 + let case_result = case_map "result" Result.jsont (fun v -> Result v) in 694 694 + 695 695 + let enc_case = function 696 696 + | User v -> Jsont.Object.Case.value case_user v 697 697 + | Assistant v -> Jsont.Object.Case.value case_assistant v 698 698 + | System v -> Jsont.Object.Case.value case_system v 699 699 + | Result v -> Jsont.Object.Case.value case_result v 700 700 + in 701 701 + 702 702 + let cases = Jsont.Object.Case.[ 703 703 + make case_user; 704 704 + make case_assistant; 705 705 + make case_system; 706 706 + make case_result 707 707 + ] in 708 708 + 709 709 + Jsont.Object.map ~kind:"Message" Fun.id 710 710 + |> Jsont.Object.case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases 711 711 + ~tag_to_string:Fun.id ~tag_compare:String.compare 712 712 + |> Jsont.Object.finish 713 713 + 498 714 let to_json = function 499 715 | User t -> User.to_json t 500 716 | Assistant t -> Assistant.to_json t ··· 503 719 504 720 let of_json json = 505 721 match json with 506 506 - | `O fields -> ( 507 507 - match List.assoc_opt "type" fields with 508 508 - | Some (`String "user") -> User (User.of_json json) 509 509 - | Some (`String "assistant") -> Assistant (Assistant.of_json json) 510 510 - | Some (`String "system") -> System (System.of_json json) 511 511 - | Some (`String "result") -> Result (Result.of_json json) 512 512 - | _ -> raise (Invalid_argument "Message.of_json: unknown type") 722 722 + | Jsont.Object (fields, _) -> ( 723 723 + match List.assoc_opt (Jsont.Json.name "type") fields with 724 724 + | Some (Jsont.String ("user", _)) -> User (User.of_json json) 725 725 + | Some (Jsont.String ("assistant", _)) -> Assistant (Assistant.of_json json) 726 726 + | Some (Jsont.String ("system", _)) -> System (System.of_json json) 727 727 + | Some (Jsont.String ("result", _)) -> Result (Result.of_json json) 728 728 + | Some _ -> raise (Invalid_argument "Message.of_json: invalid type") 729 729 + | None -> raise (Invalid_argument "Message.of_json: missing type field") 513 730 ) 514 731 | _ -> raise (Invalid_argument "Message.of_json: expected object") 515 732

+171 -110

claudeio/lib/message.mli

reviewed

··· 1 1 (** Messages exchanged with Claude. 2 2 - 3 3 - This module defines the various types of messages that can be sent to and 4 4 - received from Claude, including user input, assistant responses, system 2 2 + 3 3 + This module defines the various types of messages that can be sent to and 4 4 + received from Claude, including user input, assistant responses, system 5 5 messages, and result metadata. *) 6 6 7 7 (** The log source for message operations *) ··· 11 11 12 12 module User : sig 13 13 (** Messages sent by the user. *) 14 14 - 15 15 - type content = 14 14 + 15 15 + type content = 16 16 | String of string (** Simple text message *) 17 17 | Blocks of Content_block.t list (** Complex message with multiple content blocks *) 18 18 (** The content of a user message. *) 19 19 - 19 19 + 20 20 + module Unknown : sig 21 21 + type t = Jsont.json 22 22 + val empty : t 23 23 + val is_empty : t -> bool 24 24 + val jsont : t Jsont.t 25 25 + end 26 26 + 20 27 type t 21 28 (** The type of user messages. *) 22 22 - 29 29 + 30 30 + val jsont : t Jsont.t 31 31 + (** [jsont] is the Jsont codec for user messages. *) 32 32 + 23 33 val create_string : string -> t 24 34 (** [create_string s] creates a user message with simple text content. *) 25 25 - 35 35 + 26 36 val create_blocks : Content_block.t list -> t 27 37 (** [create_blocks blocks] creates a user message with content blocks. *) 28 28 - 29 29 - val create_with_tool_result : 30 30 - tool_use_id:string -> 31 31 - content:string -> 32 32 - ?is_error:bool -> 38 38 + 39 39 + val create_with_tool_result : 40 40 + tool_use_id:string -> 41 41 + content:string -> 42 42 + ?is_error:bool -> 33 43 unit -> t 34 34 - (** [create_with_tool_result ~tool_use_id ~content ?is_error ()] creates a user 44 44 + (** [create_with_tool_result ~tool_use_id ~content ?is_error ()] creates a user 35 45 message containing a tool result. *) 36 36 - 46 46 + 37 47 val create_mixed : text:string option -> tool_results:(string * string * bool option) list -> t 38 38 - (** [create_mixed ?text ~tool_results] creates a user message with optional text 48 48 + (** [create_mixed ?text ~tool_results] creates a user message with optional text 39 49 and tool results. Each tool result is (tool_use_id, content, is_error). *) 40 40 - 50 50 + 41 51 val content : t -> content 42 52 (** [content t] returns the content of the user message. *) 43 43 - 53 53 + 54 54 + val unknown : t -> Unknown.t 55 55 + (** [unknown t] returns the unknown fields preserved from JSON. *) 56 56 + 44 57 val as_text : t -> string option 45 58 (** [as_text t] returns the text content if the message is a simple string, None otherwise. *) 46 46 - 59 59 + 47 60 val get_blocks : t -> Content_block.t list 48 61 (** [get_blocks t] returns the content blocks, or a single text block if it's a string message. *) 49 49 - 50 50 - val to_json : t -> Ezjsonm.value 62 62 + 63 63 + val to_json : t -> Jsont.json 51 64 (** [to_json t] converts the user message to its JSON representation. *) 52 52 - 53 53 - val of_json : Ezjsonm.value -> t 65 65 + 66 66 + val of_json : Jsont.json -> t 54 67 (** [of_json json] parses a user message from JSON. 55 68 @raise Invalid_argument if the JSON is not a valid user message. *) 56 56 - 69 69 + 57 70 val pp : Format.formatter -> t -> unit 58 71 (** [pp fmt t] pretty-prints the user message. *) 59 72 end ··· 79 92 val error_of_string : string -> error 80 93 (** [error_of_string s] parses an error string. Unknown strings become [`Unknown]. *) 81 94 95 95 + module Unknown : sig 96 96 + type t = Jsont.json 97 97 + val empty : t 98 98 + val is_empty : t -> bool 99 99 + val jsont : t Jsont.t 100 100 + end 101 101 + 82 102 type t 83 103 (** The type of assistant messages. *) 104 104 + 105 105 + val jsont : t Jsont.t 106 106 + (** [jsont] is the Jsont codec for assistant messages. *) 84 107 85 108 val create : content:Content_block.t list -> model:string -> ?error:error -> unit -> t 86 109 (** [create ~content ~model ?error ()] creates an assistant message. ··· 96 119 97 120 val error : t -> error option 98 121 (** [error t] returns the optional error that occurred during message generation. *) 99 99 - 122 122 + 123 123 + val unknown : t -> Unknown.t 124 124 + (** [unknown t] returns the unknown fields preserved from JSON. *) 125 125 + 100 126 val get_text_blocks : t -> string list 101 127 (** [get_text_blocks t] extracts all text content from the message. *) 102 102 - 128 128 + 103 129 val get_tool_uses : t -> Content_block.Tool_use.t list 104 130 (** [get_tool_uses t] extracts all tool use blocks from the message. *) 105 105 - 131 131 + 106 132 val get_thinking : t -> Content_block.Thinking.t list 107 133 (** [get_thinking t] extracts all thinking blocks from the message. *) 108 108 - 134 134 + 109 135 val has_tool_use : t -> bool 110 136 (** [has_tool_use t] returns true if the message contains any tool use blocks. *) 111 111 - 137 137 + 112 138 val combined_text : t -> string 113 139 (** [combined_text t] concatenates all text blocks into a single string. *) 114 114 - 115 115 - val to_json : t -> Ezjsonm.value 140 140 + 141 141 + val to_json : t -> Jsont.json 116 142 (** [to_json t] converts the assistant message to its JSON representation. *) 117 117 - 118 118 - val of_json : Ezjsonm.value -> t 143 143 + 144 144 + val of_json : Jsont.json -> t 119 145 (** [of_json json] parses an assistant message from JSON. 120 146 @raise Invalid_argument if the JSON is not a valid assistant message. *) 121 121 - 147 147 + 122 148 val pp : Format.formatter -> t -> unit 123 149 (** [pp fmt t] pretty-prints the assistant message. *) 124 150 end ··· 127 153 128 154 module System : sig 129 155 (** System control and status messages. *) 130 130 - 156 156 + 131 157 module Data : sig 132 158 (** System message data. *) 133 133 - 134 134 - type t 135 135 - (** Abstract type for system message data. Contains both the raw JSON 136 136 - and typed accessors for common fields. *) 137 137 - 159 159 + 160 160 + type t = Jsont.json 161 161 + (** Opaque type for system message data. Contains the raw JSON 162 162 + with typed accessors for common fields. *) 163 163 + 164 164 + val jsont : t Jsont.t 165 165 + (** [jsont] is the Jsont codec for system data. *) 166 166 + 138 167 val empty : t 139 168 (** [empty] creates empty data. *) 140 140 - 141 141 - val of_assoc : (string * Ezjsonm.value) list -> t 169 169 + 170 170 + val of_assoc : (string * Jsont.json) list -> t 142 171 (** [of_assoc assoc] creates data from an association list. *) 143 143 - 172 172 + 144 173 val get_string : t -> string -> string option 145 174 (** [get_string t key] returns the string value for [key], if present. *) 146 146 - 175 175 + 147 176 val get_int : t -> string -> int option 148 177 (** [get_int t key] returns the integer value for [key], if present. *) 149 149 - 178 178 + 150 179 val get_bool : t -> string -> bool option 151 180 (** [get_bool t key] returns the boolean value for [key], if present. *) 152 152 - 181 181 + 153 182 val get_float : t -> string -> float option 154 183 (** [get_float t key] returns the float value for [key], if present. *) 155 155 - 156 156 - val get_list : t -> string -> Ezjsonm.value list option 184 184 + 185 185 + val get_list : t -> string -> Jsont.json list option 157 186 (** [get_list t key] returns the list value for [key], if present. *) 158 158 - 159 159 - val get_field : t -> string -> Ezjsonm.value option 187 187 + 188 188 + val get_field : t -> string -> Jsont.json option 160 189 (** [get_field t key] returns the raw JSON value for [key], if present. *) 161 161 - 162 162 - val raw_json : t -> Ezjsonm.value 190 190 + 191 191 + val raw_json : t -> Jsont.json 163 192 (** [raw_json t] returns the full underlying JSON data. *) 164 164 - 165 165 - val to_json : t -> Ezjsonm.value 193 193 + 194 194 + val to_json : t -> Jsont.json 166 195 (** [to_json t] converts to JSON representation. Internal use only. *) 167 167 - 168 168 - val of_json : Ezjsonm.value -> t 196 196 + 197 197 + val of_json : Jsont.json -> t 169 198 (** [of_json json] parses from JSON. Internal use only. *) 170 199 end 171 171 - 200 200 + 201 201 + module Unknown : sig 202 202 + type t = Jsont.json 203 203 + val empty : t 204 204 + val is_empty : t -> bool 205 205 + val jsont : t Jsont.t 206 206 + end 207 207 + 172 208 type t 173 209 (** The type of system messages. *) 174 174 - 210 210 + 211 211 + val jsont : t Jsont.t 212 212 + (** [jsont] is the Jsont codec for system messages. *) 213 213 + 175 214 val create : subtype:string -> data:Data.t -> t 176 215 (** [create ~subtype ~data] creates a system message. 177 216 @param subtype The subtype of the system message 178 217 @param data Additional data for the message *) 179 179 - 218 218 + 180 219 val subtype : t -> string 181 220 (** [subtype t] returns the subtype of the system message. *) 182 182 - 221 221 + 183 222 val data : t -> Data.t 184 223 (** [data t] returns the additional data of the system message. *) 185 185 - 186 186 - val to_json : t -> Ezjsonm.value 224 224 + 225 225 + val unknown : t -> Unknown.t 226 226 + (** [unknown t] returns the unknown fields preserved from JSON. *) 227 227 + 228 228 + val to_json : t -> Jsont.json 187 229 (** [to_json t] converts the system message to its JSON representation. *) 188 188 - 189 189 - val of_json : Ezjsonm.value -> t 230 230 + 231 231 + val of_json : Jsont.json -> t 190 232 (** [of_json json] parses a system message from JSON. 191 233 @raise Invalid_argument if the JSON is not a valid system message. *) 192 192 - 234 234 + 193 235 val pp : Format.formatter -> t -> unit 194 236 (** [pp fmt t] pretty-prints the system message. *) 195 237 end ··· 198 240 199 241 module Result : sig 200 242 (** Final result messages with metadata about the conversation. *) 201 201 - 243 243 + 202 244 module Usage : sig 203 245 (** Usage statistics for API calls. *) 204 204 - 205 205 - type t 206 206 - (** Abstract type for usage statistics. *) 207 207 - 208 208 - val create : 209 209 - ?input_tokens:int -> 210 210 - ?output_tokens:int -> 246 246 + 247 247 + type t = Jsont.json 248 248 + (** Opaque type for usage statistics. *) 249 249 + 250 250 + val jsont : t Jsont.t 251 251 + (** [jsont] is the Jsont codec for usage statistics. *) 252 252 + 253 253 + val create : 254 254 + ?input_tokens:int -> 255 255 + ?output_tokens:int -> 211 256 ?total_tokens:int -> 212 257 ?cache_creation_input_tokens:int -> 213 258 ?cache_read_input_tokens:int -> 214 259 unit -> t 215 215 - (** [create ?input_tokens ?output_tokens ?total_tokens ?cache_creation_input_tokens 260 260 + (** [create ?input_tokens ?output_tokens ?total_tokens ?cache_creation_input_tokens 216 261 ?cache_read_input_tokens ()] creates usage statistics. *) 217 217 - 262 262 + 218 263 val input_tokens : t -> int option 219 264 (** [input_tokens t] returns the number of input tokens used. *) 220 220 - 265 265 + 221 266 val output_tokens : t -> int option 222 267 (** [output_tokens t] returns the number of output tokens generated. *) 223 223 - 268 268 + 224 269 val total_tokens : t -> int option 225 270 (** [total_tokens t] returns the total number of tokens. *) 226 226 - 271 271 + 227 272 val cache_creation_input_tokens : t -> int option 228 273 (** [cache_creation_input_tokens t] returns cache creation input tokens. *) 229 229 - 274 274 + 230 275 val cache_read_input_tokens : t -> int option 231 276 (** [cache_read_input_tokens t] returns cache read input tokens. *) 232 232 - 277 277 + 233 278 val effective_input_tokens : t -> int 234 279 (** [effective_input_tokens t] returns input tokens minus cached tokens, or 0 if not available. *) 235 235 - 280 280 + 236 281 val total_cost_estimate : t -> input_price:float -> output_price:float -> float option 237 237 - (** [total_cost_estimate t ~input_price ~output_price] estimates the cost based on token 282 282 + (** [total_cost_estimate t ~input_price ~output_price] estimates the cost based on token 238 283 prices per million tokens. Returns None if token counts are not available. *) 239 239 - 284 284 + 240 285 val pp : Format.formatter -> t -> unit 241 286 (** [pp fmt t] pretty-prints the usage statistics. *) 242 242 - 243 243 - val to_json : t -> Ezjsonm.value 287 287 + 288 288 + val to_json : t -> Jsont.json 244 289 (** [to_json t] converts to JSON representation. Internal use only. *) 245 245 - 246 246 - val of_json : Ezjsonm.value -> t 290 290 + 291 291 + val of_json : Jsont.json -> t 247 292 (** [of_json json] parses from JSON. Internal use only. *) 248 293 end 249 249 - 294 294 + 295 295 + module Unknown : sig 296 296 + type t = Jsont.json 297 297 + val empty : t 298 298 + val is_empty : t -> bool 299 299 + val jsont : t Jsont.t 300 300 + end 301 301 + 250 302 type t 251 303 (** The type of result messages. *) 252 252 - 304 304 + 305 305 + val jsont : t Jsont.t 306 306 + (** [jsont] is the Jsont codec for result messages. *) 307 307 + 253 308 val create : 254 309 subtype:string -> 255 310 duration_ms:int -> ··· 260 315 ?total_cost_usd:float -> 261 316 ?usage:Usage.t -> 262 317 ?result:string -> 263 263 - ?structured_output:Ezjsonm.value -> 318 318 + ?structured_output:Jsont.json -> 264 319 unit -> t 265 265 - (** [create ~subtype ~duration_ms ~duration_api_ms ~is_error ~num_turns 320 320 + (** [create ~subtype ~duration_ms ~duration_api_ms ~is_error ~num_turns 266 321 ~session_id ?total_cost_usd ?usage ?result ()] creates a result message. 267 322 @param subtype The subtype of the result 268 323 @param duration_ms Total duration in milliseconds ··· 274 329 @param usage Optional usage statistics as JSON 275 330 @param result Optional result string 276 331 @param structured_output Optional structured JSON output from Claude *) 277 277 - 332 332 + 278 333 val subtype : t -> string 279 334 (** [subtype t] returns the subtype of the result. *) 280 280 - 335 335 + 281 336 val duration_ms : t -> int 282 337 (** [duration_ms t] returns the total duration in milliseconds. *) 283 283 - 338 338 + 284 339 val duration_api_ms : t -> int 285 340 (** [duration_api_ms t] returns the API duration in milliseconds. *) 286 286 - 341 341 + 287 342 val is_error : t -> bool 288 343 (** [is_error t] returns whether this result represents an error. *) 289 289 - 344 344 + 290 345 val num_turns : t -> int 291 346 (** [num_turns t] returns the number of conversation turns. *) 292 292 - 347 347 + 293 348 val session_id : t -> string 294 349 (** [session_id t] returns the session identifier. *) 295 295 - 350 350 + 296 351 val total_cost_usd : t -> float option 297 352 (** [total_cost_usd t] returns the optional total cost in USD. *) 298 298 - 353 353 + 299 354 val usage : t -> Usage.t option 300 355 (** [usage t] returns the optional usage statistics. *) 301 301 - 356 356 + 302 357 val result : t -> string option 303 358 (** [result t] returns the optional result string. *) 304 359 305 305 - val structured_output : t -> Ezjsonm.value option 360 360 + val structured_output : t -> Jsont.json option 306 361 (** [structured_output t] returns the optional structured JSON output. *) 307 362 308 308 - val to_json : t -> Ezjsonm.value 363 363 + val unknown : t -> Unknown.t 364 364 + (** [unknown t] returns the unknown fields preserved from JSON. *) 365 365 + 366 366 + val to_json : t -> Jsont.json 309 367 (** [to_json t] converts the result message to its JSON representation. *) 310 310 - 311 311 - val of_json : Ezjsonm.value -> t 368 368 + 369 369 + val of_json : Jsont.json -> t 312 370 (** [of_json json] parses a result message from JSON. 313 371 @raise Invalid_argument if the JSON is not a valid result message. *) 314 314 - 372 372 + 315 373 val pp : Format.formatter -> t -> unit 316 374 (** [pp fmt t] pretty-prints the result message. *) 317 375 end ··· 325 383 | Result of Result.t 326 384 (** The type of messages, which can be user, assistant, system, or result. *) 327 385 386 386 + val jsont : t Jsont.t 387 387 + (** [jsont] is the Jsont codec for messages. *) 388 388 + 328 389 val user_string : string -> t 329 390 (** [user_string s] creates a user message with text content. *) 330 391 ··· 332 393 (** [user_blocks blocks] creates a user message with content blocks. *) 333 394 334 395 val user_with_tool_result : tool_use_id:string -> content:string -> ?is_error:bool -> unit -> t 335 335 - (** [user_with_tool_result ~tool_use_id ~content ?is_error ()] creates a user message 396 396 + (** [user_with_tool_result ~tool_use_id ~content ?is_error ()] creates a user message 336 397 containing a tool result. *) 337 398 338 399 val assistant : content:Content_block.t list -> model:string -> ?error:Assistant.error -> unit -> t ··· 360 421 ?total_cost_usd:float -> 361 422 ?usage:Result.Usage.t -> 362 423 ?result:string -> 363 363 - ?structured_output:Ezjsonm.value -> 424 424 + ?structured_output:Jsont.json -> 364 425 unit -> t 365 365 - (** [result ~subtype ~duration_ms ~duration_api_ms ~is_error ~num_turns 426 426 + (** [result ~subtype ~duration_ms ~duration_api_ms ~is_error ~num_turns 366 427 ~session_id ?total_cost_usd ?usage ?result ()] creates a result message. *) 367 428 368 368 - val to_json : t -> Ezjsonm.value 429 429 + val to_json : t -> Jsont.json 369 430 (** [to_json t] converts any message to its JSON representation. *) 370 431 371 371 - val of_json : Ezjsonm.value -> t 432 432 + val of_json : Jsont.json -> t 372 433 (** [of_json json] parses a message from JSON. 373 434 @raise Invalid_argument if the JSON is not a valid message. *) 374 435

+27

claudeio/lib/model.ml

reviewed

··· 1 1 + type t = [ 2 2 + | `Sonnet_4_5 3 3 + | `Sonnet_4 4 4 + | `Sonnet_3_5 5 5 + | `Opus_4 6 6 + | `Haiku_4 7 7 + | `Custom of string 8 8 + ] 9 9 + 10 10 + let to_string = function 11 11 + | `Sonnet_4_5 -> "claude-sonnet-4-5" 12 12 + | `Sonnet_4 -> "claude-sonnet-4" 13 13 + | `Sonnet_3_5 -> "claude-sonnet-3-5" 14 14 + | `Opus_4 -> "claude-opus-4" 15 15 + | `Haiku_4 -> "claude-haiku-4" 16 16 + | `Custom s -> s 17 17 + 18 18 + let of_string = function 19 19 + | "claude-sonnet-4-5" -> `Sonnet_4_5 20 20 + | "claude-sonnet-4" -> `Sonnet_4 21 21 + | "claude-sonnet-3-5" -> `Sonnet_3_5 22 22 + | "claude-opus-4" -> `Opus_4 23 23 + | "claude-haiku-4" -> `Haiku_4 24 24 + | s -> `Custom s 25 25 + 26 26 + let pp fmt t = 27 27 + Fmt.string fmt (to_string t)

+36

claudeio/lib/model.mli

reviewed

··· 1 1 + (** Claude AI model identifiers. 2 2 + 3 3 + This module provides type-safe model identifiers based on the Python SDK's 4 4 + model strings. Use polymorphic variants for known models with a custom 5 5 + escape hatch for future or unknown models. *) 6 6 + 7 7 + type t = [ 8 8 + | `Sonnet_4_5 (** claude-sonnet-4-5 - Most recent Sonnet model *) 9 9 + | `Sonnet_4 (** claude-sonnet-4 - Sonnet 4 model *) 10 10 + | `Sonnet_3_5 (** claude-sonnet-3-5 - Sonnet 3.5 model *) 11 11 + | `Opus_4 (** claude-opus-4 - Opus 4 model for complex tasks *) 12 12 + | `Haiku_4 (** claude-haiku-4 - Fast, cost-effective Haiku model *) 13 13 + | `Custom of string (** Custom model string for future/unknown models *) 14 14 + ] 15 15 + (** The type of Claude models. *) 16 16 + 17 17 + val to_string : t -> string 18 18 + (** [to_string t] converts a model to its CLI string representation. 19 19 + 20 20 + Examples: 21 21 + - [`Sonnet_4_5] becomes "claude-sonnet-4-5" 22 22 + - [`Opus_4] becomes "claude-opus-4" 23 23 + - [`Custom "my-model"] becomes "my-model" *) 24 24 + 25 25 + val of_string : string -> t 26 26 + (** [of_string s] parses a model string into a typed model. 27 27 + 28 28 + Known model strings are converted to their typed variants. 29 29 + Unknown strings become [`Custom s]. 30 30 + 31 31 + Examples: 32 32 + - "claude-sonnet-4-5" becomes [`Sonnet_4_5] 33 33 + - "future-model" becomes [`Custom "future-model"] *) 34 34 + 35 35 + val pp : Format.formatter -> t -> unit 36 36 + (** [pp fmt t] pretty-prints a model identifier. *)

+82 -99

claudeio/lib/options.ml

reviewed

··· 1 1 - open Ezjsonm 2 2 - 3 1 let src = Logs.Src.create "claude.options" ~doc:"Claude configuration options" 4 2 module Log = (val Logs.src_log src : Logs.LOG) 5 3 6 4 type setting_source = User | Project | Local 7 5 6 6 + module Unknown = struct 7 7 + type t = Jsont.json 8 8 + let empty = Jsont.Object ([], Jsont.Meta.none) 9 9 + let _is_empty = function Jsont.Object ([], _) -> true | _ -> false 10 10 + let _jsont = Jsont.json 11 11 + end 12 12 + 8 13 type t = { 9 14 allowed_tools : string list; 10 15 disallowed_tools : string list; ··· 31 36 max_buffer_size : int option; 32 37 user : string option; 33 38 output_format : Structured_output.t option; 39 39 + unknown : Unknown.t; 34 40 } 35 41 36 42 let default = { ··· 59 65 max_buffer_size = None; 60 66 user = None; 61 67 output_format = None; 68 68 + unknown = Unknown.empty; 62 69 } 63 70 64 71 let create ··· 87 94 ?max_buffer_size 88 95 ?user 89 96 ?output_format 97 97 + ?(unknown = Unknown.empty) 90 98 () = 91 99 { allowed_tools; disallowed_tools; max_thinking_tokens; 92 100 system_prompt; append_system_prompt; permission_mode; ··· 95 103 permission_prompt_tool_name; settings; add_dirs; 96 104 extra_args; debug_stderr; hooks; 97 105 max_budget_usd; fallback_model; setting_sources; 98 98 - max_buffer_size; user; output_format } 106 106 + max_buffer_size; user; output_format; unknown } 99 107 100 108 let allowed_tools t = t.allowed_tools 101 109 let disallowed_tools t = t.disallowed_tools ··· 122 130 let max_buffer_size t = t.max_buffer_size 123 131 let user t = t.user 124 132 let output_format t = t.output_format 133 133 + let unknown t = t.unknown 125 134 126 135 let with_allowed_tools tools t = { t with allowed_tools = tools } 127 136 let with_disallowed_tools tools t = { t with disallowed_tools = tools } ··· 152 161 let with_user user t = { t with user = Some user } 153 162 let with_output_format format t = { t with output_format = Some format } 154 163 164 164 + (* Helper codec for Model.t *) 165 165 + let model_jsont : Model.t Jsont.t = 166 166 + Jsont.map ~kind:"Model" 167 167 + ~dec:Model.of_string 168 168 + ~enc:Model.to_string 169 169 + Jsont.string 170 170 + 171 171 + (* Helper codec for env - list of string pairs encoded as object *) 172 172 + let env_jsont : (string * string) list Jsont.t = 173 173 + Jsont.map ~kind:"Env" 174 174 + ~dec:(fun obj -> 175 175 + match obj with 176 176 + | Jsont.Object (members, _) -> 177 177 + List.map (fun ((name, _), value) -> 178 178 + match value with 179 179 + | Jsont.String (s, _) -> (name, s) 180 180 + | _ -> (name, "") 181 181 + ) members 182 182 + | _ -> []) 183 183 + ~enc:(fun pairs -> 184 184 + let mems = List.map (fun (k, v) -> 185 185 + Jsont.Json.mem (Jsont.Json.name k) (Jsont.Json.string v) 186 186 + ) pairs in 187 187 + Jsont.Json.object' mems) 188 188 + Jsont.json 189 189 + 190 190 + let jsont : t Jsont.t = 191 191 + let make allowed_tools disallowed_tools max_thinking_tokens 192 192 + system_prompt append_system_prompt permission_mode 193 193 + model env unknown = 194 194 + { allowed_tools; disallowed_tools; max_thinking_tokens; 195 195 + system_prompt; append_system_prompt; permission_mode; 196 196 + permission_callback = Some Permissions.default_allow_callback; 197 197 + model; cwd = None; env; 198 198 + continue_conversation = false; 199 199 + resume = None; 200 200 + max_turns = None; 201 201 + permission_prompt_tool_name = None; 202 202 + settings = None; 203 203 + add_dirs = []; 204 204 + extra_args = []; 205 205 + debug_stderr = None; 206 206 + hooks = None; 207 207 + max_budget_usd = None; 208 208 + fallback_model = None; 209 209 + setting_sources = None; 210 210 + max_buffer_size = None; 211 211 + user = None; 212 212 + output_format = None; 213 213 + unknown } 214 214 + in 215 215 + Jsont.Object.map ~kind:"Options" make 216 216 + |> Jsont.Object.mem "allowed_tools" (Jsont.list Jsont.string) ~enc:allowed_tools ~dec_absent:[] 217 217 + |> Jsont.Object.mem "disallowed_tools" (Jsont.list Jsont.string) ~enc:disallowed_tools ~dec_absent:[] 218 218 + |> Jsont.Object.mem "max_thinking_tokens" Jsont.int ~enc:max_thinking_tokens ~dec_absent:8000 219 219 + |> Jsont.Object.opt_mem "system_prompt" Jsont.string ~enc:system_prompt 220 220 + |> Jsont.Object.opt_mem "append_system_prompt" Jsont.string ~enc:append_system_prompt 221 221 + |> Jsont.Object.opt_mem "permission_mode" Permissions.Mode.jsont ~enc:permission_mode 222 222 + |> Jsont.Object.opt_mem "model" model_jsont ~enc:model 223 223 + |> Jsont.Object.mem "env" env_jsont ~enc:env ~dec_absent:[] 224 224 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 225 225 + |> Jsont.Object.finish 226 226 + 155 227 let to_json t = 156 156 - let fields = [] in 157 157 - let fields = 158 158 - if t.allowed_tools <> [] then 159 159 - ("allowed_tools", `A (List.map (fun s -> `String s) t.allowed_tools)) :: fields 160 160 - else fields 161 161 - in 162 162 - let fields = 163 163 - if t.disallowed_tools <> [] then 164 164 - ("disallowed_tools", `A (List.map (fun s -> `String s) t.disallowed_tools)) :: fields 165 165 - else fields 166 166 - in 167 167 - let fields = 168 168 - if t.max_thinking_tokens <> 8000 then 169 169 - ("max_thinking_tokens", `Float (float_of_int t.max_thinking_tokens)) :: fields 170 170 - else fields 171 171 - in 172 172 - let fields = match t.system_prompt with 173 173 - | Some p -> ("system_prompt", `String p) :: fields 174 174 - | None -> fields 175 175 - in 176 176 - let fields = match t.append_system_prompt with 177 177 - | Some p -> ("append_system_prompt", `String p) :: fields 178 178 - | None -> fields 179 179 - in 180 180 - let fields = match t.permission_mode with 181 181 - | Some m -> ("permission_mode", Permissions.Mode.to_json m) :: fields 182 182 - | None -> fields 183 183 - in 184 184 - let fields = match t.model with 185 185 - | Some m -> ("model", `String (Model.to_string m)) :: fields 186 186 - | None -> fields 187 187 - in 188 188 - let fields = 189 189 - if t.env <> [] then 190 190 - let env_obj = `O (List.map (fun (k, v) -> (k, `String v)) t.env) in 191 191 - ("env", env_obj) :: fields 192 192 - else fields 193 193 - in 194 194 - `O fields 228 228 + match Jsont.Json.encode jsont t with 229 229 + | Ok json -> json 230 230 + | Error msg -> failwith ("Options.to_json: " ^ msg) 195 231 196 196 - let of_json = function 197 197 - | `O fields -> 198 198 - let allowed_tools = 199 199 - try get_list get_string (List.assoc "allowed_tools" fields) 200 200 - with Not_found -> [] 201 201 - in 202 202 - let disallowed_tools = 203 203 - try get_list get_string (List.assoc "disallowed_tools" fields) 204 204 - with Not_found -> [] 205 205 - in 206 206 - let max_thinking_tokens = 207 207 - try int_of_float (get_float (List.assoc "max_thinking_tokens" fields)) 208 208 - with Not_found -> 8000 209 209 - in 210 210 - let system_prompt = 211 211 - try Some (get_string (List.assoc "system_prompt" fields)) 212 212 - with Not_found -> None 213 213 - in 214 214 - let append_system_prompt = 215 215 - try Some (get_string (List.assoc "append_system_prompt" fields)) 216 216 - with Not_found -> None 217 217 - in 218 218 - let permission_mode = 219 219 - try Some (Permissions.Mode.of_json (List.assoc "permission_mode" fields)) 220 220 - with Not_found -> None 221 221 - in 222 222 - let model = 223 223 - try Some (Model.of_string (get_string (List.assoc "model" fields))) 224 224 - with Not_found -> None 225 225 - in 226 226 - let env = 227 227 - try 228 228 - match List.assoc "env" fields with 229 229 - | `O pairs -> List.map (fun (k, v) -> (k, get_string v)) pairs 230 230 - | _ -> [] 231 231 - with Not_found -> [] 232 232 - in 233 233 - { allowed_tools; disallowed_tools; max_thinking_tokens; 234 234 - system_prompt; append_system_prompt; permission_mode; 235 235 - permission_callback = Some Permissions.default_allow_callback; 236 236 - model; cwd = None; env; 237 237 - continue_conversation = false; 238 238 - resume = None; 239 239 - max_turns = None; 240 240 - permission_prompt_tool_name = None; 241 241 - settings = None; 242 242 - add_dirs = []; 243 243 - extra_args = []; 244 244 - debug_stderr = None; 245 245 - hooks = None; 246 246 - max_budget_usd = None; 247 247 - fallback_model = None; 248 248 - setting_sources = None; 249 249 - max_buffer_size = None; 250 250 - user = None; 251 251 - output_format = None; } 252 252 - | _ -> raise (Invalid_argument "Options.of_json: expected object") 232 232 + let of_json json = 233 233 + match Jsont.Json.decode jsont json with 234 234 + | Ok t -> t 235 235 + | Error msg -> raise (Invalid_argument ("Options.of_json: " ^ msg)) 253 236 254 237 let pp fmt t = 255 238 Fmt.pf fmt "@[<v>Options {@ \

+10 -5

claudeio/lib/options.mli

reviewed

··· 62 62 {3 Structured Output: Type-Safe Responses} 63 63 64 64 {[ 65 65 - let schema = Ezjsonm.(`O [ 65 65 + let schema = Jsont.json_of_json (`O [ 66 66 ("type", `String "object"); 67 67 ("properties", `O [ 68 68 ("count", `O [("type", `String "integer")]); ··· 98 98 99 99 Use {!with_fallback_model} to specify an alternative model when the 100 100 primary model is unavailable or overloaded. This improves reliability. *) 101 101 - 102 102 - open Ezjsonm 103 101 104 102 (** The log source for options operations *) 105 103 val src : Logs.Src.t ··· 148 146 ?max_buffer_size:int -> 149 147 ?user:string -> 150 148 ?output_format:Structured_output.t -> 149 149 + ?unknown:Jsont.json -> 151 150 unit -> t 152 151 (** [create ?allowed_tools ?disallowed_tools ?max_thinking_tokens ?system_prompt 153 152 ?append_system_prompt ?permission_mode ?permission_callback ?model ?cwd ?env ··· 257 256 258 257 val output_format : t -> Structured_output.t option 259 258 (** [output_format t] returns the optional structured output format. *) 259 259 + 260 260 + val unknown : t -> Jsont.json 261 261 + (** [unknown t] returns any unknown JSON fields that were preserved during decoding. *) 260 262 261 263 (** {1 Builders} *) 262 264 ··· 351 353 352 354 (** {1 Serialization} *) 353 355 354 354 - val to_json : t -> value 356 356 + val jsont : t Jsont.t 357 357 + (** [jsont] is the Jsont codec for Options.t *) 358 358 + 359 359 + val to_json : t -> Jsont.json 355 360 (** [to_json t] converts options to JSON representation. *) 356 361 357 357 - val of_json : value -> t 362 362 + val of_json : Jsont.json -> t 358 363 (** [of_json json] parses options from JSON. 359 364 @raise Invalid_argument if the JSON is not valid options. *) 360 365

+192 -168

claudeio/lib/permissions.ml

reviewed

··· 1 1 - open Ezjsonm 2 2 - 3 1 let src = Logs.Src.create "claude.permission" ~doc:"Claude permission system" 4 2 module Log = (val Logs.src_log src : Logs.LOG) 5 3 6 4 (* Helper for pretty-printing JSON *) 7 5 let pp_json fmt json = 8 8 - Fmt.string fmt (value_to_string json) 6 6 + let s = match Jsont_bytesrw.encode_string' Jsont.json json with 7 7 + | Ok s -> s 8 8 + | Error err -> Jsont.Error.to_string err 9 9 + in 10 10 + Fmt.string fmt s 9 11 10 12 (** Permission modes *) 11 13 module Mode = struct 12 12 - type t = 14 14 + type t = 13 15 | Default 14 16 | Accept_edits 15 17 | Plan 16 18 | Bypass_permissions 17 17 - 19 19 + 18 20 let to_string = function 19 21 | Default -> "default" 20 22 | Accept_edits -> "acceptEdits" 21 23 | Plan -> "plan" 22 24 | Bypass_permissions -> "bypassPermissions" 23 23 - 25 25 + 24 26 let of_string = function 25 27 | "default" -> Default 26 28 | "acceptEdits" -> Accept_edits 27 29 | "plan" -> Plan 28 30 | "bypassPermissions" -> Bypass_permissions 29 31 | s -> raise (Invalid_argument (Printf.sprintf "Mode.of_string: unknown mode %s" s)) 30 30 - 31 31 - let to_json t = `String (to_string t) 32 32 - 33 33 - let of_json = function 34 34 - | `String s -> of_string s 35 35 - | _ -> raise (Invalid_argument "Mode.of_json: expected string") 36 36 - 32 32 + 37 33 let pp fmt t = Fmt.string fmt (to_string t) 34 34 + 35 35 + let jsont : t Jsont.t = 36 36 + Jsont.enum [ 37 37 + "default", Default; 38 38 + "acceptEdits", Accept_edits; 39 39 + "plan", Plan; 40 40 + "bypassPermissions", Bypass_permissions; 41 41 + ] 38 42 end 39 43 40 44 (** Permission behaviors *) 41 45 module Behavior = struct 42 46 type t = Allow | Deny | Ask 43 43 - 47 47 + 44 48 let to_string = function 45 49 | Allow -> "allow" 46 50 | Deny -> "deny" 47 51 | Ask -> "ask" 48 48 - 52 52 + 49 53 let of_string = function 50 54 | "allow" -> Allow 51 55 | "deny" -> Deny 52 56 | "ask" -> Ask 53 57 | s -> raise (Invalid_argument (Printf.sprintf "Behavior.of_string: unknown behavior %s" s)) 54 54 - 55 55 - let to_json t = `String (to_string t) 56 56 - 57 57 - let of_json = function 58 58 - | `String s -> of_string s 59 59 - | _ -> raise (Invalid_argument "Behavior.of_json: expected string") 60 60 - 58 58 + 61 59 let pp fmt t = Fmt.string fmt (to_string t) 60 60 + 61 61 + let jsont : t Jsont.t = 62 62 + Jsont.enum [ 63 63 + "allow", Allow; 64 64 + "deny", Deny; 65 65 + "ask", Ask; 66 66 + ] 62 67 end 63 68 64 69 (** Permission rules *) 65 70 module Rule = struct 71 71 + module Unknown = struct 72 72 + type t = Jsont.json 73 73 + let empty = Jsont.Object ([], Jsont.Meta.none) 74 74 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 75 75 + let jsont = Jsont.json 76 76 + end 77 77 + 66 78 type t = { 67 79 tool_name : string; 68 80 rule_content : string option; 81 81 + unknown : Unknown.t; 69 82 } 70 70 - 71 71 - let create ~tool_name ?rule_content () = { tool_name; rule_content } 83 83 + 84 84 + let create ~tool_name ?rule_content ?(unknown = Unknown.empty) () = 85 85 + { tool_name; rule_content; unknown } 72 86 let tool_name t = t.tool_name 73 87 let rule_content t = t.rule_content 74 74 - 75 75 - let to_json t = 76 76 - let fields = [("tool_name", `String t.tool_name)] in 77 77 - let fields = match t.rule_content with 78 78 - | Some c -> ("rule_content", `String c) :: fields 79 79 - | None -> fields 80 80 - in 81 81 - `O fields 82 82 - 83 83 - let of_json = function 84 84 - | `O fields -> 85 85 - let tool_name = get_string (List.assoc "tool_name" fields) in 86 86 - let rule_content = 87 87 - try Some (get_string (List.assoc "rule_content" fields)) 88 88 - with Not_found -> None 89 89 - in 90 90 - { tool_name; rule_content } 91 91 - | _ -> raise (Invalid_argument "Rule.of_json: expected object") 92 92 - 88 88 + let unknown t = t.unknown 89 89 + 90 90 + let jsont : t Jsont.t = 91 91 + let make tool_name rule_content unknown = { tool_name; rule_content; unknown } in 92 92 + Jsont.Object.map ~kind:"Rule" make 93 93 + |> Jsont.Object.mem "tool_name" Jsont.string ~enc:tool_name 94 94 + |> Jsont.Object.opt_mem "rule_content" Jsont.string ~enc:rule_content 95 95 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 96 96 + |> Jsont.Object.finish 97 97 + 93 98 let pp fmt t = 94 99 Fmt.pf fmt "@[<2>Rule@ { tool_name = %S;@ rule_content = %a }@]" 95 100 t.tool_name Fmt.(option string) t.rule_content ··· 97 102 98 103 (** Permission updates *) 99 104 module Update = struct 100 100 - type destination = 105 105 + type destination = 101 106 | User_settings 102 107 | Project_settings 103 108 | Local_settings 104 109 | Session 105 105 - 110 110 + 106 111 let destination_to_string = function 107 112 | User_settings -> "userSettings" 108 113 | Project_settings -> "projectSettings" 109 114 | Local_settings -> "localSettings" 110 115 | Session -> "session" 111 111 - 112 112 - let destination_of_string = function 116 116 + 117 117 + let _destination_of_string = function 113 118 | "userSettings" -> User_settings 114 119 | "projectSettings" -> Project_settings 115 120 | "localSettings" -> Local_settings 116 121 | "session" -> Session 117 122 | s -> raise (Invalid_argument (Printf.sprintf "destination_of_string: unknown %s" s)) 118 118 - 123 123 + 124 124 + let destination_jsont : destination Jsont.t = 125 125 + Jsont.enum [ 126 126 + "userSettings", User_settings; 127 127 + "projectSettings", Project_settings; 128 128 + "localSettings", Local_settings; 129 129 + "session", Session; 130 130 + ] 131 131 + 119 132 type update_type = 120 133 | Add_rules 121 134 | Replace_rules ··· 123 136 | Set_mode 124 137 | Add_directories 125 138 | Remove_directories 126 126 - 139 139 + 127 140 let update_type_to_string = function 128 141 | Add_rules -> "addRules" 129 142 | Replace_rules -> "replaceRules" ··· 131 144 | Set_mode -> "setMode" 132 145 | Add_directories -> "addDirectories" 133 146 | Remove_directories -> "removeDirectories" 134 134 - 135 135 - let update_type_of_string = function 147 147 + 148 148 + let _update_type_of_string = function 136 149 | "addRules" -> Add_rules 137 150 | "replaceRules" -> Replace_rules 138 151 | "removeRules" -> Remove_rules ··· 140 153 | "addDirectories" -> Add_directories 141 154 | "removeDirectories" -> Remove_directories 142 155 | s -> raise (Invalid_argument (Printf.sprintf "update_type_of_string: unknown %s" s)) 156 156 + 157 157 + let update_type_jsont : update_type Jsont.t = 158 158 + Jsont.enum [ 159 159 + "addRules", Add_rules; 160 160 + "replaceRules", Replace_rules; 161 161 + "removeRules", Remove_rules; 162 162 + "setMode", Set_mode; 163 163 + "addDirectories", Add_directories; 164 164 + "removeDirectories", Remove_directories; 165 165 + ] 143 166 167 167 + module Unknown = struct 168 168 + type t = Jsont.json 169 169 + let empty = Jsont.Object ([], Jsont.Meta.none) 170 170 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 171 171 + let jsont = Jsont.json 172 172 + end 173 173 + 144 174 type t = { 145 175 update_type : update_type; 146 176 rules : Rule.t list option; ··· 148 178 mode : Mode.t option; 149 179 directories : string list option; 150 180 destination : destination option; 181 181 + unknown : Unknown.t; 151 182 } 152 152 - 153 153 - let create ~update_type ?rules ?behavior ?mode ?directories ?destination () = 154 154 - { update_type; rules; behavior; mode; directories; destination } 155 155 - 183 183 + 184 184 + let create ~update_type ?rules ?behavior ?mode ?directories ?destination ?(unknown = Unknown.empty) () = 185 185 + { update_type; rules; behavior; mode; directories; destination; unknown } 186 186 + 156 187 let update_type t = t.update_type 157 188 let rules t = t.rules 158 189 let behavior t = t.behavior 159 190 let mode t = t.mode 160 191 let directories t = t.directories 161 192 let destination t = t.destination 162 162 - 163 163 - let to_json t = 164 164 - let fields = [("type", `String (update_type_to_string t.update_type))] in 165 165 - let fields = match t.rules with 166 166 - | Some rules -> ("rules", `A (List.map Rule.to_json rules)) :: fields 167 167 - | None -> fields 193 193 + let unknown t = t.unknown 194 194 + 195 195 + let jsont : t Jsont.t = 196 196 + let make update_type rules behavior mode directories destination unknown = 197 197 + { update_type; rules; behavior; mode; directories; destination; unknown } 168 198 in 169 169 - let fields = match t.behavior with 170 170 - | Some b -> ("behavior", Behavior.to_json b) :: fields 171 171 - | None -> fields 172 172 - in 173 173 - let fields = match t.mode with 174 174 - | Some m -> ("mode", Mode.to_json m) :: fields 175 175 - | None -> fields 176 176 - in 177 177 - let fields = match t.directories with 178 178 - | Some dirs -> ("directories", `A (List.map (fun s -> `String s) dirs)) :: fields 179 179 - | None -> fields 180 180 - in 181 181 - let fields = match t.destination with 182 182 - | Some d -> ("destination", `String (destination_to_string d)) :: fields 183 183 - | None -> fields 184 184 - in 185 185 - `O fields 186 186 - 187 187 - let of_json = function 188 188 - | `O fields -> 189 189 - let update_type = update_type_of_string (get_string (List.assoc "type" fields)) in 190 190 - let rules = 191 191 - try Some (get_list Rule.of_json (List.assoc "rules" fields)) 192 192 - with Not_found -> None 193 193 - in 194 194 - let behavior = 195 195 - try Some (Behavior.of_json (List.assoc "behavior" fields)) 196 196 - with Not_found -> None 197 197 - in 198 198 - let mode = 199 199 - try Some (Mode.of_json (List.assoc "mode" fields)) 200 200 - with Not_found -> None 201 201 - in 202 202 - let directories = 203 203 - try Some (get_list get_string (List.assoc "directories" fields)) 204 204 - with Not_found -> None 205 205 - in 206 206 - let destination = 207 207 - try Some (destination_of_string (get_string (List.assoc "destination" fields))) 208 208 - with Not_found -> None 209 209 - in 210 210 - { update_type; rules; behavior; mode; directories; destination } 211 211 - | _ -> raise (Invalid_argument "Update.of_json: expected object") 199 199 + Jsont.Object.map ~kind:"Update" make 200 200 + |> Jsont.Object.mem "type" update_type_jsont ~enc:update_type 201 201 + |> Jsont.Object.opt_mem "rules" (Jsont.list Rule.jsont) ~enc:rules 202 202 + |> Jsont.Object.opt_mem "behavior" Behavior.jsont ~enc:behavior 203 203 + |> Jsont.Object.opt_mem "mode" Mode.jsont ~enc:mode 204 204 + |> Jsont.Object.opt_mem "directories" (Jsont.list Jsont.string) ~enc:directories 205 205 + |> Jsont.Object.opt_mem "destination" destination_jsont ~enc:destination 206 206 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 207 207 + |> Jsont.Object.finish 212 208 213 209 let pp fmt t = 214 210 Fmt.pf fmt "@[<2>Update@ { type = %s;@ rules = %a;@ behavior = %a;@ \ ··· 223 219 224 220 (** Permission context for callbacks *) 225 221 module Context = struct 222 222 + module Unknown = struct 223 223 + type t = Jsont.json 224 224 + let empty = Jsont.Object ([], Jsont.Meta.none) 225 225 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 226 226 + let jsont = Jsont.json 227 227 + end 228 228 + 226 229 type t = { 227 230 suggestions : Update.t list; 231 231 + unknown : Unknown.t; 228 232 } 229 229 - 230 230 - let create ?(suggestions = []) () = { suggestions } 233 233 + 234 234 + let create ?(suggestions = []) ?(unknown = Unknown.empty) () = { suggestions; unknown } 231 235 let suggestions t = t.suggestions 232 232 - 233 233 - let to_json t = 234 234 - `O [("suggestions", `A (List.map Update.to_json t.suggestions))] 235 235 - 236 236 - let of_json = function 237 237 - | `O fields -> 238 238 - let suggestions = 239 239 - try get_list Update.of_json (List.assoc "suggestions" fields) 240 240 - with Not_found -> [] 241 241 - in 242 242 - { suggestions } 243 243 - | _ -> raise (Invalid_argument "Context.of_json: expected object") 244 244 - 236 236 + let unknown t = t.unknown 237 237 + 238 238 + let jsont : t Jsont.t = 239 239 + let make suggestions unknown = { suggestions; unknown } in 240 240 + Jsont.Object.map ~kind:"Context" make 241 241 + |> Jsont.Object.mem "suggestions" (Jsont.list Update.jsont) ~enc:suggestions ~dec_absent:[] 242 242 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown 243 243 + |> Jsont.Object.finish 244 244 + 245 245 let pp fmt t = 246 246 Fmt.pf fmt "@[<2>Context@ { suggestions = @[<v>%a@] }@]" 247 247 Fmt.(list ~sep:(any "@,") Update.pp) t.suggestions ··· 249 249 250 250 (** Permission results *) 251 251 module Result = struct 252 252 + module Unknown = struct 253 253 + type t = Jsont.json 254 254 + let empty = Jsont.Object ([], Jsont.Meta.none) 255 255 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 256 256 + let jsont = Jsont.json 257 257 + end 258 258 + 252 259 type t = 253 260 | Allow of { 254 254 - updated_input : value option; 261 261 + updated_input : Jsont.json option; 255 262 updated_permissions : Update.t list option; 263 263 + unknown : Unknown.t; 256 264 } 257 265 | Deny of { 258 266 message : string; 259 267 interrupt : bool; 268 268 + unknown : Unknown.t; 260 269 } 261 261 - 262 262 - let allow ?updated_input ?updated_permissions () = 263 263 - Allow { updated_input; updated_permissions } 264 264 - 265 265 - let deny ~message ~interrupt = Deny { message; interrupt } 266 266 - 267 267 - let to_json = function 268 268 - | Allow { updated_input; updated_permissions } -> 269 269 - let fields = [("behavior", `String "allow")] in 270 270 - let fields = match updated_input with 271 271 - | Some input -> ("updated_input", input) :: fields 272 272 - | None -> fields 273 273 - in 274 274 - let fields = match updated_permissions with 275 275 - | Some perms -> ("updated_permissions", `A (List.map Update.to_json perms)) :: fields 276 276 - | None -> fields 277 277 - in 278 278 - `O fields 279 279 - | Deny { message; interrupt } -> 280 280 - `O [ 281 281 - ("behavior", `String "deny"); 282 282 - ("message", `String message); 283 283 - ("interrupt", `Bool interrupt); 284 284 - ] 285 285 - 286 286 - let of_json = function 287 287 - | `O fields -> ( 288 288 - match List.assoc "behavior" fields with 289 289 - | `String "allow" -> 290 290 - let updated_input = List.assoc_opt "updated_input" fields in 291 291 - let updated_permissions = 292 292 - try Some (get_list Update.of_json (List.assoc "updated_permissions" fields)) 293 293 - with Not_found -> None 294 294 - in 295 295 - Allow { updated_input; updated_permissions } 296 296 - | `String "deny" -> 297 297 - let message = get_string (List.assoc "message" fields) in 298 298 - let interrupt = get_bool (List.assoc "interrupt" fields) in 299 299 - Deny { message; interrupt } 300 300 - | _ -> raise (Invalid_argument "Result.of_json: unknown behavior") 301 301 - ) 302 302 - | _ -> raise (Invalid_argument "Result.of_json: expected object") 270 270 + 271 271 + let allow ?updated_input ?updated_permissions ?(unknown = Unknown.empty) () = 272 272 + Allow { updated_input; updated_permissions; unknown } 273 273 + 274 274 + let deny ~message ~interrupt ?(unknown = Unknown.empty) () = 275 275 + Deny { message; interrupt; unknown } 276 276 + 277 277 + let jsont : t Jsont.t = 278 278 + let allow_record = 279 279 + let make updated_input updated_permissions unknown = 280 280 + Allow { updated_input; updated_permissions; unknown } 281 281 + in 282 282 + Jsont.Object.map ~kind:"AllowRecord" make 283 283 + |> Jsont.Object.opt_mem "updated_input" Jsont.json ~enc:(function 284 284 + | Allow { updated_input; _ } -> updated_input 285 285 + | _ -> None) 286 286 + |> Jsont.Object.opt_mem "updated_permissions" (Jsont.list Update.jsont) ~enc:(function 287 287 + | Allow { updated_permissions; _ } -> updated_permissions 288 288 + | _ -> None) 289 289 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(function 290 290 + | Allow { unknown; _ } -> unknown 291 291 + | _ -> Unknown.empty) 292 292 + |> Jsont.Object.finish 293 293 + in 294 294 + let deny_record = 295 295 + let make message interrupt unknown = 296 296 + Deny { message; interrupt; unknown } 297 297 + in 298 298 + Jsont.Object.map ~kind:"DenyRecord" make 299 299 + |> Jsont.Object.mem "message" Jsont.string ~enc:(function 300 300 + | Deny { message; _ } -> message 301 301 + | _ -> "") 302 302 + |> Jsont.Object.mem "interrupt" Jsont.bool ~enc:(function 303 303 + | Deny { interrupt; _ } -> interrupt 304 304 + | _ -> false) 305 305 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(function 306 306 + | Deny { unknown; _ } -> unknown 307 307 + | _ -> Unknown.empty) 308 308 + |> Jsont.Object.finish 309 309 + in 310 310 + let case_allow = Jsont.Object.Case.map "allow" allow_record ~dec:(fun v -> v) in 311 311 + let case_deny = Jsont.Object.Case.map "deny" deny_record ~dec:(fun v -> v) in 312 312 + 313 313 + let enc_case = function 314 314 + | Allow _ as v -> Jsont.Object.Case.value case_allow v 315 315 + | Deny _ as v -> Jsont.Object.Case.value case_deny v 316 316 + in 317 317 + 318 318 + let cases = Jsont.Object.Case.[ 319 319 + make case_allow; 320 320 + make case_deny 321 321 + ] in 322 322 + 323 323 + Jsont.Object.map ~kind:"Result" Fun.id 324 324 + |> Jsont.Object.case_mem "behavior" Jsont.string ~enc:Fun.id ~enc_case cases 325 325 + ~tag_to_string:Fun.id ~tag_compare:String.compare 326 326 + |> Jsont.Object.finish 303 327 304 328 let pp fmt = function 305 305 - | Allow { updated_input; updated_permissions } -> 329 329 + | Allow { updated_input; updated_permissions; _ } -> 306 330 Fmt.pf fmt "@[<2>Allow@ { updated_input = %a;@ updated_permissions = %a }@]" 307 331 Fmt.(option pp_json) updated_input 308 332 Fmt.(option (list Update.pp)) updated_permissions 309 309 - | Deny { message; interrupt } -> 333 333 + | Deny { message; interrupt; _ } -> 310 334 Fmt.pf fmt "@[<2>Deny@ { message = %S;@ interrupt = %b }@]" message interrupt 311 335 end 312 336 313 337 (** Permission callback type *) 314 314 - type callback = 315 315 - tool_name:string -> 316 316 - input:value -> 317 317 - context:Context.t -> 338 338 + type callback = 339 339 + tool_name:string -> 340 340 + input:Jsont.json -> 341 341 + context:Context.t -> 318 342 Result.t 319 343 320 344 (** Default callbacks *)

+127 -106

claudeio/lib/permissions.mli

reviewed

··· 1 1 (** Permission system for Claude tool invocations. 2 2 - 2 2 + 3 3 This module provides a permission system for controlling 4 4 which tools Claude can invoke and how they can be used. It includes 5 5 support for permission modes, rules, updates, and callbacks. *) 6 6 - 7 7 - open Ezjsonm 8 6 9 7 (** The log source for permission operations *) 10 8 val src : Logs.Src.t ··· 13 11 14 12 module Mode : sig 15 13 (** Permission modes control the overall behavior of the permission system. *) 16 16 - 17 17 - type t = 14 14 + 15 15 + type t = 18 16 | Default (** Standard permission mode with normal checks *) 19 17 | Accept_edits (** Automatically accept file edits *) 20 18 | Plan (** Planning mode with restricted execution *) 21 19 | Bypass_permissions (** Bypass all permission checks *) 22 20 (** The type of permission modes. *) 23 23 - 21 21 + 24 22 val to_string : t -> string 25 23 (** [to_string t] converts a mode to its string representation. *) 26 26 - 24 24 + 27 25 val of_string : string -> t 28 26 (** [of_string s] parses a mode from its string representation. 29 27 @raise Invalid_argument if the string is not a valid mode. *) 30 30 - 31 31 - val to_json : t -> value 32 32 - (** [to_json t] converts a mode to JSON. *) 33 33 - 34 34 - val of_json : value -> t 35 35 - (** [of_json json] parses a mode from JSON. 36 36 - @raise Invalid_argument if the JSON is not a valid mode. *) 37 37 - 28 28 + 38 29 val pp : Format.formatter -> t -> unit 39 30 (** [pp fmt t] pretty-prints the mode. *) 31 31 + 32 32 + val jsont : t Jsont.t 33 33 + (** [jsont] is the Jsont codec for permission modes. *) 40 34 end 41 35 42 36 (** {1 Permission Behaviors} *) 43 37 44 38 module Behavior : sig 45 39 (** Behaviors determine how permission requests are handled. *) 46 46 - 47 47 - type t = 40 40 + 41 41 + type t = 48 42 | Allow (** Allow the operation *) 49 43 | Deny (** Deny the operation *) 50 44 | Ask (** Ask the user for permission *) 51 45 (** The type of permission behaviors. *) 52 52 - 46 46 + 53 47 val to_string : t -> string 54 48 (** [to_string t] converts a behavior to its string representation. *) 55 55 - 49 49 + 56 50 val of_string : string -> t 57 51 (** [of_string s] parses a behavior from its string representation. 58 52 @raise Invalid_argument if the string is not a valid behavior. *) 59 59 - 60 60 - val to_json : t -> value 61 61 - (** [to_json t] converts a behavior to JSON. *) 62 62 - 63 63 - val of_json : value -> t 64 64 - (** [of_json json] parses a behavior from JSON. 65 65 - @raise Invalid_argument if the JSON is not a valid behavior. *) 66 66 - 53 53 + 67 54 val pp : Format.formatter -> t -> unit 68 55 (** [pp fmt t] pretty-prints the behavior. *) 56 56 + 57 57 + val jsont : t Jsont.t 58 58 + (** [jsont] is the Jsont codec for permission behaviors. *) 69 59 end 70 60 71 61 (** {1 Permission Rules} *) 72 62 73 63 module Rule : sig 74 64 (** Rules define specific permissions for tools. *) 75 75 - 65 65 + 66 66 + module Unknown : sig 67 67 + type t = Jsont.json 68 68 + val empty : t 69 69 + val is_empty : t -> bool 70 70 + val jsont : t Jsont.t 71 71 + end 72 72 + 76 73 type t = { 77 74 tool_name : string; (** Name of the tool *) 78 75 rule_content : string option; (** Optional rule specification *) 76 76 + unknown : Unknown.t; (** Unknown fields *) 79 77 } 80 78 (** The type of permission rules. *) 81 81 - 82 82 - val create : tool_name:string -> ?rule_content:string -> unit -> t 83 83 - (** [create ~tool_name ?rule_content ()] creates a new rule. 79 79 + 80 80 + val create : tool_name:string -> ?rule_content:string -> ?unknown:Unknown.t -> unit -> t 81 81 + (** [create ~tool_name ?rule_content ?unknown ()] creates a new rule. 84 82 @param tool_name The name of the tool this rule applies to 85 85 - @param rule_content Optional rule specification or pattern *) 86 86 - 83 83 + @param rule_content Optional rule specification or pattern 84 84 + @param unknown Optional unknown fields to preserve *) 85 85 + 87 86 val tool_name : t -> string 88 87 (** [tool_name t] returns the tool name. *) 89 89 - 88 88 + 90 89 val rule_content : t -> string option 91 90 (** [rule_content t] returns the optional rule content. *) 92 92 - 93 93 - val to_json : t -> value 94 94 - (** [to_json t] converts a rule to JSON. *) 95 95 - 96 96 - val of_json : value -> t 97 97 - (** [of_json json] parses a rule from JSON. 98 98 - @raise Invalid_argument if the JSON is not a valid rule. *) 99 99 - 91 91 + 92 92 + val unknown : t -> Unknown.t 93 93 + (** [unknown t] returns the unknown fields. *) 94 94 + 100 95 val pp : Format.formatter -> t -> unit 101 96 (** [pp fmt t] pretty-prints the rule. *) 97 97 + 98 98 + val jsont : t Jsont.t 99 99 + (** [jsont] is the Jsont codec for permission rules. *) 102 100 end 103 101 104 102 (** {1 Permission Updates} *) 105 103 106 104 module Update : sig 107 105 (** Updates modify permission settings. *) 108 108 - 109 109 - type destination = 106 106 + 107 107 + type destination = 110 108 | User_settings (** Apply to user settings *) 111 109 | Project_settings (** Apply to project settings *) 112 110 | Local_settings (** Apply to local settings *) 113 111 | Session (** Apply to current session only *) 114 112 (** The destination for permission updates. *) 115 115 - 113 113 + 116 114 type update_type = 117 115 | Add_rules (** Add new rules *) 118 116 | Replace_rules (** Replace existing rules *) ··· 121 119 | Add_directories (** Add allowed directories *) 122 120 | Remove_directories (** Remove allowed directories *) 123 121 (** The type of permission update. *) 124 124 - 122 122 + 123 123 + module Unknown : sig 124 124 + type t = Jsont.json 125 125 + val empty : t 126 126 + val is_empty : t -> bool 127 127 + val jsont : t Jsont.t 128 128 + end 129 129 + 125 130 type t 126 131 (** The type of permission updates. *) 127 127 - 128 128 - val create : 129 129 - update_type:update_type -> 130 130 - ?rules:Rule.t list -> 131 131 - ?behavior:Behavior.t -> 132 132 - ?mode:Mode.t -> 133 133 - ?directories:string list -> 134 134 - ?destination:destination -> 132 132 + 133 133 + val create : 134 134 + update_type:update_type -> 135 135 + ?rules:Rule.t list -> 136 136 + ?behavior:Behavior.t -> 137 137 + ?mode:Mode.t -> 138 138 + ?directories:string list -> 139 139 + ?destination:destination -> 140 140 + ?unknown:Unknown.t -> 135 141 unit -> t 136 136 - (** [create ~update_type ?rules ?behavior ?mode ?directories ?destination ()] 142 142 + (** [create ~update_type ?rules ?behavior ?mode ?directories ?destination ?unknown ()] 137 143 creates a new permission update. 138 144 @param update_type The type of update to perform 139 145 @param rules Optional list of rules to add/remove/replace 140 146 @param behavior Optional behavior to set 141 147 @param mode Optional permission mode to set 142 148 @param directories Optional directories to add/remove 143 143 - @param destination Optional destination for the update *) 144 144 - 149 149 + @param destination Optional destination for the update 150 150 + @param unknown Optional unknown fields to preserve *) 151 151 + 145 152 val update_type : t -> update_type 146 153 (** [update_type t] returns the update type. *) 147 147 - 154 154 + 148 155 val rules : t -> Rule.t list option 149 156 (** [rules t] returns the optional list of rules. *) 150 150 - 157 157 + 151 158 val behavior : t -> Behavior.t option 152 159 (** [behavior t] returns the optional behavior. *) 153 153 - 160 160 + 154 161 val mode : t -> Mode.t option 155 162 (** [mode t] returns the optional mode. *) 156 156 - 163 163 + 157 164 val directories : t -> string list option 158 165 (** [directories t] returns the optional list of directories. *) 159 159 - 166 166 + 160 167 val destination : t -> destination option 161 168 (** [destination t] returns the optional destination. *) 162 162 - 163 163 - val to_json : t -> value 164 164 - (** [to_json t] converts an update to JSON. *) 165 165 - 166 166 - val of_json : value -> t 167 167 - (** [of_json json] parses an update from JSON. 168 168 - @raise Invalid_argument if the JSON is not a valid update. *) 169 169 - 169 169 + 170 170 + val unknown : t -> Unknown.t 171 171 + (** [unknown t] returns the unknown fields. *) 172 172 + 170 173 val pp : Format.formatter -> t -> unit 171 174 (** [pp fmt t] pretty-prints the update. *) 175 175 + 176 176 + val jsont : t Jsont.t 177 177 + (** [jsont] is the Jsont codec for permission updates. *) 172 178 end 173 179 174 180 (** {1 Permission Context} *) 175 181 176 182 module Context : sig 177 183 (** Context provided to permission callbacks. *) 178 178 - 184 184 + 185 185 + module Unknown : sig 186 186 + type t = Jsont.json 187 187 + val empty : t 188 188 + val is_empty : t -> bool 189 189 + val jsont : t Jsont.t 190 190 + end 191 191 + 179 192 type t = { 180 193 suggestions : Update.t list; (** Suggested permission updates *) 194 194 + unknown : Unknown.t; (** Unknown fields *) 181 195 } 182 196 (** The type of permission context. *) 183 183 - 184 184 - val create : ?suggestions:Update.t list -> unit -> t 185 185 - (** [create ?suggestions ()] creates a new context. 186 186 - @param suggestions Optional list of suggested permission updates *) 187 187 - 197 197 + 198 198 + val create : ?suggestions:Update.t list -> ?unknown:Unknown.t -> unit -> t 199 199 + (** [create ?suggestions ?unknown ()] creates a new context. 200 200 + @param suggestions Optional list of suggested permission updates 201 201 + @param unknown Optional unknown fields to preserve *) 202 202 + 188 203 val suggestions : t -> Update.t list 189 204 (** [suggestions t] returns the list of suggested updates. *) 190 190 - 191 191 - val to_json : t -> value 192 192 - (** [to_json t] converts a context to JSON. *) 193 193 - 194 194 - val of_json : value -> t 195 195 - (** [of_json json] parses a context from JSON. 196 196 - @raise Invalid_argument if the JSON is not a valid context. *) 197 197 - 205 205 + 206 206 + val unknown : t -> Unknown.t 207 207 + (** [unknown t] returns the unknown fields. *) 208 208 + 198 209 val pp : Format.formatter -> t -> unit 199 210 (** [pp fmt t] pretty-prints the context. *) 211 211 + 212 212 + val jsont : t Jsont.t 213 213 + (** [jsont] is the Jsont codec for permission context. *) 200 214 end 201 215 202 216 (** {1 Permission Results} *) 203 217 204 218 module Result : sig 205 219 (** Results of permission checks. *) 206 206 - 220 220 + 221 221 + module Unknown : sig 222 222 + type t = Jsont.json 223 223 + val empty : t 224 224 + val is_empty : t -> bool 225 225 + val jsont : t Jsont.t 226 226 + end 227 227 + 207 228 type t = 208 229 | Allow of { 209 209 - updated_input : value option; (** Modified tool input *) 230 230 + updated_input : Jsont.json option; (** Modified tool input *) 210 231 updated_permissions : Update.t list option; (** Permission updates to apply *) 232 232 + unknown : Unknown.t; (** Unknown fields *) 211 233 } 212 234 | Deny of { 213 235 message : string; (** Reason for denial *) 214 236 interrupt : bool; (** Whether to interrupt execution *) 237 237 + unknown : Unknown.t; (** Unknown fields *) 215 238 } 216 239 (** The type of permission results. *) 217 217 - 218 218 - val allow : ?updated_input:value -> ?updated_permissions:Update.t list -> unit -> t 219 219 - (** [allow ?updated_input ?updated_permissions ()] creates an allow result. 240 240 + 241 241 + val allow : ?updated_input:Jsont.json -> ?updated_permissions:Update.t list -> ?unknown:Unknown.t -> unit -> t 242 242 + (** [allow ?updated_input ?updated_permissions ?unknown ()] creates an allow result. 220 243 @param updated_input Optional modified tool input 221 221 - @param updated_permissions Optional permission updates to apply *) 222 222 - 223 223 - val deny : message:string -> interrupt:bool -> t 224 224 - (** [deny ~message ~interrupt] creates a deny result. 244 244 + @param updated_permissions Optional permission updates to apply 245 245 + @param unknown Optional unknown fields to preserve *) 246 246 + 247 247 + val deny : message:string -> interrupt:bool -> ?unknown:Unknown.t -> unit -> t 248 248 + (** [deny ~message ~interrupt ?unknown ()] creates a deny result. 225 249 @param message The reason for denying permission 226 226 - @param interrupt Whether to interrupt further execution *) 227 227 - 228 228 - val to_json : t -> value 229 229 - (** [to_json t] converts a result to JSON. *) 230 230 - 231 231 - val of_json : value -> t 232 232 - (** [of_json json] parses a result from JSON. 233 233 - @raise Invalid_argument if the JSON is not a valid result. *) 234 234 - 250 250 + @param interrupt Whether to interrupt further execution 251 251 + @param unknown Optional unknown fields to preserve *) 252 252 + 235 253 val pp : Format.formatter -> t -> unit 236 254 (** [pp fmt t] pretty-prints the result. *) 255 255 + 256 256 + val jsont : t Jsont.t 257 257 + (** [jsont] is the Jsont codec for permission results. *) 237 258 end 238 259 239 260 (** {1 Permission Callbacks} *) 240 261 241 241 - type callback = 242 242 - tool_name:string -> 243 243 - input:value -> 244 244 - context:Context.t -> 262 262 + type callback = 263 263 + tool_name:string -> 264 264 + input:Jsont.json -> 265 265 + context:Context.t -> 245 266 Result.t 246 267 (** The type of permission callbacks. Callbacks are invoked when Claude 247 268 attempts to use a tool, allowing custom permission logic. *)

+288 -256

claudeio/lib/sdk_control.ml

reviewed

··· 1 1 - open Ezjsonm 2 2 - 3 1 let src = Logs.Src.create "claude.sdk_control" ~doc:"Claude SDK control protocol" 4 2 module Log = (val Logs.src_log src : Logs.LOG) 5 3 6 6 - module JU = Json_utils 4 4 + module Request = struct 5 5 + module Unknown = struct 6 6 + type t = Jsont.json 7 7 + let empty = Jsont.Object ([], Jsont.Meta.none) 8 8 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 9 9 + let jsont = Jsont.json 10 10 + end 7 11 8 8 - module Request = struct 9 12 type interrupt = { 10 13 subtype : [`Interrupt]; 14 14 + unknown : Unknown.t; 11 15 } 12 12 - 16 16 + 13 17 type permission = { 14 18 subtype : [`Can_use_tool]; 15 19 tool_name : string; 16 16 - input : value; 20 20 + input : Jsont.json; 17 21 permission_suggestions : Permissions.Update.t list option; 18 22 blocked_path : string option; 23 23 + unknown : Unknown.t; 19 24 } 20 20 - 25 25 + 21 26 type initialize = { 22 27 subtype : [`Initialize]; 23 23 - hooks : (string * value) list option; 28 28 + hooks : (string * Jsont.json) list option; 29 29 + unknown : Unknown.t; 24 30 } 25 25 - 31 31 + 26 32 type set_permission_mode = { 27 33 subtype : [`Set_permission_mode]; 28 34 mode : Permissions.Mode.t; 35 35 + unknown : Unknown.t; 29 36 } 30 30 - 37 37 + 31 38 type hook_callback = { 32 39 subtype : [`Hook_callback]; 33 40 callback_id : string; 34 34 - input : value; 41 41 + input : Jsont.json; 35 42 tool_use_id : string option; 43 43 + unknown : Unknown.t; 36 44 } 37 37 - 45 45 + 38 46 type mcp_message = { 39 47 subtype : [`Mcp_message]; 40 48 server_name : string; 41 41 - message : value; 49 49 + message : Jsont.json; 50 50 + unknown : Unknown.t; 42 51 } 43 52 44 53 type set_model = { 45 54 subtype : [`Set_model]; 46 55 model : string; 56 56 + unknown : Unknown.t; 47 57 } 48 58 49 59 type get_server_info = { 50 60 subtype : [`Get_server_info]; 61 61 + unknown : Unknown.t; 51 62 } 52 63 53 64 type t = ··· 60 71 | Set_model of set_model 61 72 | Get_server_info of get_server_info 62 73 63 63 - let interrupt () = Interrupt { subtype = `Interrupt } 64 64 - 65 65 - let permission ~tool_name ~input ?permission_suggestions ?blocked_path () = 74 74 + let interrupt ?(unknown = Unknown.empty) () = 75 75 + Interrupt { subtype = `Interrupt; unknown } 76 76 + 77 77 + let permission ~tool_name ~input ?permission_suggestions ?blocked_path ?(unknown = Unknown.empty) () = 66 78 Permission { 67 79 subtype = `Can_use_tool; 68 80 tool_name; 69 81 input; 70 82 permission_suggestions; 71 83 blocked_path; 84 84 + unknown; 72 85 } 73 73 - 74 74 - let initialize ?hooks () = 75 75 - Initialize { subtype = `Initialize; hooks } 76 76 - 77 77 - let set_permission_mode ~mode = 78 78 - Set_permission_mode { subtype = `Set_permission_mode; mode } 79 79 - 80 80 - let hook_callback ~callback_id ~input ?tool_use_id () = 86 86 + 87 87 + let initialize ?hooks ?(unknown = Unknown.empty) () = 88 88 + Initialize { subtype = `Initialize; hooks; unknown } 89 89 + 90 90 + let set_permission_mode ~mode ?(unknown = Unknown.empty) () = 91 91 + Set_permission_mode { subtype = `Set_permission_mode; mode; unknown } 92 92 + 93 93 + let hook_callback ~callback_id ~input ?tool_use_id ?(unknown = Unknown.empty) () = 81 94 Hook_callback { 82 95 subtype = `Hook_callback; 83 96 callback_id; 84 97 input; 85 98 tool_use_id; 99 99 + unknown; 86 100 } 87 87 - 88 88 - let mcp_message ~server_name ~message = 101 101 + 102 102 + let mcp_message ~server_name ~message ?(unknown = Unknown.empty) () = 89 103 Mcp_message { 90 104 subtype = `Mcp_message; 91 105 server_name; 92 106 message; 107 107 + unknown; 93 108 } 94 109 95 95 - let set_model ~model = 96 96 - Set_model { subtype = `Set_model; model } 110 110 + let set_model ~model ?(unknown = Unknown.empty) () = 111 111 + Set_model { subtype = `Set_model; model; unknown } 97 112 98 98 - let get_server_info () = 99 99 - Get_server_info { subtype = `Get_server_info } 113 113 + let get_server_info ?(unknown = Unknown.empty) () = 114 114 + Get_server_info { subtype = `Get_server_info; unknown } 100 115 101 101 - let to_json = function 102 102 - | Interrupt _ -> 103 103 - `O [("subtype", `String "interrupt")] 104 104 - | Permission p -> 105 105 - let fields = [ 106 106 - ("subtype", `String "can_use_tool"); 107 107 - ("tool_name", `String p.tool_name); 108 108 - ("input", p.input); 109 109 - ] in 110 110 - let fields = match p.permission_suggestions with 111 111 - | Some suggestions -> 112 112 - ("permission_suggestions", 113 113 - `A (List.map Permissions.Update.to_json suggestions)) :: fields 114 114 - | None -> fields 115 115 - in 116 116 - let fields = match p.blocked_path with 117 117 - | Some path -> ("blocked_path", `String path) :: fields 118 118 - | None -> fields 119 119 - in 120 120 - `O fields 121 121 - | Initialize i -> 122 122 - let fields = [("subtype", `String "initialize")] in 123 123 - let fields = match i.hooks with 124 124 - | Some hooks -> 125 125 - ("hooks", `O hooks) :: fields 126 126 - | None -> fields 127 127 - in 128 128 - `O fields 129 129 - | Set_permission_mode s -> 130 130 - `O [ 131 131 - ("subtype", `String "set_permission_mode"); 132 132 - ("mode", Permissions.Mode.to_json s.mode); 133 133 - ] 134 134 - | Hook_callback h -> 135 135 - let fields = [ 136 136 - ("subtype", `String "hook_callback"); 137 137 - ("callback_id", `String h.callback_id); 138 138 - ("input", h.input); 139 139 - ] in 140 140 - let fields = match h.tool_use_id with 141 141 - | Some id -> ("tool_use_id", `String id) :: fields 142 142 - | None -> fields 143 143 - in 144 144 - `O fields 145 145 - | Mcp_message m -> 146 146 - `O [ 147 147 - ("subtype", `String "mcp_message"); 148 148 - ("server_name", `String m.server_name); 149 149 - ("message", m.message); 150 150 - ] 151 151 - | Set_model s -> 152 152 - `O [ 153 153 - ("subtype", `String "set_model"); 154 154 - ("model", `String s.model); 155 155 - ] 156 156 - | Get_server_info _ -> 157 157 - `O [("subtype", `String "get_server_info")] 116 116 + (* Individual record codecs *) 117 117 + let interrupt_jsont : interrupt Jsont.t = 118 118 + let make (unknown : Unknown.t) : interrupt = { subtype = `Interrupt; unknown } in 119 119 + Jsont.Object.map ~kind:"Interrupt" make 120 120 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : interrupt) -> r.unknown) 121 121 + |> Jsont.Object.finish 158 122 159 159 - let of_json = function 160 160 - | `O fields -> 161 161 - let subtype = JU.assoc_string "subtype" fields in 162 162 - (match subtype with 163 163 - | "interrupt" -> 164 164 - Interrupt { subtype = `Interrupt } 165 165 - | "can_use_tool" -> 166 166 - let tool_name = JU.assoc_string "tool_name" fields in 167 167 - let input = List.assoc "input" fields in 168 168 - let permission_suggestions = 169 169 - match List.assoc_opt "permission_suggestions" fields with 170 170 - | Some (`A lst) -> 171 171 - Some (List.map Permissions.Update.of_json lst) 172 172 - | _ -> None 173 173 - in 174 174 - let blocked_path = JU.assoc_string_opt "blocked_path" fields in 175 175 - Permission { 176 176 - subtype = `Can_use_tool; 177 177 - tool_name; 178 178 - input; 179 179 - permission_suggestions; 180 180 - blocked_path; 181 181 - } 182 182 - | "initialize" -> 183 183 - let hooks = 184 184 - match List.assoc_opt "hooks" fields with 185 185 - | Some (`O hooks) -> Some hooks 186 186 - | _ -> None 187 187 - in 188 188 - Initialize { subtype = `Initialize; hooks } 189 189 - | "set_permission_mode" -> 190 190 - let mode = List.assoc "mode" fields |> Permissions.Mode.of_json in 191 191 - Set_permission_mode { subtype = `Set_permission_mode; mode } 192 192 - | "hook_callback" -> 193 193 - let callback_id = JU.assoc_string "callback_id" fields in 194 194 - let input = List.assoc "input" fields in 195 195 - let tool_use_id = JU.assoc_string_opt "tool_use_id" fields in 196 196 - Hook_callback { 197 197 - subtype = `Hook_callback; 198 198 - callback_id; 199 199 - input; 200 200 - tool_use_id; 201 201 - } 202 202 - | "mcp_message" -> 203 203 - let server_name = JU.assoc_string "server_name" fields in 204 204 - let message = List.assoc "message" fields in 205 205 - Mcp_message { 206 206 - subtype = `Mcp_message; 207 207 - server_name; 208 208 - message; 209 209 - } 210 210 - | "set_model" -> 211 211 - let model = JU.assoc_string "model" fields in 212 212 - Set_model { subtype = `Set_model; model } 213 213 - | "get_server_info" -> 214 214 - Get_server_info { subtype = `Get_server_info } 215 215 - | _ -> raise (Invalid_argument ("Unknown request subtype: " ^ subtype))) 216 216 - | _ -> raise (Invalid_argument "Request.of_json: expected object") 123 123 + let permission_jsont : permission Jsont.t = 124 124 + let make tool_name input permission_suggestions blocked_path (unknown : Unknown.t) : permission = 125 125 + { subtype = `Can_use_tool; tool_name; input; permission_suggestions; blocked_path; unknown } 126 126 + in 127 127 + Jsont.Object.map ~kind:"Permission" make 128 128 + |> Jsont.Object.mem "tool_name" Jsont.string ~enc:(fun (r : permission) -> r.tool_name) 129 129 + |> Jsont.Object.mem "input" Jsont.json ~enc:(fun (r : permission) -> r.input) 130 130 + |> Jsont.Object.opt_mem "permission_suggestions" (Jsont.list Permissions.Update.jsont) ~enc:(fun (r : permission) -> r.permission_suggestions) 131 131 + |> Jsont.Object.opt_mem "blocked_path" Jsont.string ~enc:(fun (r : permission) -> r.blocked_path) 132 132 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : permission) -> r.unknown) 133 133 + |> Jsont.Object.finish 134 134 + 135 135 + let initialize_jsont : initialize Jsont.t = 136 136 + (* The hooks field is an object with string keys and json values *) 137 137 + let hooks_map_jsont = Jsont.Object.as_string_map Jsont.json in 138 138 + let module StringMap = Map.Make(String) in 139 139 + let hooks_jsont = Jsont.map 140 140 + ~dec:(fun m -> StringMap.bindings m) 141 141 + ~enc:(fun l -> StringMap.of_seq (List.to_seq l)) 142 142 + hooks_map_jsont 143 143 + in 144 144 + let make hooks (unknown : Unknown.t) : initialize = { subtype = `Initialize; hooks; unknown } in 145 145 + Jsont.Object.map ~kind:"Initialize" make 146 146 + |> Jsont.Object.opt_mem "hooks" hooks_jsont ~enc:(fun (r : initialize) -> r.hooks) 147 147 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : initialize) -> r.unknown) 148 148 + |> Jsont.Object.finish 149 149 + 150 150 + let set_permission_mode_jsont : set_permission_mode Jsont.t = 151 151 + let make mode (unknown : Unknown.t) : set_permission_mode = { subtype = `Set_permission_mode; mode; unknown } in 152 152 + Jsont.Object.map ~kind:"SetPermissionMode" make 153 153 + |> Jsont.Object.mem "mode" Permissions.Mode.jsont ~enc:(fun (r : set_permission_mode) -> r.mode) 154 154 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : set_permission_mode) -> r.unknown) 155 155 + |> Jsont.Object.finish 156 156 + 157 157 + let hook_callback_jsont : hook_callback Jsont.t = 158 158 + let make callback_id input tool_use_id (unknown : Unknown.t) : hook_callback = 159 159 + { subtype = `Hook_callback; callback_id; input; tool_use_id; unknown } 160 160 + in 161 161 + Jsont.Object.map ~kind:"HookCallback" make 162 162 + |> Jsont.Object.mem "callback_id" Jsont.string ~enc:(fun (r : hook_callback) -> r.callback_id) 163 163 + |> Jsont.Object.mem "input" Jsont.json ~enc:(fun (r : hook_callback) -> r.input) 164 164 + |> Jsont.Object.opt_mem "tool_use_id" Jsont.string ~enc:(fun (r : hook_callback) -> r.tool_use_id) 165 165 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : hook_callback) -> r.unknown) 166 166 + |> Jsont.Object.finish 167 167 + 168 168 + let mcp_message_jsont : mcp_message Jsont.t = 169 169 + let make server_name message (unknown : Unknown.t) : mcp_message = 170 170 + { subtype = `Mcp_message; server_name; message; unknown } 171 171 + in 172 172 + Jsont.Object.map ~kind:"McpMessage" make 173 173 + |> Jsont.Object.mem "server_name" Jsont.string ~enc:(fun (r : mcp_message) -> r.server_name) 174 174 + |> Jsont.Object.mem "message" Jsont.json ~enc:(fun (r : mcp_message) -> r.message) 175 175 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : mcp_message) -> r.unknown) 176 176 + |> Jsont.Object.finish 177 177 + 178 178 + let set_model_jsont : set_model Jsont.t = 179 179 + let make model (unknown : Unknown.t) : set_model = { subtype = `Set_model; model; unknown } in 180 180 + Jsont.Object.map ~kind:"SetModel" make 181 181 + |> Jsont.Object.mem "model" Jsont.string ~enc:(fun (r : set_model) -> r.model) 182 182 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : set_model) -> r.unknown) 183 183 + |> Jsont.Object.finish 184 184 + 185 185 + let get_server_info_jsont : get_server_info Jsont.t = 186 186 + let make (unknown : Unknown.t) : get_server_info = { subtype = `Get_server_info; unknown } in 187 187 + Jsont.Object.map ~kind:"GetServerInfo" make 188 188 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : get_server_info) -> r.unknown) 189 189 + |> Jsont.Object.finish 190 190 + 191 191 + (* Main variant codec using subtype discriminator *) 192 192 + let jsont : t Jsont.t = 193 193 + let case_interrupt = Jsont.Object.Case.map "interrupt" interrupt_jsont ~dec:(fun v -> Interrupt v) in 194 194 + let case_permission = Jsont.Object.Case.map "can_use_tool" permission_jsont ~dec:(fun v -> Permission v) in 195 195 + let case_initialize = Jsont.Object.Case.map "initialize" initialize_jsont ~dec:(fun v -> Initialize v) in 196 196 + let case_set_permission_mode = Jsont.Object.Case.map "set_permission_mode" set_permission_mode_jsont ~dec:(fun v -> Set_permission_mode v) in 197 197 + let case_hook_callback = Jsont.Object.Case.map "hook_callback" hook_callback_jsont ~dec:(fun v -> Hook_callback v) in 198 198 + let case_mcp_message = Jsont.Object.Case.map "mcp_message" mcp_message_jsont ~dec:(fun v -> Mcp_message v) in 199 199 + let case_set_model = Jsont.Object.Case.map "set_model" set_model_jsont ~dec:(fun v -> Set_model v) in 200 200 + let case_get_server_info = Jsont.Object.Case.map "get_server_info" get_server_info_jsont ~dec:(fun v -> Get_server_info v) in 201 201 + 202 202 + let enc_case = function 203 203 + | Interrupt v -> Jsont.Object.Case.value case_interrupt v 204 204 + | Permission v -> Jsont.Object.Case.value case_permission v 205 205 + | Initialize v -> Jsont.Object.Case.value case_initialize v 206 206 + | Set_permission_mode v -> Jsont.Object.Case.value case_set_permission_mode v 207 207 + | Hook_callback v -> Jsont.Object.Case.value case_hook_callback v 208 208 + | Mcp_message v -> Jsont.Object.Case.value case_mcp_message v 209 209 + | Set_model v -> Jsont.Object.Case.value case_set_model v 210 210 + | Get_server_info v -> Jsont.Object.Case.value case_get_server_info v 211 211 + in 212 212 + 213 213 + let cases = Jsont.Object.Case.[ 214 214 + make case_interrupt; 215 215 + make case_permission; 216 216 + make case_initialize; 217 217 + make case_set_permission_mode; 218 218 + make case_hook_callback; 219 219 + make case_mcp_message; 220 220 + make case_set_model; 221 221 + make case_get_server_info; 222 222 + ] in 223 223 + 224 224 + Jsont.Object.map ~kind:"Request" Fun.id 225 225 + |> Jsont.Object.case_mem "subtype" Jsont.string ~enc:Fun.id ~enc_case cases 226 226 + ~tag_to_string:Fun.id ~tag_compare:String.compare 227 227 + |> Jsont.Object.finish 217 228 218 229 let pp fmt = function 219 230 | Interrupt _ -> ··· 240 251 end 241 252 242 253 module Response = struct 254 254 + module Unknown = struct 255 255 + type t = Jsont.json 256 256 + let empty = Jsont.Object ([], Jsont.Meta.none) 257 257 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 258 258 + let jsont = Jsont.json 259 259 + end 260 260 + 243 261 type success = { 244 262 subtype : [`Success]; 245 263 request_id : string; 246 246 - response : value option; 264 264 + response : Jsont.json option; 265 265 + unknown : Unknown.t; 247 266 } 248 248 - 267 267 + 249 268 type error = { 250 269 subtype : [`Error]; 251 270 request_id : string; 252 271 error : string; 272 272 + unknown : Unknown.t; 253 273 } 254 254 - 274 274 + 255 275 type t = 256 276 | Success of success 257 277 | Error of error 258 258 - 259 259 - let success ~request_id ?response () = 278 278 + 279 279 + let success ~request_id ?response ?(unknown = Unknown.empty) () = 260 280 Success { 261 281 subtype = `Success; 262 282 request_id; 263 283 response; 284 284 + unknown; 264 285 } 265 265 - 266 266 - let error ~request_id ~error = 286 286 + 287 287 + let error ~request_id ~error ?(unknown = Unknown.empty) () = 267 288 Error { 268 289 subtype = `Error; 269 290 request_id; 270 291 error; 292 292 + unknown; 271 293 } 272 272 - 273 273 - let to_json = function 274 274 - | Success s -> 275 275 - let fields = [ 276 276 - ("subtype", `String "success"); 277 277 - ("request_id", `String s.request_id); 278 278 - ] in 279 279 - let fields = match s.response with 280 280 - | Some resp -> ("response", resp) :: fields 281 281 - | None -> fields 282 282 - in 283 283 - `O fields 284 284 - | Error e -> 285 285 - `O [ 286 286 - ("subtype", `String "error"); 287 287 - ("request_id", `String e.request_id); 288 288 - ("error", `String e.error); 289 289 - ] 290 290 - 291 291 - let of_json = function 292 292 - | `O fields -> 293 293 - let subtype = JU.assoc_string "subtype" fields in 294 294 - let request_id = JU.assoc_string "request_id" fields in 295 295 - (match subtype with 296 296 - | "success" -> 297 297 - let response = List.assoc_opt "response" fields in 298 298 - Success { 299 299 - subtype = `Success; 300 300 - request_id; 301 301 - response; 302 302 - } 303 303 - | "error" -> 304 304 - let error = JU.assoc_string "error" fields in 305 305 - Error { 306 306 - subtype = `Error; 307 307 - request_id; 308 308 - error; 309 309 - } 310 310 - | _ -> raise (Invalid_argument ("Unknown response subtype: " ^ subtype))) 311 311 - | _ -> raise (Invalid_argument "Response.of_json: expected object") 294 294 + 295 295 + (* Individual record codecs *) 296 296 + let success_jsont : success Jsont.t = 297 297 + let make request_id response (unknown : Unknown.t) : success = 298 298 + { subtype = `Success; request_id; response; unknown } 299 299 + in 300 300 + Jsont.Object.map ~kind:"Success" make 301 301 + |> Jsont.Object.mem "request_id" Jsont.string ~enc:(fun (r : success) -> r.request_id) 302 302 + |> Jsont.Object.opt_mem "response" Jsont.json ~enc:(fun (r : success) -> r.response) 303 303 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : success) -> r.unknown) 304 304 + |> Jsont.Object.finish 305 305 + 306 306 + let error_jsont : error Jsont.t = 307 307 + let make request_id error (unknown : Unknown.t) : error = 308 308 + { subtype = `Error; request_id; error; unknown } 309 309 + in 310 310 + Jsont.Object.map ~kind:"Error" make 311 311 + |> Jsont.Object.mem "request_id" Jsont.string ~enc:(fun (r : error) -> r.request_id) 312 312 + |> Jsont.Object.mem "error" Jsont.string ~enc:(fun (r : error) -> r.error) 313 313 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : error) -> r.unknown) 314 314 + |> Jsont.Object.finish 315 315 + 316 316 + (* Main variant codec using subtype discriminator *) 317 317 + let jsont : t Jsont.t = 318 318 + let case_success = Jsont.Object.Case.map "success" success_jsont ~dec:(fun v -> Success v) in 319 319 + let case_error = Jsont.Object.Case.map "error" error_jsont ~dec:(fun v -> Error v) in 320 320 + 321 321 + let enc_case = function 322 322 + | Success v -> Jsont.Object.Case.value case_success v 323 323 + | Error v -> Jsont.Object.Case.value case_error v 324 324 + in 325 325 + 326 326 + let cases = Jsont.Object.Case.[ 327 327 + make case_success; 328 328 + make case_error; 329 329 + ] in 330 330 + 331 331 + Jsont.Object.map ~kind:"Response" Fun.id 332 332 + |> Jsont.Object.case_mem "subtype" Jsont.string ~enc:Fun.id ~enc_case cases 333 333 + ~tag_to_string:Fun.id ~tag_compare:String.compare 334 334 + |> Jsont.Object.finish 312 335 313 336 let pp fmt = function 314 337 | Success s -> ··· 319 342 e.request_id e.error 320 343 end 321 344 345 345 + module Unknown = struct 346 346 + type t = Jsont.json 347 347 + let empty = Jsont.Object ([], Jsont.Meta.none) 348 348 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 349 349 + let jsont = Jsont.json 350 350 + end 351 351 + 322 352 type control_request = { 323 353 type_ : [`Control_request]; 324 354 request_id : string; 325 355 request : Request.t; 356 356 + unknown : Unknown.t; 326 357 } 327 358 328 359 type control_response = { 329 360 type_ : [`Control_response]; 330 361 response : Response.t; 362 362 + unknown : Unknown.t; 331 363 } 332 364 333 365 type t = 334 366 | Request of control_request 335 367 | Response of control_response 336 368 337 337 - let create_request ~request_id ~request = 369 369 + let create_request ~request_id ~request ?(unknown = Unknown.empty) () = 338 370 Request { 339 371 type_ = `Control_request; 340 372 request_id; 341 373 request; 374 374 + unknown; 342 375 } 343 376 344 344 - let create_response ~response = 377 377 + let create_response ~response ?(unknown = Unknown.empty) () = 345 378 Response { 346 379 type_ = `Control_response; 347 380 response; 381 381 + unknown; 348 382 } 349 383 350 350 - let to_json = function 351 351 - | Request r -> 352 352 - `O [ 353 353 - ("type", `String "control_request"); 354 354 - ("request_id", `String r.request_id); 355 355 - ("request", Request.to_json r.request); 356 356 - ] 357 357 - | Response r -> 358 358 - `O [ 359 359 - ("type", `String "control_response"); 360 360 - ("response", Response.to_json r.response); 361 361 - ] 384 384 + (* Individual record codecs *) 385 385 + let control_request_jsont : control_request Jsont.t = 386 386 + let make request_id request (unknown : Unknown.t) : control_request = 387 387 + { type_ = `Control_request; request_id; request; unknown } 388 388 + in 389 389 + Jsont.Object.map ~kind:"ControlRequest" make 390 390 + |> Jsont.Object.mem "request_id" Jsont.string ~enc:(fun (r : control_request) -> r.request_id) 391 391 + |> Jsont.Object.mem "request" Request.jsont ~enc:(fun (r : control_request) -> r.request) 392 392 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : control_request) -> r.unknown) 393 393 + |> Jsont.Object.finish 362 394 363 363 - let of_json = function 364 364 - | `O fields -> 365 365 - let type_ = JU.assoc_string "type" fields in 366 366 - (match type_ with 367 367 - | "control_request" -> 368 368 - let request_id = JU.assoc_string "request_id" fields in 369 369 - let request = List.assoc "request" fields |> Request.of_json in 370 370 - Request { 371 371 - type_ = `Control_request; 372 372 - request_id; 373 373 - request; 374 374 - } 375 375 - | "control_response" -> 376 376 - let response = List.assoc "response" fields |> Response.of_json in 377 377 - Response { 378 378 - type_ = `Control_response; 379 379 - response; 380 380 - } 381 381 - | _ -> raise (Invalid_argument ("Unknown control type: " ^ type_))) 382 382 - | _ -> raise (Invalid_argument "of_json: expected object") 395 395 + let control_response_jsont : control_response Jsont.t = 396 396 + let make response (unknown : Unknown.t) : control_response = 397 397 + { type_ = `Control_response; response; unknown } 398 398 + in 399 399 + Jsont.Object.map ~kind:"ControlResponse" make 400 400 + |> Jsont.Object.mem "response" Response.jsont ~enc:(fun (r : control_response) -> r.response) 401 401 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : control_response) -> r.unknown) 402 402 + |> Jsont.Object.finish 403 403 + 404 404 + (* Main variant codec using type discriminator *) 405 405 + let jsont : t Jsont.t = 406 406 + let case_request = Jsont.Object.Case.map "control_request" control_request_jsont ~dec:(fun v -> Request v) in 407 407 + let case_response = Jsont.Object.Case.map "control_response" control_response_jsont ~dec:(fun v -> Response v) in 408 408 + 409 409 + let enc_case = function 410 410 + | Request v -> Jsont.Object.Case.value case_request v 411 411 + | Response v -> Jsont.Object.Case.value case_response v 412 412 + in 413 413 + 414 414 + let cases = Jsont.Object.Case.[ 415 415 + make case_request; 416 416 + make case_response; 417 417 + ] in 418 418 + 419 419 + Jsont.Object.map ~kind:"Control" Fun.id 420 420 + |> Jsont.Object.case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases 421 421 + ~tag_to_string:Fun.id ~tag_compare:String.compare 422 422 + |> Jsont.Object.finish 383 423 384 424 let pp fmt = function 385 425 | Request r -> ··· 397 437 398 438 (** Server information *) 399 439 module Server_info = struct 440 440 + module Unknown = struct 441 441 + type t = Jsont.json 442 442 + let empty = Jsont.Object ([], Jsont.Meta.none) 443 443 + let is_empty = function Jsont.Object ([], _) -> true | _ -> false 444 444 + let jsont = Jsont.json 445 445 + end 446 446 + 400 447 type t = { 401 448 version : string; 402 449 capabilities : string list; 403 450 commands : string list; 404 451 output_styles : string list; 452 452 + unknown : Unknown.t; 405 453 } 406 454 407 407 - let create ~version ~capabilities ~commands ~output_styles = 408 408 - { version; capabilities; commands; output_styles } 455 455 + let create ~version ~capabilities ~commands ~output_styles ?(unknown = Unknown.empty) () = 456 456 + { version; capabilities; commands; output_styles; unknown } 409 457 410 458 let version t = t.version 411 459 let capabilities t = t.capabilities 412 460 let commands t = t.commands 413 461 let output_styles t = t.output_styles 414 414 - 415 415 - let of_json = function 416 416 - | `O fields -> 417 417 - let version = JU.assoc_string "version" fields in 418 418 - let capabilities = 419 419 - match List.assoc_opt "capabilities" fields with 420 420 - | Some (`A lst) -> List.map Ezjsonm.get_string lst 421 421 - | _ -> [] 422 422 - in 423 423 - let commands = 424 424 - match List.assoc_opt "commands" fields with 425 425 - | Some (`A lst) -> List.map Ezjsonm.get_string lst 426 426 - | _ -> [] 427 427 - in 428 428 - let output_styles = 429 429 - match List.assoc_opt "outputStyles" fields with 430 430 - | Some (`A lst) -> List.map Ezjsonm.get_string lst 431 431 - | _ -> [] 432 432 - in 433 433 - { version; capabilities; commands; output_styles } 434 434 - | _ -> raise (Invalid_argument "Server_info.of_json: expected object") 462 462 + let unknown t = t.unknown 435 463 436 436 - let to_json t = 437 437 - `O [ 438 438 - ("version", `String t.version); 439 439 - ("capabilities", `A (List.map (fun s -> `String s) t.capabilities)); 440 440 - ("commands", `A (List.map (fun s -> `String s) t.commands)); 441 441 - ("outputStyles", `A (List.map (fun s -> `String s) t.output_styles)); 442 442 - ] 464 464 + let jsont : t Jsont.t = 465 465 + let make version capabilities commands output_styles (unknown : Unknown.t) : t = 466 466 + { version; capabilities; commands; output_styles; unknown } 467 467 + in 468 468 + Jsont.Object.map ~kind:"ServerInfo" make 469 469 + |> Jsont.Object.mem "version" Jsont.string ~enc:(fun (r : t) -> r.version) 470 470 + |> Jsont.Object.mem "capabilities" (Jsont.list Jsont.string) ~enc:(fun (r : t) -> r.capabilities) ~dec_absent:[] 471 471 + |> Jsont.Object.mem "commands" (Jsont.list Jsont.string) ~enc:(fun (r : t) -> r.commands) ~dec_absent:[] 472 472 + |> Jsont.Object.mem "outputStyles" (Jsont.list Jsont.string) ~enc:(fun (r : t) -> r.output_styles) ~dec_absent:[] 473 473 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : t) -> r.unknown) 474 474 + |> Jsont.Object.finish 443 475 444 476 let pp fmt t = 445 477 Fmt.pf fmt "@[<2>ServerInfo@ { version = %S;@ capabilities = [%a];@ commands = [%a];@ output_styles = [%a] }@]"

+117 -82

claudeio/lib/sdk_control.mli

reviewed

··· 51 51 See {!Client.set_permission_mode}, {!Client.set_model}, and 52 52 {!Client.get_server_info} for high-level APIs that use this protocol. *) 53 53 54 54 - open Ezjsonm 55 55 - 56 54 (** The log source for SDK control operations *) 57 55 val src : Logs.Src.t 58 56 ··· 60 58 61 59 module Request : sig 62 60 (** SDK control request types. *) 63 63 - 61 61 + 62 62 + module Unknown : sig 63 63 + type t = Jsont.json 64 64 + val empty : t 65 65 + val is_empty : t -> bool 66 66 + val jsont : t Jsont.t 67 67 + end 68 68 + 64 69 type interrupt = { 65 70 subtype : [`Interrupt]; 71 71 + unknown : Unknown.t; 66 72 } 67 73 (** Interrupt request to stop execution. *) 68 68 - 74 74 + 69 75 type permission = { 70 76 subtype : [`Can_use_tool]; 71 77 tool_name : string; 72 72 - input : value; 78 78 + input : Jsont.json; 73 79 permission_suggestions : Permissions.Update.t list option; 74 80 blocked_path : string option; 81 81 + unknown : Unknown.t; 75 82 } 76 83 (** Permission request for tool usage. *) 77 77 - 84 84 + 78 85 type initialize = { 79 86 subtype : [`Initialize]; 80 80 - hooks : (string * value) list option; (* Hook event to configuration *) 87 87 + hooks : (string * Jsont.json) list option; (* Hook event to configuration *) 88 88 + unknown : Unknown.t; 81 89 } 82 90 (** Initialize request with optional hook configuration. *) 83 83 - 91 91 + 84 92 type set_permission_mode = { 85 93 subtype : [`Set_permission_mode]; 86 94 mode : Permissions.Mode.t; 95 95 + unknown : Unknown.t; 87 96 } 88 97 (** Request to change permission mode. *) 89 89 - 98 98 + 90 99 type hook_callback = { 91 100 subtype : [`Hook_callback]; 92 101 callback_id : string; 93 93 - input : value; 102 102 + input : Jsont.json; 94 103 tool_use_id : string option; 104 104 + unknown : Unknown.t; 95 105 } 96 106 (** Hook callback request. *) 97 97 - 107 107 + 98 108 type mcp_message = { 99 109 subtype : [`Mcp_message]; 100 110 server_name : string; 101 101 - message : value; 111 111 + message : Jsont.json; 112 112 + unknown : Unknown.t; 102 113 } 103 114 (** MCP server message request. *) 104 115 105 116 type set_model = { 106 117 subtype : [`Set_model]; 107 118 model : string; 119 119 + unknown : Unknown.t; 108 120 } 109 121 (** Request to change the AI model. *) 110 122 111 123 type get_server_info = { 112 124 subtype : [`Get_server_info]; 125 125 + unknown : Unknown.t; 113 126 } 114 127 (** Request to get server information. *) 115 128 ··· 123 136 | Set_model of set_model 124 137 | Get_server_info of get_server_info 125 138 (** The type of SDK control requests. *) 126 126 - 127 127 - val interrupt : unit -> t 128 128 - (** [interrupt ()] creates an interrupt request. *) 129 129 - 130 130 - val permission : 131 131 - tool_name:string -> 132 132 - input:value -> 133 133 - ?permission_suggestions:Permissions.Update.t list -> 134 134 - ?blocked_path:string -> 139 139 + 140 140 + val interrupt : ?unknown:Unknown.t -> unit -> t 141 141 + (** [interrupt ?unknown ()] creates an interrupt request. *) 142 142 + 143 143 + val permission : 144 144 + tool_name:string -> 145 145 + input:Jsont.json -> 146 146 + ?permission_suggestions:Permissions.Update.t list -> 147 147 + ?blocked_path:string -> 148 148 + ?unknown:Unknown.t -> 135 149 unit -> t 136 136 - (** [permission ~tool_name ~input ?permission_suggestions ?blocked_path ()] 150 150 + (** [permission ~tool_name ~input ?permission_suggestions ?blocked_path ?unknown ()] 137 151 creates a permission request. *) 138 138 - 139 139 - val initialize : ?hooks:(string * value) list -> unit -> t 140 140 - (** [initialize ?hooks ()] creates an initialize request. *) 141 141 - 142 142 - val set_permission_mode : mode:Permissions.Mode.t -> t 143 143 - (** [set_permission_mode ~mode] creates a permission mode change request. *) 144 144 - 145 145 - val hook_callback : 146 146 - callback_id:string -> 147 147 - input:value -> 148 148 - ?tool_use_id:string -> 152 152 + 153 153 + val initialize : ?hooks:(string * Jsont.json) list -> ?unknown:Unknown.t -> unit -> t 154 154 + (** [initialize ?hooks ?unknown ()] creates an initialize request. *) 155 155 + 156 156 + val set_permission_mode : mode:Permissions.Mode.t -> ?unknown:Unknown.t -> unit -> t 157 157 + (** [set_permission_mode ~mode ?unknown] creates a permission mode change request. *) 158 158 + 159 159 + val hook_callback : 160 160 + callback_id:string -> 161 161 + input:Jsont.json -> 162 162 + ?tool_use_id:string -> 163 163 + ?unknown:Unknown.t -> 149 164 unit -> t 150 150 - (** [hook_callback ~callback_id ~input ?tool_use_id ()] creates a hook callback request. *) 151 151 - 152 152 - val mcp_message : server_name:string -> message:value -> t 153 153 - (** [mcp_message ~server_name ~message] creates an MCP message request. *) 165 165 + (** [hook_callback ~callback_id ~input ?tool_use_id ?unknown ()] creates a hook callback request. *) 166 166 + 167 167 + val mcp_message : server_name:string -> message:Jsont.json -> ?unknown:Unknown.t -> unit -> t 168 168 + (** [mcp_message ~server_name ~message ?unknown] creates an MCP message request. *) 169 169 + 170 170 + val set_model : model:string -> ?unknown:Unknown.t -> unit -> t 171 171 + (** [set_model ~model ?unknown] creates a model change request. *) 154 172 155 155 - val set_model : model:string -> t 156 156 - (** [set_model ~model] creates a model change request. *) 173 173 + val get_server_info : ?unknown:Unknown.t -> unit -> t 174 174 + (** [get_server_info ?unknown ()] creates a server info request. *) 157 175 158 158 - val get_server_info : unit -> t 159 159 - (** [get_server_info ()] creates a server info request. *) 176 176 + val jsont : t Jsont.t 177 177 + (** [jsont] is the jsont codec for requests. *) 160 178 161 161 - val to_json : t -> value 162 162 - (** [to_json t] converts a request to JSON. *) 163 163 - 164 164 - val of_json : value -> t 165 165 - (** [of_json json] parses a request from JSON. 166 166 - @raise Invalid_argument if the JSON is not a valid request. *) 167 167 - 168 179 val pp : Format.formatter -> t -> unit 169 180 (** [pp fmt t] pretty-prints the request. *) 170 181 end ··· 173 184 174 185 module Response : sig 175 186 (** SDK control response types. *) 176 176 - 187 187 + 188 188 + module Unknown : sig 189 189 + type t = Jsont.json 190 190 + val empty : t 191 191 + val is_empty : t -> bool 192 192 + val jsont : t Jsont.t 193 193 + end 194 194 + 177 195 type success = { 178 196 subtype : [`Success]; 179 197 request_id : string; 180 180 - response : value option; 198 198 + response : Jsont.json option; 199 199 + unknown : Unknown.t; 181 200 } 182 201 (** Successful response. *) 183 183 - 202 202 + 184 203 type error = { 185 204 subtype : [`Error]; 186 205 request_id : string; 187 206 error : string; 207 207 + unknown : Unknown.t; 188 208 } 189 209 (** Error response. *) 190 190 - 210 210 + 191 211 type t = 192 212 | Success of success 193 213 | Error of error 194 214 (** The type of SDK control responses. *) 195 195 - 196 196 - val success : request_id:string -> ?response:value -> unit -> t 197 197 - (** [success ~request_id ?response ()] creates a success response. *) 198 198 - 199 199 - val error : request_id:string -> error:string -> t 200 200 - (** [error ~request_id ~error] creates an error response. *) 201 201 - 202 202 - val to_json : t -> value 203 203 - (** [to_json t] converts a response to JSON. *) 204 204 - 205 205 - val of_json : value -> t 206 206 - (** [of_json json] parses a response from JSON. 207 207 - @raise Invalid_argument if the JSON is not a valid response. *) 208 208 - 215 215 + 216 216 + val success : request_id:string -> ?response:Jsont.json -> ?unknown:Unknown.t -> unit -> t 217 217 + (** [success ~request_id ?response ?unknown ()] creates a success response. *) 218 218 + 219 219 + val error : request_id:string -> error:string -> ?unknown:Unknown.t -> unit -> t 220 220 + (** [error ~request_id ~error ?unknown] creates an error response. *) 221 221 + 222 222 + val jsont : t Jsont.t 223 223 + (** [jsont] is the jsont codec for responses. *) 224 224 + 209 225 val pp : Format.formatter -> t -> unit 210 226 (** [pp fmt t] pretty-prints the response. *) 211 227 end 212 228 213 229 (** {1 Control Messages} *) 214 230 231 231 + module Unknown : sig 232 232 + type t = Jsont.json 233 233 + val empty : t 234 234 + val is_empty : t -> bool 235 235 + val jsont : t Jsont.t 236 236 + end 237 237 + 215 238 type control_request = { 216 239 type_ : [`Control_request]; 217 240 request_id : string; 218 241 request : Request.t; 242 242 + unknown : Unknown.t; 219 243 } 220 244 (** Control request message. *) 221 245 222 246 type control_response = { 223 247 type_ : [`Control_response]; 224 248 response : Response.t; 249 249 + unknown : Unknown.t; 225 250 } 226 251 (** Control response message. *) 227 252 253 253 + val control_response_jsont : control_response Jsont.t 254 254 + (** [control_response_jsont] is the jsont codec for control response messages. *) 255 255 + 228 256 type t = 229 257 | Request of control_request 230 258 | Response of control_response 231 259 (** The type of SDK control messages. *) 232 260 233 233 - val create_request : request_id:string -> request:Request.t -> t 234 234 - (** [create_request ~request_id ~request] creates a control request message. *) 261 261 + val create_request : request_id:string -> request:Request.t -> ?unknown:Unknown.t -> unit -> t 262 262 + (** [create_request ~request_id ~request ?unknown ()] creates a control request message. *) 235 263 236 236 - val create_response : response:Response.t -> t 237 237 - (** [create_response ~response] creates a control response message. *) 264 264 + val create_response : response:Response.t -> ?unknown:Unknown.t -> unit -> t 265 265 + (** [create_response ~response ?unknown ()] creates a control response message. *) 238 266 239 239 - val to_json : t -> value 240 240 - (** [to_json t] converts a control message to JSON. *) 241 241 - 242 242 - val of_json : value -> t 243 243 - (** [of_json json] parses a control message from JSON. 244 244 - @raise Invalid_argument if the JSON is not a valid control message. *) 267 267 + val jsont : t Jsont.t 268 268 + (** [jsont] is the jsont codec for control messages. *) 245 269 246 270 val pp : Format.formatter -> t -> unit 247 271 (** [pp fmt t] pretty-prints the control message. *) ··· 282 306 module Server_info : sig 283 307 (** Server information and capabilities. *) 284 308 309 309 + module Unknown : sig 310 310 + type t = Jsont.json 311 311 + val empty : t 312 312 + val is_empty : t -> bool 313 313 + val jsont : t Jsont.t 314 314 + end 315 315 + 285 316 type t = { 286 317 version : string; 287 318 (** Server version string (e.g., "2.0.0") *) ··· 294 325 295 326 output_styles : string list; 296 327 (** Supported output formats (e.g., "json", "stream-json") *) 328 328 + 329 329 + unknown : Unknown.t; 330 330 + (** Unknown fields for forward compatibility *) 297 331 } 298 332 (** Server metadata and capabilities. 299 333 ··· 304 338 capabilities:string list -> 305 339 commands:string list -> 306 340 output_styles:string list -> 341 341 + ?unknown:Unknown.t -> 342 342 + unit -> 307 343 t 308 308 - (** [create ~version ~capabilities ~commands ~output_styles] creates server info. *) 344 344 + (** [create ~version ~capabilities ~commands ~output_styles ?unknown ()] creates server info. *) 309 345 310 346 val version : t -> string 311 347 (** [version t] returns the server version. *) ··· 319 355 val output_styles : t -> string list 320 356 (** [output_styles t] returns available output styles. *) 321 357 322 322 - val of_json : value -> t 323 323 - (** [of_json json] parses server info from JSON. 324 324 - @raise Invalid_argument if the JSON is not valid server info. *) 358 358 + val unknown : t -> Unknown.t 359 359 + (** [unknown t] returns the unknown fields. *) 325 360 326 326 - val to_json : t -> value 327 327 - (** [to_json t] converts server info to JSON. *) 361 361 + val jsont : t Jsont.t 362 362 + (** [jsont] is the jsont codec for server info. *) 328 363 329 364 val pp : Format.formatter -> t -> unit 330 365 (** [pp fmt t] pretty-prints the server info. *)

+49

claudeio/lib/structured_output.ml

reviewed

··· 1 1 + let src = Logs.Src.create "claude.structured_output" ~doc:"Structured output" 2 2 + module Log = (val Logs.src_log src : Logs.LOG) 3 3 + 4 4 + type t = { 5 5 + json_schema : Jsont.json; 6 6 + } 7 7 + 8 8 + let json_to_string json = 9 9 + match Jsont_bytesrw.encode_string' Jsont.json json with 10 10 + | Ok str -> str 11 11 + | Error err -> failwith (Jsont.Error.to_string err) 12 12 + 13 13 + let of_json_schema schema = 14 14 + Log.debug (fun m -> m "Created output format from JSON schema: %s" 15 15 + (json_to_string schema)); 16 16 + { json_schema = schema } 17 17 + 18 18 + let json_schema t = t.json_schema 19 19 + 20 20 + (* Codec for serializing structured output format *) 21 21 + let jsont : t Jsont.t = 22 22 + Jsont.Object.map ~kind:"StructuredOutput" 23 23 + (fun json_schema -> {json_schema}) 24 24 + |> Jsont.Object.mem "jsonSchema" Jsont.json ~enc:(fun t -> t.json_schema) 25 25 + |> Jsont.Object.finish 26 26 + 27 27 + let to_json t = 28 28 + match Jsont.Json.encode jsont t with 29 29 + | Ok json -> json 30 30 + | Error msg -> failwith ("Structured_output.to_json: " ^ msg) 31 31 + 32 32 + let of_json json = 33 33 + match Jsont.Json.decode jsont json with 34 34 + | Ok t -> t 35 35 + | Error msg -> raise (Invalid_argument ("Structured_output.of_json: " ^ msg)) 36 36 + 37 37 + let pp fmt t = 38 38 + let schema_str = 39 39 + match Jsont_bytesrw.encode_string' ~format:Jsont.Minify Jsont.json t.json_schema with 40 40 + | Ok s -> s 41 41 + | Error err -> Jsont.Error.to_string err 42 42 + in 43 43 + let truncated = 44 44 + if String.length schema_str > 100 then 45 45 + String.sub schema_str 0 97 ^ "..." 46 46 + else 47 47 + schema_str 48 48 + in 49 49 + Fmt.pf fmt "@[<2>StructuredOutput { schema = %s }@]" truncated

+171

claudeio/lib/structured_output.mli

reviewed

··· 1 1 + (** Structured output configuration using JSON Schema. 2 2 + 3 3 + This module provides structured output support for Claude, allowing you to 4 4 + specify the expected output format using JSON schemas. When a structured 5 5 + output format is configured, Claude will return its response in the 6 6 + specified JSON format, validated against your schema. 7 7 + 8 8 + {2 Overview} 9 9 + 10 10 + Structured outputs ensure that Claude's responses conform to a specific 11 11 + JSON schema, making it easier to parse and use the results programmatically. 12 12 + This is particularly useful for: 13 13 + 14 14 + - Extracting structured data from unstructured text 15 15 + - Building APIs that require consistent JSON responses 16 16 + - Integrating Claude into data pipelines 17 17 + - Ensuring type-safe parsing of Claude's outputs 18 18 + 19 19 + {2 Creating Output Formats} 20 20 + 21 21 + Use {!of_json_schema} to specify a JSON Schema as a {!Jsont.json} value: 22 22 + {[ 23 23 + let meta = Jsont.Meta.none in 24 24 + let schema = Jsont.Object ([ 25 25 + (("type", meta), Jsont.String ("object", meta)); 26 26 + (("properties", meta), Jsont.Object ([ 27 27 + (("name", meta), Jsont.Object ([ 28 28 + (("type", meta), Jsont.String ("string", meta)) 29 29 + ], meta)); 30 30 + (("age", meta), Jsont.Object ([ 31 31 + (("type", meta), Jsont.String ("integer", meta)) 32 32 + ], meta)); 33 33 + ], meta)); 34 34 + (("required", meta), Jsont.Array ([ 35 35 + Jsont.String ("name", meta); 36 36 + Jsont.String ("age", meta) 37 37 + ], meta)); 38 38 + ], meta) in 39 39 + 40 40 + let format = Structured_output.of_json_schema schema 41 41 + ]} 42 42 + 43 43 + {3 Helper Functions for Building Schemas} 44 44 + 45 45 + For complex schemas, you can use helper functions to make construction easier: 46 46 + {[ 47 47 + let json_object fields = 48 48 + Jsont.Object (fields, Jsont.Meta.none) 49 49 + 50 50 + let json_string s = 51 51 + Jsont.String (s, Jsont.Meta.none) 52 52 + 53 53 + let json_array items = 54 54 + Jsont.Array (items, Jsont.Meta.none) 55 55 + 56 56 + let json_field name value = 57 57 + ((name, Jsont.Meta.none), value) 58 58 + 59 59 + let person_schema = 60 60 + json_object [ 61 61 + json_field "type" (json_string "object"); 62 62 + json_field "properties" (json_object [ 63 63 + json_field "name" (json_object [ 64 64 + json_field "type" (json_string "string") 65 65 + ]); 66 66 + json_field "age" (json_object [ 67 67 + json_field "type" (json_string "integer") 68 68 + ]); 69 69 + ]); 70 70 + json_field "required" (json_array [ 71 71 + json_string "name"; 72 72 + json_string "age" 73 73 + ]) 74 74 + ] 75 75 + 76 76 + let format = Structured_output.of_json_schema person_schema 77 77 + ]} 78 78 + 79 79 + {2 Usage with Claude Client} 80 80 + 81 81 + {[ 82 82 + let options = Options.default 83 83 + |> Options.with_output_format format 84 84 + 85 85 + let client = Client.create ~sw ~process_mgr ~options () in 86 86 + Client.query client "Extract person info from: John is 30 years old"; 87 87 + 88 88 + let messages = Client.receive_all client in 89 89 + List.iter (function 90 90 + | Message.Result result -> 91 91 + (match Message.Result.structured_output result with 92 92 + | Some json -> (* Process validated JSON *) 93 93 + let json_str = match Jsont_bytesrw.encode_string' Jsont.json json with 94 94 + | Ok s -> s 95 95 + | Error err -> Jsont.Error.to_string err 96 96 + in 97 97 + Printf.printf "Structured output: %s\n" json_str 98 98 + | None -> ()) 99 99 + | _ -> () 100 100 + ) messages 101 101 + ]} 102 102 + 103 103 + {2 JSON Schema Support} 104 104 + 105 105 + The module supports standard JSON Schema Draft 7, including: 106 106 + - Primitive types (string, integer, number, boolean, null) 107 107 + - Objects with properties and required fields 108 108 + - Arrays with item schemas 109 109 + - Enumerations 110 110 + - Nested objects and arrays 111 111 + - Complex validation rules 112 112 + 113 113 + @see <https://json-schema.org/> JSON Schema specification 114 114 + @see <https://erratique.ch/software/jsont> jsont documentation *) 115 115 + 116 116 + (** The log source for structured output operations *) 117 117 + val src : Logs.Src.t 118 118 + 119 119 + (** {1 Output Format Configuration} *) 120 120 + 121 121 + type t 122 122 + (** The type of structured output format configurations. *) 123 123 + 124 124 + val of_json_schema : Jsont.json -> t 125 125 + (** [of_json_schema schema] creates an output format from a JSON Schema. 126 126 + 127 127 + The schema should be a valid JSON Schema Draft 7 as a {!Jsont.json} value. 128 128 + 129 129 + Example: 130 130 + {[ 131 131 + let meta = Jsont.Meta.none in 132 132 + let schema = Jsont.Object ([ 133 133 + (("type", meta), Jsont.String ("object", meta)); 134 134 + (("properties", meta), Jsont.Object ([ 135 135 + (("name", meta), Jsont.Object ([ 136 136 + (("type", meta), Jsont.String ("string", meta)) 137 137 + ], meta)); 138 138 + (("age", meta), Jsont.Object ([ 139 139 + (("type", meta), Jsont.String ("integer", meta)) 140 140 + ], meta)); 141 141 + ], meta)); 142 142 + (("required", meta), Jsont.Array ([ 143 143 + Jsont.String ("name", meta); 144 144 + Jsont.String ("age", meta) 145 145 + ], meta)); 146 146 + ], meta) in 147 147 + 148 148 + let format = Structured_output.of_json_schema schema 149 149 + ]} *) 150 150 + 151 151 + val json_schema : t -> Jsont.json 152 152 + (** [json_schema t] returns the JSON Schema. *) 153 153 + 154 154 + val jsont : t Jsont.t 155 155 + (** Codec for structured output format. *) 156 156 + 157 157 + (** {1 Serialization} 158 158 + 159 159 + Internal use for encoding/decoding with the CLI. *) 160 160 + 161 161 + val to_json : t -> Jsont.json 162 162 + (** [to_json t] converts the output format to its JSON representation. 163 163 + Internal use only. *) 164 164 + 165 165 + val of_json : Jsont.json -> t 166 166 + (** [of_json json] parses an output format from JSON. 167 167 + Internal use only. 168 168 + @raise Invalid_argument if the JSON is not a valid output format. *) 169 169 + 170 170 + val pp : Format.formatter -> t -> unit 171 171 + (** [pp fmt t] pretty-prints the output format. *)

+15 -9

claudeio/lib/transport.ml

reviewed

··· 84 84 let cmd = match Options.output_format options with 85 85 | Some format -> 86 86 let schema = Structured_output.json_schema format in 87 87 - let schema_str = Ezjsonm.value_to_string schema in 87 87 + let schema_str = match Jsont_bytesrw.encode_string' Jsont.json schema with 88 88 + | Ok s -> s 89 89 + | Error err -> failwith (Jsont.Error.to_string err) 90 90 + in 88 91 cmd @ ["--json-schema"; schema_str] 89 92 | None -> cmd 90 93 in ··· 162 165 { process = P process; stdin; stdin_close; stdout; sw } 163 166 164 167 let send t json = 165 165 - let data = Ezjsonm.value_to_string json in 168 168 + let data = match Jsont_bytesrw.encode_string' Jsont.json json with 169 169 + | Ok s -> s 170 170 + | Error err -> failwith (Jsont.Error.to_string err) 171 171 + in 166 172 Log.debug (fun m -> m "Sending: %s" data); 167 173 try 168 174 Eio.Flow.write t.stdin [Cstruct.of_string (data ^ "\n")] ··· 187 193 188 194 let interrupt t = 189 195 Log.info (fun m -> m "Sending interrupt signal"); 190 190 - let interrupt_msg = 191 191 - Ezjsonm.dict [ 192 192 - "type", Ezjsonm.string "control_response"; 193 193 - "response", Ezjsonm.dict [ 194 194 - "subtype", Ezjsonm.string "interrupt"; 195 195 - "request_id", Ezjsonm.string ""; 196 196 - ] 196 196 + let interrupt_msg = 197 197 + Jsont.Json.object' [ 198 198 + Jsont.Json.mem (Jsont.Json.name "type") (Jsont.Json.string "control_response"); 199 199 + Jsont.Json.mem (Jsont.Json.name "response") (Jsont.Json.object' [ 200 200 + Jsont.Json.mem (Jsont.Json.name "subtype") (Jsont.Json.string "interrupt"); 201 201 + Jsont.Json.mem (Jsont.Json.name "request_id") (Jsont.Json.string ""); 202 202 + ]) 197 203 ] 198 204 in 199 205 send t interrupt_msg

+2 -2

claudeio/lib/transport.mli

reviewed

··· 7 7 8 8 type t 9 9 10 10 - val create : 10 10 + val create : 11 11 sw:Eio.Switch.t -> 12 12 process_mgr:_ Eio.Process.mgr -> 13 13 options:Options.t -> 14 14 unit -> t 15 15 16 16 - val send : t -> Ezjsonm.value -> unit 16 16 + val send : t -> Jsont.json -> unit 17 17 val receive_line : t -> string option 18 18 val interrupt : t -> unit 19 19 val close : t -> unit

+165

claudeio/test/advanced_config_demo.ml

reviewed

··· 1 1 + (* Advanced Configuration Demo 2 2 + 3 3 + This example demonstrates the advanced configuration options available 4 4 + in the OCaml Claude SDK, including: 5 5 + - Budget limits for cost control 6 6 + - Fallback models for reliability 7 7 + - Settings isolation for CI/CD environments 8 8 + - Custom buffer sizes for large outputs 9 9 + *) 10 10 + 11 11 + open Eio.Std 12 12 + open Claude 13 13 + 14 14 + let log_setup () = 15 15 + Logs.set_reporter (Logs_fmt.reporter ()); 16 16 + Logs.set_level (Some Logs.Info) 17 17 + 18 18 + (* Example 1: CI/CD Configuration 19 19 + 20 20 + In CI/CD environments, you want isolated, reproducible behavior 21 21 + without any user/project/local settings interfering. 22 22 + *) 23 23 + let ci_cd_config () = 24 24 + Options.default 25 25 + |> Options.with_no_settings (* Disable all settings loading *) 26 26 + |> Options.with_max_budget_usd 0.50 (* 50 cent limit per run *) 27 27 + |> Options.with_fallback_model_string "claude-haiku-4" (* Fast fallback *) 28 28 + |> Options.with_model_string "claude-sonnet-4-5" 29 29 + |> Options.with_permission_mode Permissions.Mode.Bypass_permissions 30 30 + 31 31 + (* Example 2: Production Configuration with Fallback 32 32 + 33 33 + Production usage with cost controls and automatic fallback 34 34 + to ensure availability. 35 35 + *) 36 36 + let production_config () = 37 37 + Options.default 38 38 + |> Options.with_model_string "claude-sonnet-4-5" 39 39 + |> Options.with_fallback_model_string "claude-sonnet-3-5" 40 40 + |> Options.with_max_budget_usd 10.0 (* $10 limit *) 41 41 + |> Options.with_max_buffer_size 5_000_000 (* 5MB buffer for large outputs *) 42 42 + 43 43 + (* Example 3: Development Configuration 44 44 + 45 45 + Development with user settings enabled but with cost controls. 46 46 + *) 47 47 + let dev_config () = 48 48 + Options.default 49 49 + |> Options.with_setting_sources [Options.User; Options.Project] 50 50 + |> Options.with_max_budget_usd 1.0 (* $1 limit for dev testing *) 51 51 + |> Options.with_fallback_model_string "claude-haiku-4" 52 52 + 53 53 + (* Example 4: Isolated Test Configuration 54 54 + 55 55 + For automated testing with no external settings and strict limits. 56 56 + *) 57 57 + let test_config () = 58 58 + Options.default 59 59 + |> Options.with_no_settings 60 60 + |> Options.with_max_budget_usd 0.10 (* 10 cent limit per test *) 61 61 + |> Options.with_model_string "claude-haiku-4" (* Fast, cheap model *) 62 62 + |> Options.with_permission_mode Permissions.Mode.Bypass_permissions 63 63 + |> Options.with_max_buffer_size 1_000_000 (* 1MB buffer *) 64 64 + 65 65 + (* Example 5: Custom Buffer Size Demo 66 66 + 67 67 + For applications that need to handle very large outputs. 68 68 + *) 69 69 + let _large_output_config () = 70 70 + Options.default 71 71 + |> Options.with_max_buffer_size 10_000_000 (* 10MB buffer *) 72 72 + |> Options.with_model_string "claude-sonnet-4-5" 73 73 + 74 74 + (* Helper to run a query with a specific configuration *) 75 75 + let run_query ~sw process_mgr config prompt = 76 76 + print_endline "\n=== Configuration ==="; 77 77 + (match Options.max_budget_usd config with 78 78 + | Some budget -> Printf.printf "Budget limit: $%.2f\n" budget 79 79 + | None -> print_endline "Budget limit: None"); 80 80 + (match Options.fallback_model config with 81 81 + | Some model -> Printf.printf "Fallback model: %s\n" (Claude.Model.to_string model) 82 82 + | None -> print_endline "Fallback model: None"); 83 83 + (match Options.setting_sources config with 84 84 + | Some [] -> print_endline "Settings: Isolated (no settings loaded)" 85 85 + | Some sources -> 86 86 + let source_str = String.concat ", " (List.map (function 87 87 + | Options.User -> "user" 88 88 + | Options.Project -> "project" 89 89 + | Options.Local -> "local" 90 90 + ) sources) in 91 91 + Printf.printf "Settings: %s\n" source_str 92 92 + | None -> print_endline "Settings: Default"); 93 93 + (match Options.max_buffer_size config with 94 94 + | Some size -> Printf.printf "Buffer size: %d bytes\n" size 95 95 + | None -> print_endline "Buffer size: Default (1MB)"); 96 96 + 97 97 + print_endline "\n=== Running Query ==="; 98 98 + let client = Client.create ~options:config ~sw ~process_mgr () in 99 99 + Client.query client prompt; 100 100 + let messages = Client.receive client in 101 101 + 102 102 + Seq.iter (function 103 103 + | Message.Assistant msg -> 104 104 + List.iter (function 105 105 + | Content_block.Text t -> 106 106 + Printf.printf "Response: %s\n" (Content_block.Text.text t) 107 107 + | _ -> () 108 108 + ) (Message.Assistant.content msg) 109 109 + | Message.Result result -> 110 110 + Printf.printf "\n=== Session Complete ===\n"; 111 111 + Printf.printf "Duration: %dms\n" (Message.Result.duration_ms result); 112 112 + (match Message.Result.total_cost_usd result with 113 113 + | Some cost -> Printf.printf "Cost: $%.4f\n" cost 114 114 + | None -> ()); 115 115 + Printf.printf "Turns: %d\n" (Message.Result.num_turns result) 116 116 + | _ -> () 117 117 + ) messages 118 118 + 119 119 + let main () = 120 120 + log_setup (); 121 121 + 122 122 + Eio_main.run @@ fun env -> 123 123 + Switch.run @@ fun sw -> 124 124 + let process_mgr = Eio.Stdenv.process_mgr env in 125 125 + 126 126 + print_endline "=============================================="; 127 127 + print_endline "Claude SDK - Advanced Configuration Examples"; 128 128 + print_endline "=============================================="; 129 129 + 130 130 + (* Example: CI/CD isolated environment *) 131 131 + print_endline "\n\n### Example 1: CI/CD Configuration ###"; 132 132 + print_endline "Purpose: Isolated, reproducible environment for CI/CD"; 133 133 + let config = ci_cd_config () in 134 134 + run_query ~sw process_mgr config "What is 2+2? Answer in one sentence."; 135 135 + 136 136 + (* Example: Production with fallback *) 137 137 + print_endline "\n\n### Example 2: Production Configuration ###"; 138 138 + print_endline "Purpose: Production with cost controls and fallback"; 139 139 + let config = production_config () in 140 140 + run_query ~sw process_mgr config "Explain OCaml in one sentence."; 141 141 + 142 142 + (* Example: Development with settings *) 143 143 + print_endline "\n\n### Example 3: Development Configuration ###"; 144 144 + print_endline "Purpose: Development with user/project settings"; 145 145 + let config = dev_config () in 146 146 + run_query ~sw process_mgr config "What is functional programming? One sentence."; 147 147 + 148 148 + (* Example: Test configuration *) 149 149 + print_endline "\n\n### Example 4: Test Configuration ###"; 150 150 + print_endline "Purpose: Automated testing with strict limits"; 151 151 + let config = test_config () in 152 152 + run_query ~sw process_mgr config "Say 'test passed' in one word."; 153 153 + 154 154 + print_endline "\n\n=============================================="; 155 155 + print_endline "All examples completed successfully!"; 156 156 + print_endline "==============================================" 157 157 + 158 158 + let () = 159 159 + try 160 160 + main () 161 161 + with 162 162 + | e -> 163 163 + Printf.eprintf "Error: %s\n" (Printexc.to_string e); 164 164 + Printexc.print_backtrace stderr; 165 165 + exit 1

+16 -5

claudeio/test/dune

reviewed

··· 1 1 + (library 2 2 + (name test_json_utils) 3 3 + (modules test_json_utils) 4 4 + (libraries jsont jsont.bytesrw)) 5 5 + 1 6 (executable 2 7 (public_name camel_jokes) 3 8 (name camel_jokes) ··· 8 13 (public_name permission_demo) 9 14 (name permission_demo) 10 15 (modules permission_demo) 11 11 - (libraries claude eio_main cmdliner logs logs.fmt fmt.tty fmt.cli logs.cli)) 16 16 + (libraries test_json_utils claude eio_main cmdliner logs logs.fmt fmt.tty fmt.cli logs.cli)) 12 17 13 18 (executable 14 19 (public_name discovery_demo) ··· 32 37 (public_name simple_permission_test) 33 38 (name simple_permission_test) 34 39 (modules simple_permission_test) 35 35 - (libraries claude eio_main cmdliner logs logs.fmt fmt.tty fmt.cli logs.cli)) 40 40 + (libraries test_json_utils claude eio_main cmdliner logs logs.fmt fmt.tty fmt.cli logs.cli)) 36 41 37 42 (executable 38 43 (public_name hooks_example) 39 44 (name hooks_example) 40 45 (modules hooks_example) 41 41 - (libraries claude eio_main cmdliner logs logs.fmt fmt.tty fmt.cli logs.cli)) 46 46 + (libraries test_json_utils claude eio_main cmdliner logs logs.fmt fmt.tty fmt.cli logs.cli)) 42 47 43 48 (executable 44 49 (public_name dynamic_control_demo) ··· 57 62 (name structured_output_demo) 58 63 (modules structured_output_demo) 59 64 (flags (:standard -w -33)) 60 60 - (libraries claude eio_main logs logs.fmt fmt.tty)) 65 65 + (libraries test_json_utils claude eio_main logs logs.fmt fmt.tty)) 61 66 62 67 (executable 63 68 (public_name structured_output_simple) 64 69 (name structured_output_simple) 65 70 (modules structured_output_simple) 66 71 (flags (:standard -w -33)) 67 67 - (libraries claude eio_main logs logs.fmt fmt.tty)) 72 72 + (libraries test_json_utils claude eio_main logs logs.fmt fmt.tty)) 73 73 + 74 74 + (executable 75 75 + (public_name test_incoming) 76 76 + (name test_incoming) 77 77 + (modules test_incoming) 78 78 + (libraries claude jsont.bytesrw))

+91

claudeio/test/dynamic_control_demo.ml

reviewed

··· 1 1 + open Claude 2 2 + open Eio.Std 3 3 + 4 4 + let () = Logs.set_reporter (Logs_fmt.reporter ()) 5 5 + let () = Logs.set_level (Some Logs.Info) 6 6 + 7 7 + let run env = 8 8 + Switch.run @@ fun sw -> 9 9 + let process_mgr = Eio.Stdenv.process_mgr env in 10 10 + 11 11 + (* Create client with default options *) 12 12 + let options = Options.default in 13 13 + let client = Client.create ~options ~sw ~process_mgr () in 14 14 + 15 15 + traceln "=== Dynamic Control Demo ===\n"; 16 16 + 17 17 + (* First query with default model *) 18 18 + traceln "1. Initial query with default model"; 19 19 + Client.query client "What model are you?"; 20 20 + 21 21 + (* Consume initial messages *) 22 22 + let messages = Client.receive_all client in 23 23 + List.iter (function 24 24 + | Message.Assistant msg -> 25 25 + List.iter (function 26 26 + | Content_block.Text t -> 27 27 + traceln "Assistant: %s" (Content_block.Text.text t) 28 28 + | _ -> () 29 29 + ) (Message.Assistant.content msg) 30 30 + | _ -> () 31 31 + ) messages; 32 32 + 33 33 + traceln "\n2. Getting server info..."; 34 34 + (try 35 35 + let info = Client.get_server_info client in 36 36 + traceln "Server version: %s" (Sdk_control.Server_info.version info); 37 37 + traceln "Capabilities: [%s]" 38 38 + (String.concat ", " (Sdk_control.Server_info.capabilities info)); 39 39 + traceln "Commands: [%s]" 40 40 + (String.concat ", " (Sdk_control.Server_info.commands info)); 41 41 + traceln "Output styles: [%s]" 42 42 + (String.concat ", " (Sdk_control.Server_info.output_styles info)); 43 43 + with 44 44 + | Failure msg -> traceln "Failed to get server info: %s" msg 45 45 + | exn -> traceln "Error getting server info: %s" (Printexc.to_string exn)); 46 46 + 47 47 + traceln "\n3. Switching to a different model (if available)..."; 48 48 + (try 49 49 + Client.set_model_string client "claude-sonnet-4"; 50 50 + traceln "Model switched successfully"; 51 51 + 52 52 + (* Query with new model *) 53 53 + Client.query client "Confirm your model again please."; 54 54 + let messages = Client.receive_all client in 55 55 + List.iter (function 56 56 + | Message.Assistant msg -> 57 57 + List.iter (function 58 58 + | Content_block.Text t -> 59 59 + traceln "Assistant (new model): %s" (Content_block.Text.text t) 60 60 + | _ -> () 61 61 + ) (Message.Assistant.content msg) 62 62 + | _ -> () 63 63 + ) messages; 64 64 + with 65 65 + | Failure msg -> traceln "Failed to switch model: %s" msg 66 66 + | exn -> traceln "Error switching model: %s" (Printexc.to_string exn)); 67 67 + 68 68 + traceln "\n4. Changing permission mode..."; 69 69 + (try 70 70 + Client.set_permission_mode client Permissions.Mode.Accept_edits; 71 71 + traceln "Permission mode changed to Accept_edits"; 72 72 + with 73 73 + | Failure msg -> traceln "Failed to change permission mode: %s" msg 74 74 + | exn -> traceln "Error changing permission mode: %s" (Printexc.to_string exn)); 75 75 + 76 76 + traceln "\n=== Demo Complete ==="; 77 77 + () 78 78 + 79 79 + let () = 80 80 + Eio_main.run @@ fun env -> 81 81 + try 82 82 + run env 83 83 + with 84 84 + | Transport.CLI_not_found msg -> 85 85 + traceln "Error: %s" msg; 86 86 + traceln "Make sure the 'claude' CLI is installed and authenticated."; 87 87 + exit 1 88 88 + | exn -> 89 89 + traceln "Unexpected error: %s" (Printexc.to_string exn); 90 90 + Printexc.print_backtrace stderr; 91 91 + exit 1

+2 -2

claudeio/test/hooks_example.ml

reviewed

··· 10 10 11 11 if tool_name = "Bash" then 12 12 let tool_input = Claude.Hooks.PreToolUse.tool_input hook in 13 13 - match Ezjsonm.find tool_input ["command"] with 14 14 - | `String command -> 13 13 + match Test_json_utils.get_string tool_input "command" with 14 14 + | Some command -> 15 15 if String.length command >= 6 && String.sub command 0 6 = "rm -rf" then begin 16 16 Log.app (fun m -> m "🚫 Blocked dangerous command: %s" command); 17 17 let output = Claude.Hooks.PreToolUse.deny

+27 -22

claudeio/test/permission_demo.ml

reviewed

··· 33 33 Log.app (fun m -> m "Tool: %s" tool_name); 34 34 35 35 (* Log the full input for debugging *) 36 36 - Log.info (fun m -> m "Full input JSON: %s" (Ezjsonm.value_to_string input)); 36 36 + Log.info (fun m -> m "Full input JSON: %s" (Test_json_utils.to_string input)); 37 37 38 38 (* Show input details *) 39 39 (* Try to extract key information from the input *) 40 40 (try 41 41 match tool_name with 42 42 | "Read" -> 43 43 - let file_path = Ezjsonm.find input ["file_path"] |> Ezjsonm.get_string in 44 44 - Log.app (fun m -> m "File: %s" file_path) 43 43 + (match Test_json_utils.get_string input "file_path" with 44 44 + | Some file_path -> Log.app (fun m -> m "File: %s" file_path) 45 45 + | None -> ()) 45 46 | "Bash" -> 46 46 - let command = Ezjsonm.find input ["command"] |> Ezjsonm.get_string in 47 47 - Log.app (fun m -> m "Command: %s" command) 47 47 + (match Test_json_utils.get_string input "command" with 48 48 + | Some command -> Log.app (fun m -> m "Command: %s" command) 49 49 + | None -> ()) 48 50 | "Write" | "Edit" -> 49 49 - let file_path = Ezjsonm.find input ["file_path"] |> Ezjsonm.get_string in 50 50 - Log.app (fun m -> m "File: %s" file_path) 51 51 + (match Test_json_utils.get_string input "file_path" with 52 52 + | Some file_path -> Log.app (fun m -> m "File: %s" file_path) 53 53 + | None -> ()) 51 54 | "Glob" -> 52 52 - let pattern = Ezjsonm.find input ["pattern"] |> Ezjsonm.get_string in 53 53 - Log.app (fun m -> m "Pattern: %s" pattern); 54 54 - (try 55 55 - let path = Ezjsonm.find input ["path"] |> Ezjsonm.get_string in 56 56 - Log.app (fun m -> m "Path: %s" path) 57 57 - with _ -> Log.app (fun m -> m "Path: (current directory)")) 55 55 + (match Test_json_utils.get_string input "pattern" with 56 56 + | Some pattern -> 57 57 + Log.app (fun m -> m "Pattern: %s" pattern); 58 58 + (match Test_json_utils.get_string input "path" with 59 59 + | Some path -> Log.app (fun m -> m "Path: %s" path) 60 60 + | None -> Log.app (fun m -> m "Path: (current directory)")) 61 61 + | None -> ()) 58 62 | "Grep" -> 59 59 - let pattern = Ezjsonm.find input ["pattern"] |> Ezjsonm.get_string in 60 60 - Log.app (fun m -> m "Pattern: %s" pattern); 61 61 - (try 62 62 - let path = Ezjsonm.find input ["path"] |> Ezjsonm.get_string in 63 63 - Log.app (fun m -> m "Path: %s" path) 64 64 - with _ -> Log.app (fun m -> m "Path: (current directory)")) 63 63 + (match Test_json_utils.get_string input "pattern" with 64 64 + | Some pattern -> 65 65 + Log.app (fun m -> m "Pattern: %s" pattern); 66 66 + (match Test_json_utils.get_string input "path" with 67 67 + | Some path -> Log.app (fun m -> m "Path: %s" path) 68 68 + | None -> Log.app (fun m -> m "Path: (current directory)")) 69 69 + | None -> ()) 65 70 | _ -> 66 66 - Log.app (fun m -> m "Input: %s" (Ezjsonm.value_to_string input)) 67 67 - with exn -> 71 71 + Log.app (fun m -> m "Input: %s" (Test_json_utils.to_string input)) 72 72 + with exn -> 68 73 Log.info (fun m -> m "Failed to parse input details: %s" (Printexc.to_string exn))); 69 74 70 75 (* Check if already granted *) ··· 90 95 | _ -> 91 96 Granted.deny tool_name; 92 97 Log.info (fun m -> m "User denied permission for %s" tool_name); 93 93 - Claude.Permissions.Result.deny ~message:(Printf.sprintf "User denied access to %s" tool_name) ~interrupt:false 98 98 + Claude.Permissions.Result.deny ~message:(Printf.sprintf "User denied access to %s" tool_name) ~interrupt:false () 94 99 end 95 100 96 101 let process_response client =

+1 -1

claudeio/test/simple_permission_test.ml

reviewed

··· 7 7 let auto_allow_callback ~tool_name ~input ~context:_ = 8 8 Log.app (fun m -> m "\n🔐 Permission callback invoked!"); 9 9 Log.app (fun m -> m " Tool: %s" tool_name); 10 10 - Log.app (fun m -> m " Input: %s" (Ezjsonm.value_to_string input)); 10 10 + Log.app (fun m -> m " Input: %s" (Test_json_utils.to_string input)); 11 11 Log.app (fun m -> m " ✅ Auto-allowing"); 12 12 Claude.Permissions.Result.allow () 13 13

+29 -17

claudeio/test/simulated_permissions.ml

reviewed

··· 46 46 Claude.Permissions.Result.allow () 47 47 end else if PermissionState.is_denied tool_name then begin 48 48 Log.app (fun m -> m " → Auto-denied (previously denied)"); 49 49 - Claude.Permissions.Result.deny 49 49 + Claude.Permissions.Result.deny 50 50 ~message:(Printf.sprintf "Tool %s is blocked by policy" tool_name) 51 51 - ~interrupt:false 51 51 + ~interrupt:false () 52 52 end else begin 53 53 (* Ask user *) 54 54 Printf.printf " Allow %s? [y/n/always/never]: %!" tool_name; ··· 58 58 Claude.Permissions.Result.allow () 59 59 | "n" | "no" -> 60 60 Log.app (fun m -> m " → Denied (one time)"); 61 61 - Claude.Permissions.Result.deny 61 61 + Claude.Permissions.Result.deny 62 62 ~message:(Printf.sprintf "User denied %s" tool_name) 63 63 - ~interrupt:false 63 63 + ~interrupt:false () 64 64 | "a" | "always" -> 65 65 PermissionState.grant tool_name; 66 66 Log.app (fun m -> m " → Allowed (always)"); ··· 68 68 | "never" -> 69 69 PermissionState.deny tool_name; 70 70 Log.app (fun m -> m " → Denied (always)"); 71 71 - Claude.Permissions.Result.deny 71 71 + Claude.Permissions.Result.deny 72 72 ~message:(Printf.sprintf "Tool %s permanently blocked" tool_name) 73 73 - ~interrupt:false 73 73 + ~interrupt:false () 74 74 | _ -> 75 75 Log.app (fun m -> m " → Denied (invalid response)"); 76 76 - Claude.Permissions.Result.deny 76 76 + Claude.Permissions.Result.deny 77 77 ~message:"Invalid permission response" 78 78 - ~interrupt:false 78 78 + ~interrupt:false () 79 79 end 80 80 81 81 (* Demonstrate the permission system *) ··· 92 92 93 93 (* Test each tool *) 94 94 List.iter (fun tool -> 95 95 - let input = Ezjsonm.dict [ 96 96 - "file_path", Ezjsonm.string "/example/path.txt" 97 97 - ] in 98 98 - let result = example_permission_callback 95 95 + let input = 96 96 + let open Jsont in 97 97 + Object ([ 98 98 + (("file_path", Meta.none), String ("/example/path.txt", Meta.none)) 99 99 + ], Meta.none) 100 100 + in 101 101 + let result = example_permission_callback 99 102 ~tool_name:tool ~input ~context in 100 103 101 104 (* Show result *) ··· 118 121 let callback = Claude.Permissions.discovery_callback discovered in 119 122 120 123 (* Simulate some tool requests *) 121 121 - let requests = [ 122 122 - ("Read", Ezjsonm.dict ["file_path", Ezjsonm.string "test.ml"]); 123 123 - ("Bash", Ezjsonm.dict ["command", Ezjsonm.string "ls -la"]); 124 124 - ("Write", Ezjsonm.dict ["file_path", Ezjsonm.string "output.txt"]); 125 125 - ] in 124 124 + let requests = 125 125 + let open Jsont in 126 126 + [ 127 127 + ("Read", Object ([ 128 128 + (("file_path", Meta.none), String ("test.ml", Meta.none)) 129 129 + ], Meta.none)); 130 130 + ("Bash", Object ([ 131 131 + (("command", Meta.none), String ("ls -la", Meta.none)) 132 132 + ], Meta.none)); 133 133 + ("Write", Object ([ 134 134 + (("file_path", Meta.none), String ("output.txt", Meta.none)) 135 135 + ], Meta.none)); 136 136 + ] 137 137 + in 126 138 127 139 Log.app (fun m -> m "Simulating tool requests with discovery callback...\n"); 128 140

+172

claudeio/test/structured_output_demo.ml

reviewed

··· 1 1 + (* Example demonstrating structured output with JSON Schema *) 2 2 + 3 3 + module C = Claude 4 4 + 5 5 + let () = 6 6 + (* Configure logging to see what's happening *) 7 7 + Logs.set_reporter (Logs_fmt.reporter ()); 8 8 + Logs.set_level (Some Logs.Info); 9 9 + Logs.Src.set_level C.Message.src (Some Logs.Debug) 10 10 + 11 11 + let run_codebase_analysis env = 12 12 + Printf.printf "\n=== Codebase Analysis with Structured Output ===\n\n"; 13 13 + 14 14 + (* Define the JSON Schema for our expected output structure *) 15 15 + let analysis_schema = 16 16 + let open Jsont in 17 17 + Object ([ 18 18 + (("type", Meta.none), String ("object", Meta.none)); 19 19 + (("properties", Meta.none), Object ([ 20 20 + (("file_count", Meta.none), Object ([ 21 21 + (("type", Meta.none), String ("integer", Meta.none)); 22 22 + (("description", Meta.none), String ("Total number of files analyzed", Meta.none)) 23 23 + ], Meta.none)); 24 24 + (("has_tests", Meta.none), Object ([ 25 25 + (("type", Meta.none), String ("boolean", Meta.none)); 26 26 + (("description", Meta.none), String ("Whether the codebase has test files", Meta.none)) 27 27 + ], Meta.none)); 28 28 + (("primary_language", Meta.none), Object ([ 29 29 + (("type", Meta.none), String ("string", Meta.none)); 30 30 + (("description", Meta.none), String ("The primary programming language used", Meta.none)) 31 31 + ], Meta.none)); 32 32 + (("complexity_rating", Meta.none), Object ([ 33 33 + (("type", Meta.none), String ("string", Meta.none)); 34 34 + (("enum", Meta.none), Array ([ 35 35 + String ("low", Meta.none); 36 36 + String ("medium", Meta.none); 37 37 + String ("high", Meta.none) 38 38 + ], Meta.none)); 39 39 + (("description", Meta.none), String ("Overall complexity rating", Meta.none)) 40 40 + ], Meta.none)); 41 41 + (("key_findings", Meta.none), Object ([ 42 42 + (("type", Meta.none), String ("array", Meta.none)); 43 43 + (("items", Meta.none), Object ([ 44 44 + (("type", Meta.none), String ("string", Meta.none)) 45 45 + ], Meta.none)); 46 46 + (("description", Meta.none), String ("List of key findings from the analysis", Meta.none)) 47 47 + ], Meta.none)); 48 48 + ], Meta.none)); 49 49 + (("required", Meta.none), Array ([ 50 50 + String ("file_count", Meta.none); 51 51 + String ("has_tests", Meta.none); 52 52 + String ("primary_language", Meta.none); 53 53 + String ("complexity_rating", Meta.none); 54 54 + String ("key_findings", Meta.none) 55 55 + ], Meta.none)); 56 56 + (("additionalProperties", Meta.none), Bool (false, Meta.none)) 57 57 + ], Meta.none) 58 58 + in 59 59 + 60 60 + (* Create structured output format from the schema *) 61 61 + let output_format = C.Structured_output.of_json_schema analysis_schema in 62 62 + 63 63 + (* Configure Claude with structured output *) 64 64 + let options = C.Options.default 65 65 + |> C.Options.with_output_format output_format 66 66 + |> C.Options.with_allowed_tools ["Read"; "Glob"; "Grep"] 67 67 + |> C.Options.with_system_prompt 68 68 + "You are a code analysis assistant. Analyze codebases and provide \ 69 69 + structured output matching the given JSON Schema." 70 70 + in 71 71 + 72 72 + Printf.printf "Structured output format configured\n"; 73 73 + Printf.printf "Schema: %s\n\n" 74 74 + (Test_json_utils.to_string ~minify:false analysis_schema); 75 75 + 76 76 + (* Create Claude client and query *) 77 77 + Eio.Switch.run @@ fun sw -> 78 78 + let process_mgr = Eio.Stdenv.process_mgr env in 79 79 + let client = C.Client.create ~sw ~process_mgr ~options () in 80 80 + 81 81 + let prompt = 82 82 + "Please analyze the current codebase structure. Look at the files, \ 83 83 + identify the primary language, count files, check for tests, assess \ 84 84 + complexity, and provide key findings. Return your analysis in the \ 85 85 + structured JSON format I specified." 86 86 + in 87 87 + 88 88 + Printf.printf "Sending query: %s\n\n" prompt; 89 89 + C.Client.query client prompt; 90 90 + 91 91 + (* Process responses *) 92 92 + let messages = C.Client.receive client in 93 93 + Seq.iter (function 94 94 + | C.Message.Assistant msg -> 95 95 + Printf.printf "\nAssistant response:\n"; 96 96 + List.iter (function 97 97 + | C.Content_block.Text text -> 98 98 + Printf.printf " Text: %s\n" (C.Content_block.Text.text text) 99 99 + | C.Content_block.Tool_use tool -> 100 100 + Printf.printf " Using tool: %s\n" (C.Content_block.Tool_use.name tool) 101 101 + | _ -> () 102 102 + ) (C.Message.Assistant.content msg) 103 103 + 104 104 + | C.Message.Result result -> 105 105 + Printf.printf "\n=== Result ===\n"; 106 106 + Printf.printf "Duration: %dms\n" (C.Message.Result.duration_ms result); 107 107 + Printf.printf "Cost: $%.4f\n" 108 108 + (Option.value (C.Message.Result.total_cost_usd result) ~default:0.0); 109 109 + 110 110 + (* Extract and display structured output *) 111 111 + (match C.Message.Result.structured_output result with 112 112 + | Some output -> 113 113 + Printf.printf "\n=== Structured Output ===\n"; 114 114 + Printf.printf "%s\n\n" (Test_json_utils.to_string ~minify:false output); 115 115 + 116 116 + (* Parse the structured output *) 117 117 + let file_count = Test_json_utils.get_int output "file_count" |> Option.value ~default:0 in 118 118 + let has_tests = Test_json_utils.get_bool output "has_tests" |> Option.value ~default:false in 119 119 + let language = Test_json_utils.get_string output "primary_language" |> Option.value ~default:"unknown" in 120 120 + let complexity = Test_json_utils.get_string output "complexity_rating" |> Option.value ~default:"unknown" in 121 121 + let findings = 122 122 + match Test_json_utils.get_array output "key_findings" with 123 123 + | Some items -> 124 124 + List.filter_map (fun json -> 125 125 + Test_json_utils.as_string json 126 126 + ) items 127 127 + | None -> [] 128 128 + in 129 129 + 130 130 + Printf.printf "=== Parsed Analysis ===\n"; 131 131 + Printf.printf "File Count: %d\n" file_count; 132 132 + Printf.printf "Has Tests: %b\n" has_tests; 133 133 + Printf.printf "Primary Language: %s\n" language; 134 134 + Printf.printf "Complexity: %s\n" complexity; 135 135 + Printf.printf "Key Findings:\n"; 136 136 + List.iter (fun finding -> 137 137 + Printf.printf " - %s\n" finding 138 138 + ) findings 139 139 + 140 140 + | None -> 141 141 + Printf.printf "No structured output received\n"; 142 142 + (match C.Message.Result.result result with 143 143 + | Some text -> Printf.printf "Text result: %s\n" text 144 144 + | None -> ())) 145 145 + 146 146 + | C.Message.System sys -> 147 147 + (match C.Message.System.subtype sys with 148 148 + | "init" -> 149 149 + Printf.printf "Session initialized\n" 150 150 + | _ -> ()) 151 151 + 152 152 + | _ -> () 153 153 + ) messages; 154 154 + 155 155 + Printf.printf "\nDone!\n" 156 156 + 157 157 + let () = 158 158 + Eio_main.run @@ fun env -> 159 159 + try 160 160 + run_codebase_analysis env 161 161 + with 162 162 + | C.Transport.CLI_not_found msg -> 163 163 + Printf.eprintf "Error: Claude CLI not found\n%s\n" msg; 164 164 + Printf.eprintf "Make sure 'claude' is installed and in your PATH\n"; 165 165 + exit 1 166 166 + | C.Transport.Connection_error msg -> 167 167 + Printf.eprintf "Connection error: %s\n" msg; 168 168 + exit 1 169 169 + | exn -> 170 170 + Printf.eprintf "Unexpected error: %s\n" (Printexc.to_string exn); 171 171 + Printexc.print_backtrace stderr; 172 172 + exit 1

+72

claudeio/test/structured_output_simple.ml

reviewed

··· 1 1 + (* Simple example showing structured output with explicit JSON Schema *) 2 2 + 3 3 + module C = Claude 4 4 + 5 5 + let () = 6 6 + Logs.set_reporter (Logs_fmt.reporter ()); 7 7 + Logs.set_level (Some Logs.Info) 8 8 + 9 9 + let simple_example env = 10 10 + Printf.printf "\n=== Simple Structured Output Example ===\n\n"; 11 11 + 12 12 + (* Define a simple schema for a person's info *) 13 13 + let person_schema = 14 14 + let open Jsont in 15 15 + Object ([ 16 16 + (("type", Meta.none), String ("object", Meta.none)); 17 17 + (("properties", Meta.none), Object ([ 18 18 + (("name", Meta.none), Object ([ 19 19 + (("type", Meta.none), String ("string", Meta.none)) 20 20 + ], Meta.none)); 21 21 + (("age", Meta.none), Object ([ 22 22 + (("type", Meta.none), String ("integer", Meta.none)) 23 23 + ], Meta.none)); 24 24 + (("occupation", Meta.none), Object ([ 25 25 + (("type", Meta.none), String ("string", Meta.none)) 26 26 + ], Meta.none)); 27 27 + ], Meta.none)); 28 28 + (("required", Meta.none), Array ([ 29 29 + String ("name", Meta.none); 30 30 + String ("age", Meta.none); 31 31 + String ("occupation", Meta.none) 32 32 + ], Meta.none)) 33 33 + ], Meta.none) 34 34 + in 35 35 + 36 36 + let output_format = C.Structured_output.of_json_schema person_schema in 37 37 + 38 38 + let options = C.Options.default 39 39 + |> C.Options.with_output_format output_format 40 40 + |> C.Options.with_max_turns 1 41 41 + in 42 42 + 43 43 + Printf.printf "Asking Claude to provide structured data...\n\n"; 44 44 + 45 45 + Eio.Switch.run @@ fun sw -> 46 46 + let process_mgr = Eio.Stdenv.process_mgr env in 47 47 + let client = C.Client.create ~sw ~process_mgr ~options () in 48 48 + 49 49 + C.Client.query client 50 50 + "Tell me about a famous computer scientist. Provide their name, age, \ 51 51 + and occupation in the exact JSON structure I specified."; 52 52 + 53 53 + let messages = C.Client.receive_all client in 54 54 + List.iter (function 55 55 + | C.Message.Result result -> 56 56 + Printf.printf "Response received!\n"; 57 57 + (match C.Message.Result.structured_output result with 58 58 + | Some json -> 59 59 + Printf.printf "\nStructured Output:\n%s\n" 60 60 + (Test_json_utils.to_string ~minify:false json) 61 61 + | None -> 62 62 + Printf.printf "No structured output\n") 63 63 + | _ -> () 64 64 + ) messages 65 65 + 66 66 + let () = 67 67 + Eio_main.run @@ fun env -> 68 68 + try 69 69 + simple_example env 70 70 + with exn -> 71 71 + Printf.eprintf "Error: %s\n" (Printexc.to_string exn); 72 72 + exit 1

+78

claudeio/test/test_incoming.ml

reviewed

··· 1 1 + (** Test the Incoming message codec *) 2 2 + 3 3 + open Claude 4 4 + 5 5 + let test_decode_user_message () = 6 6 + let json_str = {|{"type":"user","content":"Hello"}|} in 7 7 + match Jsont_bytesrw.decode_string' Incoming.jsont json_str with 8 8 + | Ok (Incoming.Message (Message.User _)) -> 9 9 + print_endline "✓ Decoded user message successfully" 10 10 + | Ok _ -> 11 11 + print_endline "✗ Wrong message type decoded" 12 12 + | Error err -> 13 13 + Printf.printf "✗ Failed to decode user message: %s\n" (Jsont.Error.to_string err) 14 14 + 15 15 + let test_decode_assistant_message () = 16 16 + let json_str = {|{"type":"assistant","model":"claude-sonnet-4","content":[{"type":"text","text":"Hi"}]}|} in 17 17 + match Jsont_bytesrw.decode_string' Incoming.jsont json_str with 18 18 + | Ok (Incoming.Message (Message.Assistant _)) -> 19 19 + print_endline "✓ Decoded assistant message successfully" 20 20 + | Ok _ -> 21 21 + print_endline "✗ Wrong message type decoded" 22 22 + | Error err -> 23 23 + Printf.printf "✗ Failed to decode assistant message: %s\n" (Jsont.Error.to_string err) 24 24 + 25 25 + let test_decode_system_message () = 26 26 + let json_str = {|{"type":"system","subtype":"init","data":{"session_id":"test-123"}}|} in 27 27 + match Jsont_bytesrw.decode_string' Incoming.jsont json_str with 28 28 + | Ok (Incoming.Message (Message.System _)) -> 29 29 + print_endline "✓ Decoded system message successfully" 30 30 + | Ok _ -> 31 31 + print_endline "✗ Wrong message type decoded" 32 32 + | Error err -> 33 33 + Printf.printf "✗ Failed to decode system message: %s\n" (Jsont.Error.to_string err) 34 34 + 35 35 + let test_decode_control_response () = 36 36 + let json_str = {|{"type":"control_response","response":{"subtype":"success","request_id":"test-req-1"}}|} in 37 37 + match Jsont_bytesrw.decode_string' Incoming.jsont json_str with 38 38 + | Ok (Incoming.Control_response resp) -> 39 39 + (match resp.response with 40 40 + | Sdk_control.Response.Success s -> 41 41 + if s.request_id = "test-req-1" then 42 42 + print_endline "✓ Decoded control response successfully" 43 43 + else 44 44 + Printf.printf "✗ Wrong request_id: %s\n" s.request_id 45 45 + | Sdk_control.Response.Error _ -> 46 46 + print_endline "✗ Got error response instead of success") 47 47 + | Ok _ -> 48 48 + print_endline "✗ Wrong message type decoded" 49 49 + | Error err -> 50 50 + Printf.printf "✗ Failed to decode control response: %s\n" (Jsont.Error.to_string err) 51 51 + 52 52 + let test_decode_control_response_error () = 53 53 + let json_str = {|{"type":"control_response","response":{"subtype":"error","request_id":"test-req-2","error":"Something went wrong"}}|} in 54 54 + match Jsont_bytesrw.decode_string' Incoming.jsont json_str with 55 55 + | Ok (Incoming.Control_response resp) -> 56 56 + (match resp.response with 57 57 + | Sdk_control.Response.Error e -> 58 58 + if e.request_id = "test-req-2" && e.error = "Something went wrong" then 59 59 + print_endline "✓ Decoded control error response successfully" 60 60 + else 61 61 + Printf.printf "✗ Wrong error content\n" 62 62 + | Sdk_control.Response.Success _ -> 63 63 + print_endline "✗ Got success response instead of error") 64 64 + | Ok _ -> 65 65 + print_endline "✗ Wrong message type decoded" 66 66 + | Error err -> 67 67 + Printf.printf "✗ Failed to decode control error response: %s\n" (Jsont.Error.to_string err) 68 68 + 69 69 + let () = 70 70 + print_endline "Testing Incoming message codec..."; 71 71 + print_endline ""; 72 72 + test_decode_user_message (); 73 73 + test_decode_assistant_message (); 74 74 + test_decode_system_message (); 75 75 + test_decode_control_response (); 76 76 + test_decode_control_response_error (); 77 77 + print_endline ""; 78 78 + print_endline "All tests completed!"

+41

claudeio/test/test_json_utils.ml

reviewed

··· 1 1 + (* Helper functions for JSON operations in tests *) 2 2 + 3 3 + let to_string ?(minify=false) json = 4 4 + let format = if minify then Jsont.Minify else Jsont.Indent in 5 5 + match Jsont_bytesrw.encode_string' ~format Jsont.json json with 6 6 + | Ok s -> s 7 7 + | Error err -> Jsont.Error.to_string err 8 8 + 9 9 + let get_field json key = 10 10 + match json with 11 11 + | Jsont.Object (members, _) -> 12 12 + List.find_map (fun ((name, _), value) -> 13 13 + if name = key then Some value else None 14 14 + ) members 15 15 + | _ -> None 16 16 + 17 17 + let get_string json key = 18 18 + match get_field json key with 19 19 + | Some (Jsont.String (s, _)) -> Some s 20 20 + | _ -> None 21 21 + 22 22 + let get_int json key = 23 23 + match get_field json key with 24 24 + | Some (Jsont.Number (f, _)) -> 25 25 + let i = int_of_float f in 26 26 + if float_of_int i = f then Some i else None 27 27 + | _ -> None 28 28 + 29 29 + let get_bool json key = 30 30 + match get_field json key with 31 31 + | Some (Jsont.Bool (b, _)) -> Some b 32 32 + | _ -> None 33 33 + 34 34 + let get_array json key = 35 35 + match get_field json key with 36 36 + | Some (Jsont.Array (items, _)) -> Some items 37 37 + | _ -> None 38 38 + 39 39 + let as_string = function 40 40 + | Jsont.String (s, _) -> Some s 41 41 + | _ -> None