jon.recoil.org
forked from
anil.recoil.org/ocaml-jmap
this repo has no description
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6type result_reference = {
7 result_of : string;
8 name : string;
9 path : Json_pointer.Jmap.t;
10}
11
12let result_reference ~result_of ~name ~path =
13 { result_of; name; path }
14
15let result_reference_of_strings ~result_of ~name ~path =
16 { result_of; name; path = Json_pointer.Jmap.of_string path }
17
18let result_reference_make result_of name path =
19 { result_of; name; path }
20
21let result_reference_jsont =
22 let kind = "ResultReference" in
23 Jsont.Object.map ~kind result_reference_make
24 |> Jsont.Object.mem "resultOf" Jsont.string ~enc:(fun r -> r.result_of)
25 |> Jsont.Object.mem "name" Jsont.string ~enc:(fun r -> r.name)
26 |> Jsont.Object.mem "path" Json_pointer.Jmap.jsont ~enc:(fun r -> r.path)
27 |> Jsont.Object.finish
28
29(* Result reference resolution *)
30
31let find_response ref ~responses =
32 List.find_map (fun (call_id, name, json) ->
33 if call_id = ref.result_of && name = ref.name
34 then Some json
35 else None
36 ) responses
37
38let resolve ref ~responses codec =
39 match find_response ref ~responses with
40 | None ->
41 Jsont.Error.msgf Jsont.Meta.none
42 "Result reference: no response found for resultOf=%s name=%s"
43 ref.result_of ref.name
44 | Some json ->
45 let extraction_codec = Json_pointer.Jmap.path ref.path codec in
46 match Jsont.Json.decode' extraction_codec json with
47 | Ok v -> v
48 | Error e -> raise (Jsont.Error e)
49
50let resolve_ids ref ~responses =
51 resolve ref ~responses (Jsont.list Jsont.string)
52
53type t = {
54 name : string;
55 arguments : Jsont.json;
56 method_call_id : string;
57}
58
59let create ~name ~arguments ~method_call_id =
60 { name; arguments; method_call_id }
61
62let name t = t.name
63let arguments t = t.arguments
64let method_call_id t = t.method_call_id
65
66(* Helper to encode a typed value back to Jsont.json *)
67let encode_json_value jsont value =
68 match Jsont.Json.encode' jsont value with
69 | Ok json -> json
70 | Error _ -> Jsont.Object ([], Jsont.Meta.none)
71
72let jsont =
73 let kind = "Invocation" in
74 (* Invocation is [name, args, callId] - a 3-element heterogeneous array *)
75 (* We need to handle this as a json array since elements have different types *)
76 let dec json =
77 match json with
78 | Jsont.Array ([name_json; arguments; call_id_json], _) ->
79 let name = match name_json with
80 | Jsont.String (s, _) -> s
81 | _ -> Jsont.Error.msg Jsont.Meta.none "Invocation[0] must be a string"
82 in
83 let method_call_id = match call_id_json with
84 | Jsont.String (s, _) -> s
85 | _ -> Jsont.Error.msg Jsont.Meta.none "Invocation[2] must be a string"
86 in
87 { name; arguments; method_call_id }
88 | Jsont.Array _ ->
89 Jsont.Error.msg Jsont.Meta.none "Invocation must be a 3-element array"
90 | _ ->
91 Jsont.Error.msg Jsont.Meta.none "Invocation must be an array"
92 in
93 let enc t =
94 Jsont.Array ([
95 Jsont.String (t.name, Jsont.Meta.none);
96 t.arguments;
97 Jsont.String (t.method_call_id, Jsont.Meta.none);
98 ], Jsont.Meta.none)
99 in
100 Jsont.map ~kind ~dec ~enc Jsont.json
101
102let make_get ~method_call_id ~method_name args =
103 let arguments = encode_json_value Proto_method.get_args_jsont args in
104 { name = method_name; arguments; method_call_id }
105
106let make_changes ~method_call_id ~method_name args =
107 let arguments = encode_json_value Proto_method.changes_args_jsont args in
108 { name = method_name; arguments; method_call_id }
109
110let make_query (type f) ~method_call_id ~method_name
111 ~(filter_cond_jsont : f Jsont.t) (args : f Proto_method.query_args) =
112 let arguments = encode_json_value (Proto_method.query_args_jsont filter_cond_jsont) args in
113 { name = method_name; arguments; method_call_id }