My agentic slop goes here. Not intended for anyone else!
1let src = Logs.Src.create "claude.control" ~doc:"Claude control messages"
2module Log = (val Logs.src_log src : Logs.LOG)
3
4(* Helper for pretty-printing JSON *)
5let pp_json fmt json =
6 let s = match Jsont_bytesrw.encode_string' Jsont.json json with
7 | Ok s -> s
8 | Error err -> Jsont.Error.to_string err
9 in
10 Fmt.string fmt s
11
12type t = {
13 request_id : string;
14 subtype : string;
15 data : Jsont.json;
16 unknown : Unknown.t;
17}
18
19let jsont =
20 Jsont.Object.map ~kind:"Control"
21 (fun request_id subtype data unknown -> {request_id; subtype; data; unknown})
22 |> Jsont.Object.mem "request_id" Jsont.string ~enc:(fun t -> t.request_id)
23 |> Jsont.Object.mem "subtype" Jsont.string ~enc:(fun t -> t.subtype)
24 |> Jsont.Object.mem "data" Jsont.json ~enc:(fun t -> t.data)
25 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)
26 |> Jsont.Object.finish
27
28let create ~request_id ~subtype ~data =
29 { request_id; subtype; data; unknown = Unknown.empty }
30
31let request_id t = t.request_id
32let subtype t = t.subtype
33let data t = t.data
34
35let to_json t =
36 match Jsont_bytesrw.encode_string ~format:Jsont.Minify jsont t with
37 | Ok s ->
38 (match Jsont_bytesrw.decode_string' Jsont.json s with
39 | Ok json -> json
40 | Error e -> failwith (Jsont.Error.to_string e))
41 | Error e -> failwith e
42
43let of_json json =
44 match Jsont_bytesrw.encode_string ~format:Jsont.Minify Jsont.json json with
45 | Ok s ->
46 (match Jsont_bytesrw.decode_string jsont s with
47 | Ok t -> t
48 | Error e -> raise (Invalid_argument ("Control.of_json: " ^ e)))
49 | Error e -> raise (Invalid_argument ("Control.of_json: " ^ e))
50
51let pp fmt t =
52 Fmt.pf fmt "@[<2>Control@ { request_id = %S;@ subtype = %S;@ data = %a }@]"
53 t.request_id t.subtype pp_json t.data
54
55let log_received t =
56 Log.debug (fun m -> m "Received control message: %a" pp t)
57
58let log_sending t =
59 Log.debug (fun m -> m "Sending control message: %a" pp t)