My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1let src = Logs.Src.create "claude.options" ~doc:"Claude configuration options"
2module Log = (val Logs.src_log src : Logs.LOG)
3
4type setting_source = User | Project | Local
5
6type mcp_stdio_config = {
7 command : string;
8 args : string list;
9 env : (string * string) list option;
10}
11
12type mcp_sse_config = {
13 url : string;
14 headers : (string * string) list option;
15}
16
17type mcp_http_config = {
18 url : string;
19 headers : (string * string) list option;
20}
21
22type mcp_server_config =
23 | Stdio of mcp_stdio_config
24 | SSE of mcp_sse_config
25 | HTTP of mcp_http_config
26
27module Unknown = struct
28 type t = Jsont.json
29 let empty = Jsont.Object ([], Jsont.Meta.none)
30 let _is_empty = function Jsont.Object ([], _) -> true | _ -> false
31 let _jsont = Jsont.json
32end
33
34type t = {
35 allowed_tools : string list;
36 disallowed_tools : string list;
37 max_thinking_tokens : int;
38 system_prompt : string option;
39 append_system_prompt : string option;
40 permission_mode : Permissions.Mode.t option;
41 permission_callback : Permissions.callback option;
42 model : Model.t option;
43 cwd : Eio.Fs.dir_ty Eio.Path.t option;
44 env : (string * string) list;
45 continue_conversation : bool;
46 resume : string option;
47 max_turns : int option;
48 permission_prompt_tool_name : string option;
49 settings : string option;
50 add_dirs : string list;
51 extra_args : (string * string option) list;
52 debug_stderr : Eio.Flow.sink_ty Eio.Flow.sink option;
53 hooks : Hooks.config option;
54 max_budget_usd : float option;
55 fallback_model : Model.t option;
56 setting_sources : setting_source list option;
57 max_buffer_size : int option;
58 user : string option;
59 output_format : Structured_output.t option;
60 mcp_servers : (string * mcp_server_config) list;
61 unknown : Unknown.t;
62}
63
64let default = {
65 allowed_tools = [];
66 disallowed_tools = [];
67 max_thinking_tokens = 8000;
68 system_prompt = None;
69 append_system_prompt = None;
70 permission_mode = None;
71 permission_callback = Some Permissions.default_allow_callback;
72 model = None;
73 cwd = None;
74 env = [];
75 continue_conversation = false;
76 resume = None;
77 max_turns = None;
78 permission_prompt_tool_name = None;
79 settings = None;
80 add_dirs = [];
81 extra_args = [];
82 debug_stderr = None;
83 hooks = None;
84 max_budget_usd = None;
85 fallback_model = None;
86 setting_sources = None;
87 max_buffer_size = None;
88 user = None;
89 output_format = None;
90 mcp_servers = [];
91 unknown = Unknown.empty;
92}
93
94let create
95 ?(allowed_tools = [])
96 ?(disallowed_tools = [])
97 ?(max_thinking_tokens = 8000)
98 ?system_prompt
99 ?append_system_prompt
100 ?permission_mode
101 ?permission_callback
102 ?model
103 ?cwd
104 ?(env = [])
105 ?(continue_conversation = false)
106 ?resume
107 ?max_turns
108 ?permission_prompt_tool_name
109 ?settings
110 ?(add_dirs = [])
111 ?(extra_args = [])
112 ?debug_stderr
113 ?hooks
114 ?max_budget_usd
115 ?fallback_model
116 ?setting_sources
117 ?max_buffer_size
118 ?user
119 ?output_format
120 ?(mcp_servers = [])
121 ?(unknown = Unknown.empty)
122 () =
123 { allowed_tools; disallowed_tools; max_thinking_tokens;
124 system_prompt; append_system_prompt; permission_mode;
125 permission_callback; model; cwd; env;
126 continue_conversation; resume; max_turns;
127 permission_prompt_tool_name; settings; add_dirs;
128 extra_args; debug_stderr; hooks;
129 max_budget_usd; fallback_model; setting_sources;
130 max_buffer_size; user; output_format; mcp_servers; unknown }
131
132let allowed_tools t = t.allowed_tools
133let disallowed_tools t = t.disallowed_tools
134let max_thinking_tokens t = t.max_thinking_tokens
135let system_prompt t = t.system_prompt
136let append_system_prompt t = t.append_system_prompt
137let permission_mode t = t.permission_mode
138let permission_callback t = t.permission_callback
139let model t = t.model
140let cwd t = t.cwd
141let env t = t.env
142let continue_conversation t = t.continue_conversation
143let resume t = t.resume
144let max_turns t = t.max_turns
145let permission_prompt_tool_name t = t.permission_prompt_tool_name
146let settings t = t.settings
147let add_dirs t = t.add_dirs
148let extra_args t = t.extra_args
149let debug_stderr t = t.debug_stderr
150let hooks t = t.hooks
151let max_budget_usd t = t.max_budget_usd
152let fallback_model t = t.fallback_model
153let setting_sources t = t.setting_sources
154let max_buffer_size t = t.max_buffer_size
155let user t = t.user
156let output_format t = t.output_format
157let mcp_servers t = t.mcp_servers
158let unknown t = t.unknown
159
160let with_allowed_tools tools t = { t with allowed_tools = tools }
161let with_disallowed_tools tools t = { t with disallowed_tools = tools }
162let with_max_thinking_tokens tokens t = { t with max_thinking_tokens = tokens }
163let with_system_prompt prompt t = { t with system_prompt = Some prompt }
164let with_append_system_prompt prompt t = { t with append_system_prompt = Some prompt }
165let with_permission_mode mode t = { t with permission_mode = Some mode }
166let with_permission_callback callback t = { t with permission_callback = Some callback }
167let with_model model t = { t with model = Some model }
168let with_model_string model t = { t with model = Some (Model.of_string model) }
169let with_cwd cwd t = { t with cwd = Some cwd }
170let with_env env t = { t with env }
171let with_continue_conversation continue t = { t with continue_conversation = continue }
172let with_resume session_id t = { t with resume = Some session_id }
173let with_max_turns turns t = { t with max_turns = Some turns }
174let with_permission_prompt_tool_name tool t = { t with permission_prompt_tool_name = Some tool }
175let with_settings path t = { t with settings = Some path }
176let with_add_dirs dirs t = { t with add_dirs = dirs }
177let with_extra_args args t = { t with extra_args = args }
178let with_debug_stderr sink t = { t with debug_stderr = Some sink }
179let with_hooks hooks t = { t with hooks = Some hooks }
180let with_max_budget_usd budget t = { t with max_budget_usd = Some budget }
181let with_fallback_model model t = { t with fallback_model = Some model }
182let with_fallback_model_string model t = { t with fallback_model = Some (Model.of_string model) }
183let with_setting_sources sources t = { t with setting_sources = Some sources }
184let with_no_settings t = { t with setting_sources = Some [] }
185let with_max_buffer_size size t = { t with max_buffer_size = Some size }
186let with_user user t = { t with user = Some user }
187let with_output_format format t = { t with output_format = Some format }
188
189let with_mcp_server ~name ~config t =
190 let servers = List.filter (fun (n, _) -> n <> name) t.mcp_servers in
191 { t with mcp_servers = (name, config) :: servers }
192
193let with_mcp_servers servers t = { t with mcp_servers = servers }
194
195let with_mcp_stdio ~name ~command ?(args = []) ?env () t =
196 let config = Stdio { command; args; env } in
197 with_mcp_server ~name ~config t
198
199(* Helper codec for Model.t *)
200let model_jsont : Model.t Jsont.t =
201 Jsont.map ~kind:"Model"
202 ~dec:Model.of_string
203 ~enc:Model.to_string
204 Jsont.string
205
206(* Helper codec for env - list of string pairs encoded as object.
207 Env is a dynamic object where all values should be strings.
208 Uses pattern matching to extract object members, then jsont for string decoding. *)
209let env_jsont : (string * string) list Jsont.t =
210 Jsont.map ~kind:"Env"
211 ~dec:(fun json ->
212 match json with
213 | Jsont.Object (members, _) ->
214 List.filter_map (fun ((name, _), value) ->
215 match Jsont.Json.decode Jsont.string value with
216 | Ok s -> Some (name, s)
217 | Error _ -> None
218 ) members
219 | _ -> [])
220 ~enc:(fun pairs ->
221 Jsont.Json.object' (List.map (fun (k, v) ->
222 Jsont.Json.mem (Jsont.Json.name k) (Jsont.Json.string v)
223 ) pairs))
224 Jsont.json
225
226(* Helper codec for headers - list of string pairs encoded as object *)
227let headers_jsont : (string * string) list Jsont.t =
228 Jsont.map ~kind:"Headers"
229 ~dec:(fun obj ->
230 match obj with
231 | Jsont.Object (members, _) ->
232 List.map (fun ((name, _), value) ->
233 match value with
234 | Jsont.String (s, _) -> (name, s)
235 | _ -> (name, "")
236 ) members
237 | _ -> [])
238 ~enc:(fun pairs ->
239 let mems = List.map (fun (k, v) ->
240 Jsont.Json.mem (Jsont.Json.name k) (Jsont.Json.string v)
241 ) pairs in
242 Jsont.Json.object' mems)
243 Jsont.json
244
245(* MCP server config codecs *)
246let mcp_stdio_config_jsont : mcp_stdio_config Jsont.t =
247 let make command args env : mcp_stdio_config = { command; args; env } in
248 Jsont.Object.map ~kind:"McpStdioConfig" make
249 |> Jsont.Object.mem "command" Jsont.string ~enc:(fun (c : mcp_stdio_config) -> c.command) ~dec_absent:""
250 |> Jsont.Object.mem "args" (Jsont.list Jsont.string) ~enc:(fun (c : mcp_stdio_config) -> c.args) ~dec_absent:[]
251 |> Jsont.Object.opt_mem "env" env_jsont ~enc:(fun (c : mcp_stdio_config) -> c.env)
252 |> Jsont.Object.finish
253
254let mcp_sse_config_jsont : mcp_sse_config Jsont.t =
255 let make url headers : mcp_sse_config = { url; headers } in
256 Jsont.Object.map ~kind:"McpSseConfig" make
257 |> Jsont.Object.mem "url" Jsont.string ~enc:(fun (c : mcp_sse_config) -> c.url) ~dec_absent:""
258 |> Jsont.Object.opt_mem "headers" headers_jsont ~enc:(fun (c : mcp_sse_config) -> c.headers)
259 |> Jsont.Object.finish
260
261let mcp_http_config_jsont : mcp_http_config Jsont.t =
262 let make url headers : mcp_http_config = { url; headers } in
263 Jsont.Object.map ~kind:"McpHttpConfig" make
264 |> Jsont.Object.mem "url" Jsont.string ~enc:(fun (c : mcp_http_config) -> c.url) ~dec_absent:""
265 |> Jsont.Object.opt_mem "headers" headers_jsont ~enc:(fun (c : mcp_http_config) -> c.headers)
266 |> Jsont.Object.finish
267
268let mcp_server_config_jsont : mcp_server_config Jsont.t =
269 Jsont.map ~kind:"McpServerConfig"
270 ~dec:(fun obj ->
271 match obj with
272 | Jsont.Object (members, _) ->
273 (* Look for type field to determine variant *)
274 let type_field = List.find_map (fun ((name, _), value) ->
275 if name = "type" then
276 match value with
277 | Jsont.String (s, _) -> Some s
278 | _ -> None
279 else None
280 ) members in
281 (match type_field with
282 | Some "stdio" ->
283 let config = Jsont.Json.decode mcp_stdio_config_jsont obj in
284 (match config with
285 | Ok cfg -> Stdio cfg
286 | Error _ -> Stdio { command = ""; args = []; env = None })
287 | Some "sse" ->
288 let config = Jsont.Json.decode mcp_sse_config_jsont obj in
289 (match config with
290 | Ok cfg -> SSE cfg
291 | Error _ -> SSE { url = ""; headers = None })
292 | Some "http" ->
293 let config = Jsont.Json.decode mcp_http_config_jsont obj in
294 (match config with
295 | Ok cfg -> HTTP cfg
296 | Error _ -> HTTP { url = ""; headers = None })
297 | _ -> Stdio { command = ""; args = []; env = None })
298 | _ -> Stdio { command = ""; args = []; env = None })
299 ~enc:(fun config ->
300 match config with
301 | Stdio cfg ->
302 let obj = Jsont.Json.encode mcp_stdio_config_jsont cfg in
303 (match obj with
304 | Ok (Jsont.Object (members, meta)) ->
305 let type_mem = Jsont.Json.mem (Jsont.Json.name "type") (Jsont.Json.string "stdio") in
306 Jsont.Object (type_mem :: members, meta)
307 | Ok json -> json
308 | Error _ -> Jsont.Object ([], Jsont.Meta.none))
309 | SSE cfg ->
310 let obj = Jsont.Json.encode mcp_sse_config_jsont cfg in
311 (match obj with
312 | Ok (Jsont.Object (members, meta)) ->
313 let type_mem = Jsont.Json.mem (Jsont.Json.name "type") (Jsont.Json.string "sse") in
314 Jsont.Object (type_mem :: members, meta)
315 | Ok json -> json
316 | Error _ -> Jsont.Object ([], Jsont.Meta.none))
317 | HTTP cfg ->
318 let obj = Jsont.Json.encode mcp_http_config_jsont cfg in
319 (match obj with
320 | Ok (Jsont.Object (members, meta)) ->
321 let type_mem = Jsont.Json.mem (Jsont.Json.name "type") (Jsont.Json.string "http") in
322 Jsont.Object (type_mem :: members, meta)
323 | Ok json -> json
324 | Error _ -> Jsont.Object ([], Jsont.Meta.none)))
325 Jsont.json
326
327(* Codec for MCP servers map - encoded as object with server names as keys *)
328let mcp_servers_jsont : (string * mcp_server_config) list Jsont.t =
329 Jsont.map ~kind:"McpServers"
330 ~dec:(fun obj ->
331 match obj with
332 | Jsont.Object (members, _) ->
333 List.filter_map (fun ((name, _), value) ->
334 match Jsont.Json.decode mcp_server_config_jsont value with
335 | Ok cfg -> Some (name, cfg)
336 | Error _ -> None
337 ) members
338 | _ -> [])
339 ~enc:(fun servers ->
340 let mems = List.map (fun (name, cfg) ->
341 match Jsont.Json.encode mcp_server_config_jsont cfg with
342 | Ok json -> Jsont.Json.mem (Jsont.Json.name name) json
343 | Error _ -> Jsont.Json.mem (Jsont.Json.name name) (Jsont.Object ([], Jsont.Meta.none))
344 ) servers in
345 Jsont.Json.object' mems)
346 Jsont.json
347
348let jsont : t Jsont.t =
349 let make allowed_tools disallowed_tools max_thinking_tokens
350 system_prompt append_system_prompt permission_mode
351 model env mcp_servers unknown =
352 { allowed_tools; disallowed_tools; max_thinking_tokens;
353 system_prompt; append_system_prompt; permission_mode;
354 permission_callback = Some Permissions.default_allow_callback;
355 model; cwd = None; env;
356 continue_conversation = false;
357 resume = None;
358 max_turns = None;
359 permission_prompt_tool_name = None;
360 settings = None;
361 add_dirs = [];
362 extra_args = [];
363 debug_stderr = None;
364 hooks = None;
365 max_budget_usd = None;
366 fallback_model = None;
367 setting_sources = None;
368 max_buffer_size = None;
369 user = None;
370 output_format = None;
371 mcp_servers;
372 unknown }
373 in
374 Jsont.Object.map ~kind:"Options" make
375 |> Jsont.Object.mem "allowed_tools" (Jsont.list Jsont.string) ~enc:allowed_tools ~dec_absent:[]
376 |> Jsont.Object.mem "disallowed_tools" (Jsont.list Jsont.string) ~enc:disallowed_tools ~dec_absent:[]
377 |> Jsont.Object.mem "max_thinking_tokens" Jsont.int ~enc:max_thinking_tokens ~dec_absent:8000
378 |> Jsont.Object.opt_mem "system_prompt" Jsont.string ~enc:system_prompt
379 |> Jsont.Object.opt_mem "append_system_prompt" Jsont.string ~enc:append_system_prompt
380 |> Jsont.Object.opt_mem "permission_mode" Permissions.Mode.jsont ~enc:permission_mode
381 |> Jsont.Object.opt_mem "model" model_jsont ~enc:model
382 |> Jsont.Object.mem "env" env_jsont ~enc:env ~dec_absent:[]
383 |> Jsont.Object.mem "mcp_servers" mcp_servers_jsont ~enc:mcp_servers ~dec_absent:[]
384 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown
385 |> Jsont.Object.finish
386
387let to_json t =
388 match Jsont.Json.encode jsont t with
389 | Ok json -> json
390 | Error msg -> failwith ("Options.to_json: " ^ msg)
391
392let of_json json =
393 match Jsont.Json.decode jsont json with
394 | Ok t -> t
395 | Error msg -> raise (Invalid_argument ("Options.of_json: " ^ msg))
396
397let pp fmt t =
398 Fmt.pf fmt "@[<v>Options {@ \
399 allowed_tools = %a;@ \
400 disallowed_tools = %a;@ \
401 max_thinking_tokens = %d;@ \
402 system_prompt = %a;@ \
403 append_system_prompt = %a;@ \
404 permission_mode = %a;@ \
405 model = %a;@ \
406 env = %a@ \
407 }@]"
408 Fmt.(list string) t.allowed_tools
409 Fmt.(list string) t.disallowed_tools
410 t.max_thinking_tokens
411 Fmt.(option string) t.system_prompt
412 Fmt.(option string) t.append_system_prompt
413 Fmt.(option Permissions.Mode.pp) t.permission_mode
414 Fmt.(option Model.pp) t.model
415 Fmt.(list (pair string string)) t.env
416
417let log_options t =
418 Log.debug (fun m -> m "Claude options: %a" pp t)