anil.recoil.org
OCaml Claude SDK using Eio and Jsont
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6let src = Logs.Src.create "claude.message" ~doc:"Claude messages"
7
8module Log = (val Logs.src_log src : Logs.LOG)
9
10module User = struct
11 type t = Proto.Message.User.t
12
13 let of_string s = Proto.Message.User.create_string s
14
15 let of_blocks blocks =
16 Proto.Message.User.create_blocks (List.map Content_block.to_proto blocks)
17
18 let with_tool_result ~tool_use_id ~content ?is_error () =
19 Proto.Message.User.create_with_tool_result ~tool_use_id ~content ?is_error
20 ()
21
22 let as_text t =
23 match Proto.Message.User.content t with
24 | Proto.Message.User.String s -> Some s
25 | Proto.Message.User.Blocks _ -> None
26
27 let blocks t =
28 match Proto.Message.User.content t with
29 | Proto.Message.User.String s -> [ Content_block.text s ]
30 | Proto.Message.User.Blocks bs -> List.map Content_block.of_proto bs
31
32 let of_proto proto = proto
33 let to_proto t = t
34
35 (* Internal wire format functions *)
36 let incoming_jsont = Proto.Message.User.incoming_jsont
37
38 let to_json t =
39 match Jsont.Json.encode Proto.Message.User.jsont t with
40 | Ok json -> json
41 | Error e -> invalid_arg ("User.to_json: " ^ e)
42end
43
44module Assistant = struct
45 type error = Proto.Message.Assistant.error
46 type t = Proto.Message.Assistant.t
47
48 let content t =
49 List.map Content_block.of_proto (Proto.Message.Assistant.content t)
50
51 let model t = Proto.Message.Assistant.model t
52 let error t = Proto.Message.Assistant.error t
53
54 let text_blocks t =
55 List.filter_map
56 (function
57 | Content_block.Text text -> Some (Content_block.Text.text text)
58 | _ -> None)
59 (content t)
60
61 let tool_uses t =
62 List.filter_map
63 (function Content_block.Tool_use tool -> Some tool | _ -> None)
64 (content t)
65
66 let thinking_blocks t =
67 List.filter_map
68 (function Content_block.Thinking thinking -> Some thinking | _ -> None)
69 (content t)
70
71 let has_tool_use t =
72 List.exists
73 (function Content_block.Tool_use _ -> true | _ -> false)
74 (content t)
75
76 let combined_text t = String.concat "\n" (text_blocks t)
77 let of_proto proto = proto
78 let to_proto t = t
79
80 (* Internal wire format functions *)
81 let incoming_jsont = Proto.Message.Assistant.incoming_jsont
82
83 let to_json t =
84 match Jsont.Json.encode Proto.Message.Assistant.jsont t with
85 | Ok json -> json
86 | Error e -> invalid_arg ("Assistant.to_json: " ^ e)
87end
88
89module System = struct
90 type t = Proto.Message.System.t
91
92 let is_init = function Proto.Message.System.Init _ -> true | _ -> false
93 let is_error = function Proto.Message.System.Error _ -> true | _ -> false
94 let session_id = Proto.Message.System.session_id
95 let model = Proto.Message.System.model
96 let cwd = Proto.Message.System.cwd
97 let error_message = Proto.Message.System.error_msg
98 let of_proto proto = proto
99 let to_proto t = t
100
101 (* Internal wire format functions *)
102 let jsont = Proto.Message.System.jsont
103
104 let to_json t =
105 match Jsont.Json.encode Proto.Message.System.jsont t with
106 | Ok json -> json
107 | Error e -> invalid_arg ("System.to_json: " ^ e)
108end
109
110module Result = struct
111 module Usage = struct
112 type t = Proto.Message.Result.Usage.t
113
114 let input_tokens = Proto.Message.Result.Usage.input_tokens
115 let output_tokens = Proto.Message.Result.Usage.output_tokens
116 let total_tokens = Proto.Message.Result.Usage.total_tokens
117
118 let cache_creation_input_tokens =
119 Proto.Message.Result.Usage.cache_creation_input_tokens
120
121 let cache_read_input_tokens =
122 Proto.Message.Result.Usage.cache_read_input_tokens
123
124 let of_proto proto = proto
125 end
126
127 type t = Proto.Message.Result.t
128
129 let duration_ms = Proto.Message.Result.duration_ms
130 let duration_api_ms = Proto.Message.Result.duration_api_ms
131 let is_error = Proto.Message.Result.is_error
132 let num_turns = Proto.Message.Result.num_turns
133 let session_id = Proto.Message.Result.session_id
134 let total_cost_usd = Proto.Message.Result.total_cost_usd
135 let usage t = Option.map Usage.of_proto (Proto.Message.Result.usage t)
136 let result_text = Proto.Message.Result.result
137 let structured_output = Proto.Message.Result.structured_output
138 let of_proto proto = proto
139 let to_proto t = t
140
141 (* Internal wire format functions *)
142 let jsont = Proto.Message.Result.jsont
143
144 let to_json t =
145 match Jsont.Json.encode Proto.Message.Result.jsont t with
146 | Ok json -> json
147 | Error e -> invalid_arg ("Result.to_json: " ^ e)
148end
149
150type t =
151 | User of User.t
152 | Assistant of Assistant.t
153 | System of System.t
154 | Result of Result.t
155
156let of_proto = function
157 | Proto.Message.User u -> User (User.of_proto u)
158 | Proto.Message.Assistant a -> Assistant (Assistant.of_proto a)
159 | Proto.Message.System s -> System (System.of_proto s)
160 | Proto.Message.Result r -> Result (Result.of_proto r)
161
162let to_proto = function
163 | User u -> Proto.Message.User (User.to_proto u)
164 | Assistant a -> Proto.Message.Assistant (Assistant.to_proto a)
165 | System s -> Proto.Message.System (System.to_proto s)
166 | Result r -> Proto.Message.Result (Result.to_proto r)
167
168let is_user = function User _ -> true | _ -> false
169let is_assistant = function Assistant _ -> true | _ -> false
170let is_system = function System _ -> true | _ -> false
171let is_result = function Result _ -> true | _ -> false
172
173let is_error = function
174 | Result r -> Result.is_error r
175 | System s -> System.is_error s
176 | _ -> false
177
178let extract_text = function
179 | User u -> User.as_text u
180 | Assistant a ->
181 let text = Assistant.combined_text a in
182 if text = "" then None else Some text
183 | _ -> None
184
185let extract_tool_uses = function
186 | Assistant a -> Assistant.tool_uses a
187 | _ -> []
188
189let get_session_id = function
190 | System s -> System.session_id s
191 | Result r -> Some (Result.session_id r)
192 | _ -> None
193
194(* Wire format conversion *)
195let to_json = function
196 | User u -> User.to_json u
197 | Assistant a -> Assistant.to_json a
198 | System s -> System.to_json s
199 | Result r -> Result.to_json r
200
201(* Convenience constructors *)
202let user_string s = User (User.of_string s)
203let user_blocks blocks = User (User.of_blocks blocks)
204let pp fmt t = Jsont.pp_value Proto.Message.jsont () fmt (to_proto t)
205let log_received t = Log.info (fun m -> m "← %a" pp t)
206let log_sending t = Log.info (fun m -> m "→ %a" pp t)