commit d65789e166d3ced20c402c20898ced2dfea8dc4e · anil.recoil.org/slop

-253

claudeio/TODO.md

···

       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

···

       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

···

       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)))

claudeio/lib/claude.ml

···

       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

claudeio/lib/claude.mli

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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