My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** MCP Content Block types *)
2
3(* Annotations *)
4
5module Audience = struct
6 type t = User | Assistant
7
8 let jsont : t Jsont.t =
9 Jsont.enum [
10 "user", User;
11 "assistant", Assistant;
12 ]
13
14 let pp fmt = function
15 | User -> Format.fprintf fmt "user"
16 | Assistant -> Format.fprintf fmt "assistant"
17end
18
19module Annotations = struct
20 type t = {
21 audience : Audience.t list option;
22 priority : float option;
23 unknown : Jsont.json;
24 }
25
26 let empty =
27 let unknown = Jsont.Object ([], Jsont.Meta.none) in
28 { audience = None; priority = None; unknown }
29
30 let jsont : t Jsont.t =
31 let make audience priority unknown = { audience; priority; unknown } in
32 Jsont.Object.map ~kind:"Annotations" make
33 |> Jsont.Object.opt_mem "audience" (Jsont.list Audience.jsont)
34 ~enc:(fun a -> a.audience)
35 |> Jsont.Object.opt_mem "priority" Jsont.number
36 ~enc:(fun a -> a.priority)
37 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun a -> a.unknown)
38 |> Jsont.Object.finish
39
40 let pp fmt _ann =
41 Format.fprintf fmt "{annotations}"
42end
43
44(* Text Content *)
45
46module Text = struct
47 type t = {
48 text : string;
49 annotations : Annotations.t option;
50 unknown : Jsont.json;
51 }
52
53 let make text =
54 let unknown = Jsont.Object ([], Jsont.Meta.none) in
55 { text; annotations = None; unknown }
56
57 let jsont : t Jsont.t =
58 let make text annotations unknown = { text; annotations; unknown } in
59 Jsont.Object.map ~kind:"TextContent" make
60 |> Jsont.Object.mem "text" Jsont.string ~enc:(fun t -> t.text)
61 |> Jsont.Object.opt_mem "annotations" Annotations.jsont
62 ~enc:(fun t -> t.annotations)
63 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)
64 |> Jsont.Object.finish
65
66 let pp fmt t =
67 Format.fprintf fmt "%S" t.text
68end
69
70(* Image Content *)
71
72module Image = struct
73 type t = {
74 data : string;
75 mime_type : string;
76 annotations : Annotations.t option;
77 unknown : Jsont.json;
78 }
79
80 let make ~data ~mime_type =
81 let unknown = Jsont.Object ([], Jsont.Meta.none) in
82 { data; mime_type; annotations = None; unknown }
83
84 let jsont : t Jsont.t =
85 let make data mime_type annotations unknown =
86 { data; mime_type; annotations; unknown }
87 in
88 Jsont.Object.map ~kind:"ImageContent" make
89 |> Jsont.Object.mem "data" Jsont.string ~enc:(fun i -> i.data)
90 |> Jsont.Object.mem "mimeType" Jsont.string ~enc:(fun i -> i.mime_type)
91 |> Jsont.Object.opt_mem "annotations" Annotations.jsont
92 ~enc:(fun i -> i.annotations)
93 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun i -> i.unknown)
94 |> Jsont.Object.finish
95
96 let pp fmt i =
97 Format.fprintf fmt "Image(%s, %d bytes)" i.mime_type (String.length i.data)
98end
99
100(* Audio Content *)
101
102module Audio = struct
103 type t = {
104 data : string;
105 mime_type : string;
106 annotations : Annotations.t option;
107 unknown : Jsont.json;
108 }
109
110 let make ~data ~mime_type =
111 let unknown = Jsont.Object ([], Jsont.Meta.none) in
112 { data; mime_type; annotations = None; unknown }
113
114 let jsont : t Jsont.t =
115 let make data mime_type annotations unknown =
116 { data; mime_type; annotations; unknown }
117 in
118 Jsont.Object.map ~kind:"AudioContent" make
119 |> Jsont.Object.mem "data" Jsont.string ~enc:(fun a -> a.data)
120 |> Jsont.Object.mem "mimeType" Jsont.string ~enc:(fun a -> a.mime_type)
121 |> Jsont.Object.opt_mem "annotations" Annotations.jsont
122 ~enc:(fun a -> a.annotations)
123 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun a -> a.unknown)
124 |> Jsont.Object.finish
125
126 let pp fmt a =
127 Format.fprintf fmt "Audio(%s, %d bytes)" a.mime_type (String.length a.data)
128end
129
130(* Embedded Resource *)
131
132module Embedded_resource = struct
133 type resource = {
134 uri : string;
135 mime_type : string option;
136 text : string option;
137 blob : string option;
138 unknown : Jsont.json;
139 }
140
141 let resource_jsont : resource Jsont.t =
142 let make uri mime_type text blob unknown =
143 { uri; mime_type; text; blob; unknown }
144 in
145 Jsont.Object.map ~kind:"Resource" make
146 |> Jsont.Object.mem "uri" Jsont.string ~enc:(fun r -> r.uri)
147 |> Jsont.Object.opt_mem "mimeType" Jsont.string ~enc:(fun r -> r.mime_type)
148 |> Jsont.Object.opt_mem "text" Jsont.string ~enc:(fun r -> r.text)
149 |> Jsont.Object.opt_mem "blob" Jsont.string ~enc:(fun r -> r.blob)
150 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)
151 |> Jsont.Object.finish
152
153 type t = {
154 resource : resource;
155 annotations : Annotations.t option;
156 unknown : Jsont.json;
157 }
158
159 let make_text ~uri ~text ?mime_type () =
160 let unknown = Jsont.Object ([], Jsont.Meta.none) in
161 let resource = {
162 uri;
163 mime_type;
164 text = Some text;
165 blob = None;
166 unknown;
167 } in
168 { resource; annotations = None; unknown }
169
170 let make_blob ~uri ~blob ~mime_type =
171 let unknown = Jsont.Object ([], Jsont.Meta.none) in
172 let resource = {
173 uri;
174 mime_type = Some mime_type;
175 text = None;
176 blob = Some blob;
177 unknown;
178 } in
179 { resource; annotations = None; unknown }
180
181 let jsont : t Jsont.t =
182 let make resource annotations unknown =
183 { resource; annotations; unknown }
184 in
185 Jsont.Object.map ~kind:"EmbeddedResource" make
186 |> Jsont.Object.mem "resource" resource_jsont ~enc:(fun e -> e.resource)
187 |> Jsont.Object.opt_mem "annotations" Annotations.jsont
188 ~enc:(fun e -> e.annotations)
189 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun e -> e.unknown)
190 |> Jsont.Object.finish
191
192 let pp fmt e =
193 Format.fprintf fmt "Resource(%s)" e.resource.uri
194end
195
196(* Content Block *)
197
198type block =
199 | Text of Text.t
200 | Image of Image.t
201 | Audio of Audio.t
202 | Embedded_resource of Embedded_resource.t
203
204let block_jsont : block Jsont.t =
205 (* Content blocks use "type" discriminator *)
206 let case_map kind obj dec = Jsont.Object.Case.map kind obj ~dec in
207
208 let case_text = case_map "text" Text.jsont (fun v -> Text v) in
209 let case_image = case_map "image" Image.jsont (fun v -> Image v) in
210 let case_audio = case_map "audio" Audio.jsont (fun v -> Audio v) in
211 let case_resource = case_map "resource" Embedded_resource.jsont
212 (fun v -> Embedded_resource v)
213 in
214
215 let enc_case = function
216 | Text v -> Jsont.Object.Case.value case_text v
217 | Image v -> Jsont.Object.Case.value case_image v
218 | Audio v -> Jsont.Object.Case.value case_audio v
219 | Embedded_resource v -> Jsont.Object.Case.value case_resource v
220 in
221
222 let cases = Jsont.Object.Case.[
223 make case_text;
224 make case_image;
225 make case_audio;
226 make case_resource;
227 ] in
228
229 Jsont.Object.map ~kind:"ContentBlock" Fun.id
230 |> Jsont.Object.case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases
231 ~tag_to_string:Fun.id ~tag_compare:String.compare
232 |> Jsont.Object.finish
233
234let pp_block fmt = function
235 | Text t -> Text.pp fmt t
236 | Image i -> Image.pp fmt i
237 | Audio a -> Audio.pp fmt a
238 | Embedded_resource e -> Embedded_resource.pp fmt e
239
240(* Convenience constructors *)
241
242let text s = Text (Text.make s)
243
244let image ~data ~mime_type = Image (Image.make ~data ~mime_type)
245
246let audio ~data ~mime_type = Audio (Audio.make ~data ~mime_type)