this repo has no description
more
+54
-142
+16
-19
stack/zulip/lib/zulip/lib/event_queue.ml
+16
-19
stack/zulip/lib/zulip/lib/event_queue.ml
···
52
52
module Events_response = struct
53
53
type t = { events : Event.t list }
54
54
55
-
(* Custom codec that handles Event.t which has its own of_json *)
56
55
let codec =
57
-
let kind = "EventsResponse" in
58
-
let of_string s =
59
-
match Jsont_bytesrw.decode_string' Jsont.json s with
60
-
| Error e -> Error (Jsont.Error.to_string e)
61
-
| Ok (Jsont.Object (fields, _)) ->
56
+
(* Use keep_unknown pattern to handle the whole object and extract events manually *)
57
+
let make raw_json =
58
+
match raw_json with
59
+
| Jsont.Object (fields, _) ->
62
60
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
63
61
(match List.assoc_opt "events" assoc with
64
-
| Some (Jsont.Array (event_list, _)) ->
65
-
let events = List.fold_left (fun acc event_json ->
66
-
match Event.of_json event_json with
62
+
| Some (Jsont.Array (items, _)) ->
63
+
(* Parse each event, skipping failures *)
64
+
let events = List.fold_left (fun acc item ->
65
+
match Event.of_json item with
67
66
| Ok event -> event :: acc
68
67
| Error _ -> acc
69
-
) [] event_list in
70
-
Ok { events = List.rev events }
71
-
| None -> Ok { events = [] }
72
-
| _ -> Error "events field is not an array")
73
-
| Ok _ -> Error "Expected JSON object"
68
+
) [] items |> List.rev in
69
+
{ events }
70
+
| Some _ -> { events = [] }
71
+
| None -> { events = [] })
72
+
| _ -> { events = [] }
74
73
in
75
-
let enc _t =
76
-
(* Not used for responses, but required by codec *)
77
-
Fmt.str "{\"events\": []}"
78
-
in
79
-
Jsont.of_of_string ~kind of_string ~enc
74
+
Jsont.Object.map ~kind:"EventsResponse" make
75
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun _ -> Jsont.Object ([], Jsont.Meta.none))
76
+
|> Jsont.Object.finish
80
77
end
81
78
82
79
let get_events t client ?last_event_id () =
+38
-123
stack/zulip/lib/zulip_bot/lib/message.ml
+38
-123
stack/zulip/lib/zulip_bot/lib/message.ml
···
20
20
21
21
(* Jsont codec for User - handles both user_id and id fields *)
22
22
let jsont : t Jsont.t =
23
-
let of_string s =
24
-
match Jsont_bytesrw.decode_string' Jsont.json s with
25
-
| Error _ -> Error "Failed to decode JSON"
26
-
| Ok json ->
27
-
match json with
28
-
| Jsont.Object (fields, _) ->
29
-
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
30
-
let user_id =
31
-
match List.assoc_opt "user_id" assoc with
32
-
| Some (Jsont.Number (f, _)) -> Some (int_of_float f)
33
-
| _ ->
34
-
match List.assoc_opt "id" assoc with
35
-
| Some (Jsont.Number (f, _)) -> Some (int_of_float f)
36
-
| _ -> None
37
-
in
38
-
let email =
39
-
match List.assoc_opt "email" assoc with
40
-
| Some (Jsont.String (s, _)) -> Some s
41
-
| _ -> None
42
-
in
43
-
let full_name =
44
-
match List.assoc_opt "full_name" assoc with
45
-
| Some (Jsont.String (s, _)) -> Some s
46
-
| _ -> None
47
-
in
48
-
let short_name =
49
-
match List.assoc_opt "short_name" assoc with
50
-
| Some (Jsont.String (s, _)) -> Some s
51
-
| _ -> None
52
-
in
53
-
(match (user_id, email, full_name) with
54
-
| (Some user_id, Some email, Some full_name) ->
55
-
(* Keep unknown fields *)
56
-
let unknown_fields = List.filter (fun (k, _) ->
57
-
k <> "user_id" && k <> "id" && k <> "email" && k <> "full_name" && k <> "short_name"
58
-
) assoc in
59
-
let unknown_mems = List.map (fun (k, v) -> ((k, Jsont.Meta.none), v)) unknown_fields in
60
-
let unknown = Jsont.Object (unknown_mems, Jsont.Meta.none) in
61
-
Ok { user_id; email; full_name; short_name; unknown }
62
-
| _ -> Error "Missing required user fields")
63
-
| _ -> Error "Expected JSON object for user"
23
+
let make email full_name short_name unknown =
24
+
(* user_id will be extracted in a custom way from the object *)
25
+
fun user_id_opt id_opt ->
26
+
let user_id = match user_id_opt, id_opt with
27
+
| Some uid, _ -> uid
28
+
| None, Some id -> id
29
+
| None, None -> Jsont.Error.msgf Jsont.Meta.none "Missing user_id or id field"
30
+
in
31
+
{ user_id; email; full_name; short_name; unknown }
64
32
in
65
-
let to_string { user_id; email; full_name; short_name; unknown } =
66
-
let fields = [
67
-
(("user_id", Jsont.Meta.none), Jsont.Number (float_of_int user_id, Jsont.Meta.none));
68
-
(("email", Jsont.Meta.none), Jsont.String (email, Jsont.Meta.none));
69
-
(("full_name", Jsont.Meta.none), Jsont.String (full_name, Jsont.Meta.none));
70
-
] in
71
-
let fields = match short_name with
72
-
| Some sn -> (("short_name", Jsont.Meta.none), Jsont.String (sn, Jsont.Meta.none)) :: fields
73
-
| None -> fields
74
-
in
75
-
let unknown_mems = match unknown with
76
-
| Jsont.Object (mems, _) -> mems
77
-
| _ -> []
78
-
in
79
-
let json = Jsont.Object (fields @ unknown_mems, Jsont.Meta.none) in
80
-
match Jsont_bytesrw.encode_string' Jsont.json json with
81
-
| Ok s -> s
82
-
| Error e -> failwith ("Failed to encode user: " ^ Jsont.Error.to_string e)
83
-
in
84
-
Jsont.of_of_string ~kind:"User" of_string ~enc:to_string
33
+
Jsont.Object.map ~kind:"User" make
34
+
|> Jsont.Object.mem "email" Jsont.string ~enc:email
35
+
|> Jsont.Object.mem "full_name" Jsont.string ~enc:full_name
36
+
|> Jsont.Object.opt_mem "short_name" Jsont.string ~enc:short_name
37
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)
38
+
|> Jsont.Object.opt_mem "user_id" Jsont.int ~enc:(fun t -> Some t.user_id)
39
+
|> Jsont.Object.opt_mem "id" Jsont.int ~enc:(fun _ -> None)
40
+
|> Jsont.Object.finish
85
41
86
42
let of_json (json : Zulip.json) : (t, Zulip.zerror) result =
87
43
match Zulip.Encode.from_json jsont json with
···
106
62
107
63
(* Jsont codec for Reaction - handles user_id in different locations *)
108
64
let jsont : t Jsont.t =
109
-
let of_string s =
110
-
match Jsont_bytesrw.decode_string' Jsont.json s with
111
-
| Error _ -> Error "Failed to decode JSON"
112
-
| Ok json ->
113
-
match json with
114
-
| Jsont.Object (fields, _) ->
115
-
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
116
-
let emoji_name =
117
-
match List.assoc_opt "emoji_name" assoc with
118
-
| Some (Jsont.String (s, _)) -> Some s
119
-
| _ -> None
120
-
in
121
-
let emoji_code =
122
-
match List.assoc_opt "emoji_code" assoc with
123
-
| Some (Jsont.String (s, _)) -> Some s
124
-
| _ -> None
125
-
in
126
-
let reaction_type =
127
-
match List.assoc_opt "reaction_type" assoc with
128
-
| Some (Jsont.String (s, _)) -> Some s
129
-
| _ -> None
130
-
in
131
-
(* user_id can be either directly in the object or nested in a "user" field *)
132
-
let user_id =
133
-
match List.assoc_opt "user_id" assoc with
134
-
| Some (Jsont.Number (f, _)) -> Some (int_of_float f)
135
-
| _ ->
136
-
match List.assoc_opt "user" assoc with
137
-
| Some (Jsont.Object (user_fields, _)) ->
138
-
let user_assoc = List.map (fun ((k, _), v) -> (k, v)) user_fields in
139
-
(match List.assoc_opt "user_id" user_assoc with
140
-
| Some (Jsont.Number (f, _)) -> Some (int_of_float f)
141
-
| _ -> None)
142
-
| _ -> None
143
-
in
144
-
(match (emoji_name, emoji_code, reaction_type, user_id) with
145
-
| (Some emoji_name, Some emoji_code, Some reaction_type, Some user_id) ->
146
-
(* Keep unknown fields *)
147
-
let unknown_fields = List.filter (fun (k, _) ->
148
-
k <> "emoji_name" && k <> "emoji_code" && k <> "reaction_type" && k <> "user_id" && k <> "user"
149
-
) assoc in
150
-
let unknown_mems = List.map (fun (k, v) -> ((k, Jsont.Meta.none), v)) unknown_fields in
151
-
let unknown = Jsont.Object (unknown_mems, Jsont.Meta.none) in
152
-
Ok { emoji_name; emoji_code; reaction_type; user_id; unknown }
153
-
| _ -> Error "Missing required reaction fields")
154
-
| _ -> Error "Expected JSON object for reaction"
65
+
(* Helper codec for nested user object - extracts just the user_id *)
66
+
let user_obj_codec =
67
+
Jsont.Object.map ~kind:"ReactionUser" Fun.id
68
+
|> Jsont.Object.mem "user_id" Jsont.int ~enc:Fun.id
69
+
|> Jsont.Object.finish
155
70
in
156
-
let to_string { emoji_name; emoji_code; reaction_type; user_id; unknown } =
157
-
let fields = [
158
-
(("emoji_name", Jsont.Meta.none), Jsont.String (emoji_name, Jsont.Meta.none));
159
-
(("emoji_code", Jsont.Meta.none), Jsont.String (emoji_code, Jsont.Meta.none));
160
-
(("reaction_type", Jsont.Meta.none), Jsont.String (reaction_type, Jsont.Meta.none));
161
-
(("user_id", Jsont.Meta.none), Jsont.Number (float_of_int user_id, Jsont.Meta.none));
162
-
] in
163
-
let unknown_mems = match unknown with
164
-
| Jsont.Object (mems, _) -> mems
165
-
| _ -> []
166
-
in
167
-
let json = Jsont.Object (fields @ unknown_mems, Jsont.Meta.none) in
168
-
match Jsont_bytesrw.encode_string' Jsont.json json with
169
-
| Ok s -> s
170
-
| Error e -> failwith ("Failed to encode reaction: " ^ Jsont.Error.to_string e)
71
+
let make emoji_name emoji_code reaction_type unknown =
72
+
fun user_id_direct user_obj_nested ->
73
+
let user_id = match user_id_direct, user_obj_nested with
74
+
| Some uid, _ -> uid
75
+
| None, Some uid -> uid
76
+
| None, None -> Jsont.Error.msgf Jsont.Meta.none "Missing user_id field"
77
+
in
78
+
{ emoji_name; emoji_code; reaction_type; user_id; unknown }
171
79
in
172
-
Jsont.of_of_string ~kind:"Reaction" of_string ~enc:to_string
80
+
Jsont.Object.map ~kind:"Reaction" make
81
+
|> Jsont.Object.mem "emoji_name" Jsont.string ~enc:emoji_name
82
+
|> Jsont.Object.mem "emoji_code" Jsont.string ~enc:emoji_code
83
+
|> Jsont.Object.mem "reaction_type" Jsont.string ~enc:reaction_type
84
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)
85
+
|> Jsont.Object.opt_mem "user_id" Jsont.int ~enc:(fun t -> Some t.user_id)
86
+
|> Jsont.Object.opt_mem "user" user_obj_codec ~enc:(fun _ -> None)
87
+
|> Jsont.Object.finish
173
88
174
89
let of_json (json : Zulip.json) : (t, Zulip.zerror) result =
175
90
match Zulip.Encode.from_json jsont json with