My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1open Ezjsonm
2module JU = Json_utils
3
4let src = Logs.Src.create "claude.content_block" ~doc:"Claude content blocks"
5module Log = (val Logs.src_log src : Logs.LOG)
6
7
8module Text = struct
9 type t = { text : string }
10
11 let create text = { text }
12 let text t = t.text
13
14 let to_json t =
15 `O [("type", `String "text"); ("text", `String t.text)]
16
17 let of_json = function
18 | `O fields ->
19 let text = JU.assoc_string "text" fields in
20 { text }
21 | _ -> raise (Invalid_argument "Text.of_json: expected object")
22
23 let pp fmt t =
24 if String.length t.text > 60 then
25 let truncated = String.sub t.text 0 57 in
26 Fmt.pf fmt "Text[%s...]" truncated
27 else
28 Fmt.pf fmt "Text[%S]" t.text
29end
30
31module Tool_use = struct
32 module Input = struct
33 type t = value
34
35 let of_string_pairs pairs =
36 `O (List.map (fun (k, v) -> (k, `String v)) pairs)
37
38 let of_assoc assoc = `O assoc
39
40 let get_string t key = JU.get_field_string_opt t key
41
42 let get_int t key = JU.get_field_int_opt t key
43
44 let get_bool t key = JU.get_field_bool_opt t key
45
46 let get_float t key = JU.get_field_float_opt t key
47
48 let keys t =
49 match t with
50 | `O fields -> List.map fst fields
51 | _ -> []
52
53 let to_json t = t
54 let of_json json = json
55 end
56
57 type t = {
58 id : string;
59 name : string;
60 input : Input.t;
61 }
62
63 let create ~id ~name ~input = { id; name; input }
64 let id t = t.id
65 let name t = t.name
66 let input t = t.input
67
68 let to_json t =
69 `O [
70 ("type", `String "tool_use");
71 ("id", `String t.id);
72 ("name", `String t.name);
73 ("input", Input.to_json t.input);
74 ]
75
76 let of_json = function
77 | `O fields ->
78 let id = JU.assoc_string "id" fields in
79 let name = JU.assoc_string "name" fields in
80 let input = Input.of_json (List.assoc "input" fields) in
81 { id; name; input }
82 | _ -> raise (Invalid_argument "Tool_use.of_json: expected object")
83
84 let pp fmt t =
85 let keys = Input.keys t.input in
86 let key_info = match keys with
87 | [] -> ""
88 | [k] -> Printf.sprintf "(%s)" k
89 | ks -> Printf.sprintf "(%d params)" (List.length ks)
90 in
91 Fmt.pf fmt "Tool[%s%s]" t.name key_info
92end
93
94module Tool_result = struct
95 type t = {
96 tool_use_id : string;
97 content : string option;
98 is_error : bool option;
99 }
100
101 let create ~tool_use_id ?content ?is_error () =
102 { tool_use_id; content; is_error }
103
104 let tool_use_id t = t.tool_use_id
105 let content t = t.content
106 let is_error t = t.is_error
107
108 let to_json t =
109 let fields = [
110 ("type", `String "tool_result");
111 ("tool_use_id", `String t.tool_use_id);
112 ] in
113 let fields = match t.content with
114 | Some c -> ("content", `String c) :: fields
115 | None -> fields
116 in
117 let fields = match t.is_error with
118 | Some e -> ("is_error", `Bool e) :: fields
119 | None -> fields
120 in
121 `O fields
122
123 let of_json = function
124 | `O fields ->
125 let tool_use_id = JU.assoc_string "tool_use_id" fields in
126 let content =
127 match List.assoc_opt "content" fields with
128 | Some (`String s) -> Some s
129 | Some (`A blocks) ->
130 (* Handle content as array of blocks - extract text *)
131 let texts = List.filter_map (function
132 | `O block_fields ->
133 (match List.assoc_opt "type" block_fields with
134 | Some (`String "text") ->
135 (match List.assoc_opt "text" block_fields with
136 | Some (`String text) -> Some text
137 | _ -> None)
138 | _ -> None)
139 | _ -> None
140 ) blocks in
141 if texts = [] then None else Some (String.concat "\n" texts)
142 | _ -> None
143 in
144 let is_error = JU.assoc_bool_opt "is_error" fields in
145 { tool_use_id; content; is_error }
146 | _ -> raise (Invalid_argument "Tool_result.of_json: expected object")
147
148 let pp fmt t =
149 match t.is_error, t.content with
150 | Some true, Some c ->
151 if String.length c > 40 then
152 let truncated = String.sub c 0 37 in
153 Fmt.pf fmt "ToolResult[error: %s...]" truncated
154 else
155 Fmt.pf fmt "ToolResult[error: %s]" c
156 | _, Some c ->
157 if String.length c > 40 then
158 let truncated = String.sub c 0 37 in
159 Fmt.pf fmt "ToolResult[%s...]" truncated
160 else
161 Fmt.pf fmt "ToolResult[%s]" c
162 | _, None -> Fmt.pf fmt "ToolResult[empty]"
163end
164
165module Thinking = struct
166 type t = {
167 thinking : string;
168 signature : string;
169 }
170
171 let create ~thinking ~signature = { thinking; signature }
172 let thinking t = t.thinking
173 let signature t = t.signature
174
175 let to_json t =
176 `O [
177 ("type", `String "thinking");
178 ("thinking", `String t.thinking);
179 ("signature", `String t.signature);
180 ]
181
182 let of_json = function
183 | `O fields ->
184 let thinking = JU.assoc_string "thinking" fields in
185 let signature = JU.assoc_string "signature" fields in
186 { thinking; signature }
187 | _ -> raise (Invalid_argument "Thinking.of_json: expected object")
188
189 let pp fmt t =
190 if String.length t.thinking > 50 then
191 let truncated = String.sub t.thinking 0 47 in
192 Fmt.pf fmt "Thinking[%s...]" truncated
193 else
194 Fmt.pf fmt "Thinking[%s]" t.thinking
195end
196
197type t =
198 | Text of Text.t
199 | Tool_use of Tool_use.t
200 | Tool_result of Tool_result.t
201 | Thinking of Thinking.t
202
203let text s = Text (Text.create s)
204let tool_use ~id ~name ~input = Tool_use (Tool_use.create ~id ~name ~input)
205let tool_result ~tool_use_id ?content ?is_error () =
206 Tool_result (Tool_result.create ~tool_use_id ?content ?is_error ())
207let thinking ~thinking ~signature =
208 Thinking (Thinking.create ~thinking ~signature)
209
210let to_json = function
211 | Text t -> Text.to_json t
212 | Tool_use t -> Tool_use.to_json t
213 | Tool_result t -> Tool_result.to_json t
214 | Thinking t -> Thinking.to_json t
215
216let of_json json =
217 match json with
218 | `O fields -> (
219 match List.assoc_opt "type" fields with
220 | Some (`String "text") -> Text (Text.of_json json)
221 | Some (`String "tool_use") -> Tool_use (Tool_use.of_json json)
222 | Some (`String "tool_result") -> Tool_result (Tool_result.of_json json)
223 | Some (`String "thinking") -> Thinking (Thinking.of_json json)
224 | _ -> raise (Invalid_argument "Content_block.of_json: unknown type")
225 )
226 | _ -> raise (Invalid_argument "Content_block.of_json: expected object")
227
228let pp fmt = function
229 | Text t -> Text.pp fmt t
230 | Tool_use t -> Tool_use.pp fmt t
231 | Tool_result t -> Tool_result.pp fmt t
232 | Thinking t -> Thinking.pp fmt t
233
234let log_received t =
235 Log.debug (fun m -> m "Received content block: %a" pp t)
236
237let log_sending t =
238 Log.debug (fun m -> m "Sending content block: %a" pp t)