+8 -1

examples/dune

··· 14 14 (public_name echo_bot) 15 15 (name echo_bot) 16 16 (package zulip_bot) 17 17 - (libraries zulip zulip_bot eio_main cmdliner logs logs.fmt mirage-crypto-rng.unix)) 17 17 + (libraries 18 18 + zulip 19 19 + zulip_bot 20 20 + eio_main 21 21 + cmdliner 22 22 + logs 23 23 + logs.fmt 24 24 + mirage-crypto-rng.unix)) 18 25 19 26 (executable 20 27 (public_name test_realtime_bot)

+1 -1

lib/dune

··· 1 1 - (dirs zulip zulip_bot zulip_botserver) 1 1 + (dirs zulip zulip_bot zulip_botserver)

+38 -105

lib/zulip/channels.ml

··· 1 1 + let streams_codec = 2 2 + Jsont.Object.( 3 3 + map ~kind:"StreamsResponse" Fun.id 4 4 + |> mem "streams" (Jsont.list Channel.jsont) ~enc:Fun.id 5 5 + |> finish) 6 6 + 1 7 let list client = 2 2 - let response_codec = 3 3 - Jsont.Object.( 4 4 - map ~kind:"StreamsResponse" (fun streams -> streams) 5 5 - |> mem "streams" (Jsont.list Channel.jsont) ~enc:(fun x -> x) 6 6 - |> finish) 7 7 - in 8 8 let json = Client.request client ~method_:`GET ~path:"/api/v1/streams" () in 9 9 - match Encode.from_json response_codec json with 10 10 - | Ok channels -> channels 11 11 - | Error msg -> 12 12 - Error.raise_with_context 13 13 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 14 14 - "parsing channels list" 9 9 + Error.decode_or_raise streams_codec json "parsing channels list" 15 10 16 11 let list_all client ?include_public ?include_web_public ?include_subscribed 17 12 ?include_all_active ?include_default ?include_owner_subscribed () = ··· 19 14 List.filter_map Fun.id 20 15 [ 21 16 Option.map (fun v -> ("include_public", string_of_bool v)) include_public; 22 22 - Option.map 23 23 - (fun v -> ("include_web_public", string_of_bool v)) 24 24 - include_web_public; 25 25 - Option.map 26 26 - (fun v -> ("include_subscribed", string_of_bool v)) 27 27 - include_subscribed; 28 28 - Option.map 29 29 - (fun v -> ("include_all_active", string_of_bool v)) 30 30 - include_all_active; 31 31 - Option.map 32 32 - (fun v -> ("include_default", string_of_bool v)) 33 33 - include_default; 34 34 - Option.map 35 35 - (fun v -> ("include_owner_subscribed", string_of_bool v)) 36 36 - include_owner_subscribed; 17 17 + Option.map (fun v -> ("include_web_public", string_of_bool v)) include_web_public; 18 18 + Option.map (fun v -> ("include_subscribed", string_of_bool v)) include_subscribed; 19 19 + Option.map (fun v -> ("include_all_active", string_of_bool v)) include_all_active; 20 20 + Option.map (fun v -> ("include_default", string_of_bool v)) include_default; 21 21 + Option.map (fun v -> ("include_owner_subscribed", string_of_bool v)) include_owner_subscribed; 37 22 ] 38 38 - in 39 39 - let response_codec = 40 40 - Jsont.Object.( 41 41 - map ~kind:"StreamsResponse" (fun streams -> streams) 42 42 - |> mem "streams" (Jsont.list Channel.jsont) ~enc:(fun x -> x) 43 43 - |> finish) 44 23 in 45 24 let json = 46 25 Client.request client ~method_:`GET ~path:"/api/v1/streams" ~params () 47 26 in 48 48 - match Encode.from_json response_codec json with 49 49 - | Ok channels -> channels 50 50 - | Error msg -> 51 51 - Error.raise_with_context 52 52 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 53 53 - "parsing channels list" 27 27 + Error.decode_or_raise streams_codec json "parsing channels list" 54 28 55 29 let get_id client ~name = 56 30 let encoded_name = Uri.pct_encode name in 57 31 let response_codec = 58 32 Jsont.Object.( 59 59 - map ~kind:"StreamIdResponse" (fun id -> id) 60 60 - |> mem "stream_id" Jsont.int ~enc:(fun x -> x) 33 33 + map ~kind:"StreamIdResponse" Fun.id 34 34 + |> mem "stream_id" Jsont.int ~enc:Fun.id 61 35 |> finish) 62 36 in 63 37 let json = ··· 65 39 ~path:("/api/v1/get_stream_id?stream=" ^ encoded_name) 66 40 () 67 41 in 68 68 - match Encode.from_json response_codec json with 69 69 - | Ok id -> id 70 70 - | Error msg -> 71 71 - Error.raise_with_context 72 72 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 73 73 - "getting stream id for %s" name 42 42 + Error.decode_or_raise response_codec json (Printf.sprintf "getting stream id for %s" name) 74 43 75 44 let get_by_id client ~stream_id = 76 45 let response_codec = 77 46 Jsont.Object.( 78 78 - map ~kind:"StreamResponse" (fun stream -> stream) 79 79 - |> mem "stream" Channel.jsont ~enc:(fun x -> x) 47 47 + map ~kind:"StreamResponse" Fun.id 48 48 + |> mem "stream" Channel.jsont ~enc:Fun.id 80 49 |> finish) 81 50 in 82 51 let json = ··· 84 53 ~path:("/api/v1/streams/" ^ string_of_int stream_id) 85 54 () 86 55 in 87 87 - match Encode.from_json response_codec json with 88 88 - | Ok channel -> channel 89 89 - | Error msg -> 90 90 - Error.raise_with_context 91 91 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 92 92 - "getting stream %d" stream_id 56 56 + Error.decode_or_raise response_codec json (Printf.sprintf "getting stream %d" stream_id) 93 57 94 58 type create_options = { 95 59 name : string; ··· 292 256 let get_subscriptions client = 293 257 let response_codec = 294 258 Jsont.Object.( 295 295 - map ~kind:"SubscriptionsResponse" (fun subs -> subs) 296 296 - |> mem "subscriptions" (Jsont.list Channel.Subscription.jsont) 297 297 - ~enc:(fun x -> x) 259 259 + map ~kind:"SubscriptionsResponse" Fun.id 260 260 + |> mem "subscriptions" (Jsont.list Channel.Subscription.jsont) ~enc:Fun.id 298 261 |> finish) 299 262 in 300 263 let json = 301 264 Client.request client ~method_:`GET ~path:"/api/v1/users/me/subscriptions" 302 265 () 303 266 in 304 304 - match Encode.from_json response_codec json with 305 305 - | Ok subs -> subs 306 306 - | Error msg -> 307 307 - Error.raise_with_context 308 308 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 309 309 - "parsing subscriptions" 267 267 + Error.decode_or_raise response_codec json "parsing subscriptions" 310 268 311 269 let get_subscription_status client ~user_id ~stream_id = 312 270 let response_codec = 313 271 Jsont.Object.( 314 314 - map ~kind:"SubscriptionStatusResponse" (fun status -> status) 315 315 - |> mem "is_subscribed" Jsont.bool ~enc:(fun x -> x) 272 272 + map ~kind:"SubscriptionStatusResponse" Fun.id 273 273 + |> mem "is_subscribed" Jsont.bool ~enc:Fun.id 316 274 |> finish) 317 275 in 318 276 let json = ··· 322 280 ^ string_of_int stream_id) 323 281 () 324 282 in 325 325 - match Encode.from_json response_codec json with 326 326 - | Ok status -> status 327 327 - | Error msg -> 328 328 - Error.raise_with_context 329 329 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 330 330 - "checking subscription status" 283 283 + Error.decode_or_raise response_codec json "checking subscription status" 331 284 332 285 let update_subscription_settings client ~stream_id ?color ?is_muted ?pin_to_top 333 286 ?desktop_notifications ?audible_notifications ?push_notifications ··· 395 348 let get_topics client ~stream_id = 396 349 let response_codec = 397 350 Jsont.Object.( 398 398 - map ~kind:"TopicsResponse" (fun topics -> topics) 399 399 - |> mem "topics" (Jsont.list Topic.jsont) ~enc:(fun x -> x) 351 351 + map ~kind:"TopicsResponse" Fun.id 352 352 + |> mem "topics" (Jsont.list Topic.jsont) ~enc:Fun.id 400 353 |> finish) 401 354 in 402 355 let json = ··· 404 357 ~path:("/api/v1/users/me/" ^ string_of_int stream_id ^ "/topics") 405 358 () 406 359 in 407 407 - match Encode.from_json response_codec json with 408 408 - | Ok topics -> topics 409 409 - | Error msg -> 410 410 - Error.raise_with_context 411 411 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 412 412 - "getting topics for stream %d" stream_id 360 360 + Error.decode_or_raise response_codec json (Printf.sprintf "getting topics for stream %d" stream_id) 413 361 414 362 let delete_topic client ~stream_id ~topic = 415 363 let params = [ ("topic_name", topic) ] in ··· 439 387 let get_muted_topics client = 440 388 let response_codec = 441 389 Jsont.Object.( 442 442 - map ~kind:"MutedTopicsResponse" (fun topics -> topics) 390 390 + map ~kind:"MutedTopicsResponse" Fun.id 443 391 |> mem "muted_topics" 444 392 (Jsont.list 445 393 (Jsont.Object.( ··· 447 395 (stream_id, topic)) 448 396 |> mem "stream_id" Jsont.int ~enc:fst 449 397 |> mem "topic_name" Jsont.string ~enc:snd 450 450 - |> mem "date_muted" Jsont.int ~dec_absent:0 ~enc:(fun _ -> 0) 398 398 + |> mem "date_muted" Jsont.int ~dec_absent:0 ~enc:(Fun.const 0) 451 399 |> finish))) 452 452 - ~enc:(fun x -> x) 400 400 + ~enc:Fun.id 453 401 |> finish) 454 402 in 455 403 let json = 456 404 Client.request client ~method_:`GET 457 405 ~path:"/api/v1/users/me/subscriptions/muted_topics" () 458 406 in 459 459 - match Encode.from_json response_codec json with 460 460 - | Ok topics -> topics 461 461 - | Error msg -> 462 462 - Error.raise_with_context 463 463 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 464 464 - "getting muted topics" 407 407 + Error.decode_or_raise response_codec json "getting muted topics" 465 408 466 409 let get_subscribers client ~stream_id = 467 410 let response_codec = 468 411 Jsont.Object.( 469 469 - map ~kind:"SubscribersResponse" (fun subs -> subs) 470 470 - |> mem "subscribers" (Jsont.list Jsont.int) ~enc:(fun x -> x) 412 412 + map ~kind:"SubscribersResponse" Fun.id 413 413 + |> mem "subscribers" (Jsont.list Jsont.int) ~enc:Fun.id 471 414 |> finish) 472 415 in 473 416 let json = ··· 475 418 ~path:("/api/v1/streams/" ^ string_of_int stream_id ^ "/members") 476 419 () 477 420 in 478 478 - match Encode.from_json response_codec json with 479 479 - | Ok subs -> subs 480 480 - | Error msg -> 481 481 - Error.raise_with_context 482 482 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 483 483 - "getting subscribers for stream %d" stream_id 421 421 + Error.decode_or_raise response_codec json (Printf.sprintf "getting subscribers for stream %d" stream_id) 484 422 485 423 let get_email_address client ~stream_id = 486 424 let response_codec = 487 425 Jsont.Object.( 488 488 - map ~kind:"EmailAddressResponse" (fun email -> email) 489 489 - |> mem "email" Jsont.string ~enc:(fun x -> x) 426 426 + map ~kind:"EmailAddressResponse" Fun.id 427 427 + |> mem "email" Jsont.string ~enc:Fun.id 490 428 |> finish) 491 429 in 492 430 let json = ··· 494 432 ~path:("/api/v1/streams/" ^ string_of_int stream_id ^ "/email_address") 495 433 () 496 434 in 497 497 - match Encode.from_json response_codec json with 498 498 - | Ok email -> email 499 499 - | Error msg -> 500 500 - Error.raise_with_context 501 501 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 502 502 - "getting email address for stream %d" stream_id 435 435 + Error.decode_or_raise response_codec json (Printf.sprintf "getting email address for stream %d" stream_id)

+19 -27

lib/zulip/client.ml

··· 40 40 41 41 (* Convert params to URL query string if provided *) 42 42 let url = 43 43 - match params with 44 44 - | Some p -> 45 45 - let uri = Uri.of_string url in 46 46 - let uri = 47 47 - List.fold_left (fun u (k, v) -> Uri.add_query_param' u (k, v)) uri p 48 48 - in 49 49 - Uri.to_string uri 50 50 - | None -> url 43 43 + params 44 44 + |> Option.map (fun p -> 45 45 + Uri.of_string url 46 46 + |> Fun.flip (List.fold_left (fun u (k, v) -> Uri.add_query_param' u (k, v))) p 47 47 + |> Uri.to_string) 48 48 + |> Option.value ~default:url 51 49 in 52 50 53 51 (* Prepare request body if provided *) 54 52 let body_opt = 55 55 - match body with 56 56 - | Some body_str -> 57 57 - let mime = 58 58 - match content_type with 59 59 - | Some ct when String.starts_with ~prefix:"multipart/form-data" ct -> 60 60 - (* Custom Content-Type for multipart *) 61 61 - Requests.Mime.of_string ct 62 62 - | Some "application/json" -> Requests.Mime.json 63 63 - | Some "application/x-www-form-urlencoded" | None -> 64 64 - (* Default for form data *) 65 65 - if 66 66 - String.contains body_str '=' 67 67 - && not (String.contains body_str '{') 68 68 - then Requests.Mime.form 69 69 - else Requests.Mime.json 70 70 - | Some ct -> Requests.Mime.of_string ct 71 71 - in 72 72 - Some (Requests.Body.of_string mime body_str) 73 73 - | None -> None 53 53 + body |> Option.map (fun body_str -> 54 54 + let mime = 55 55 + match content_type with 56 56 + | Some ct when String.starts_with ~prefix:"multipart/form-data" ct -> 57 57 + Requests.Mime.of_string ct 58 58 + | Some "application/json" -> Requests.Mime.json 59 59 + | Some "application/x-www-form-urlencoded" | None -> 60 60 + if String.contains body_str '=' && not (String.contains body_str '{') 61 61 + then Requests.Mime.form 62 62 + else Requests.Mime.json 63 63 + | Some ct -> Requests.Mime.of_string ct 64 64 + in 65 65 + Requests.Body.of_string mime body_str) 74 66 in 75 67 76 68 (* Make the request *)

+16 -9

lib/zulip/error.ml

··· 78 78 |> finish) 79 79 80 80 let of_json json = 81 81 - match Encode.from_json jsont json with 82 82 - | Ok err -> ( 81 81 + Encode.from_json jsont json 82 82 + |> Result.to_option 83 83 + |> Option.map (fun err -> 83 84 match json with 84 85 | Jsont.Object (fields, _) -> 85 85 - let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in 86 86 let extra = 87 87 - List.filter 88 88 - (fun (k, _) -> k <> "code" && k <> "msg" && k <> "result") 89 89 - assoc 87 87 + fields 88 88 + |> List.map (fun ((k, _), v) -> (k, v)) 89 89 + |> List.filter (fun (k, _) -> k <> "code" && k <> "msg" && k <> "result") 90 90 in 91 91 - Some { err with extra } 92 92 - | _ -> Some err) 93 93 - | Error _ -> None 91 91 + { err with extra } 92 92 + | _ -> err) 93 93 + 94 94 + let decode_or_raise codec json context = 95 95 + match Encode.from_json codec json with 96 96 + | Ok v -> v 97 97 + | Error msg -> 98 98 + raise_with_context 99 99 + (make ~code:(Other "json_parse") ~message:msg ()) 100 100 + "%s" context

+4

lib/zulip/error.mli

··· 77 77 val of_json : Jsont.json -> t option 78 78 (** [of_json json] attempts to parse a Zulip API error response. 79 79 Returns [None] if the JSON does not represent an error. *) 80 80 + 81 81 + val decode_or_raise : 'a Jsont.t -> Jsont.json -> string -> 'a 82 82 + (** [decode_or_raise codec json context] decodes JSON using the codec, 83 83 + or raises a Zulip error with the given context if decoding fails. *)

+5 -5

lib/zulip/event.ml

··· 17 17 Jsont.of_of_string ~kind:"Event_type.t" of_string ~enc:Event_type.to_string 18 18 19 19 (* Jsont codec for event. 20 20 - Note: We decode id and type, but keep the full JSON as data for flexibility *) 20 20 + We decode id and type, and use keep_unknown to preserve all other fields as data *) 21 21 let jsont = 22 22 let kind = "Event" in 23 23 let doc = "A Zulip event from the event queue" in 24 24 - (* We use a custom decoder that captures the full JSON as data *) 25 25 - let make id type_ = 26 26 - (* The data field will be populated separately *) 27 27 - { id; type_; data = Jsont.Null ((), Jsont.Meta.none) } 24 24 + let make id type_ (data : Jsont.json) = 25 25 + { id; type_; data } 28 26 in 27 27 + let enc_data t = t.data in 29 28 Jsont.Object.map ~kind ~doc make 30 29 |> Jsont.Object.mem "id" Jsont.int ~enc:id 31 30 |> Jsont.Object.mem "type" event_type_jsont ~enc:type_ 31 31 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:enc_data 32 32 |> Jsont.Object.finish

+18 -43

lib/zulip/event_queue.ml

··· 69 69 ] 70 70 in 71 71 72 72 - (match event_types_str with 73 73 - | Some types -> 74 74 - Log.debug (fun m -> 75 75 - m "Registering with event_types: %s" (String.concat "," types)) 76 76 - | None -> ()); 72 72 + Option.iter (fun types -> 73 73 + Log.debug (fun m -> m "Registering with event_types: %s" (String.concat "," types))) 74 74 + event_types_str; 77 75 78 76 let json = 79 77 Client.request client ~method_:`POST ~path:"/api/v1/register" ~params () 80 78 in 81 81 - match Encode.from_json Register_response.codec json with 82 82 - | Ok response -> 83 83 - { id = response.queue_id; last_event_id = response.last_event_id } 84 84 - | Error msg -> 85 85 - Error.raise_with_context 86 86 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 87 87 - "parsing register response" 79 79 + let response = Error.decode_or_raise Register_response.codec json "parsing register response" in 80 80 + { id = response.queue_id; last_event_id = response.last_event_id } 88 81 89 82 let id t = t.id 90 83 let last_event_id t = t.last_event_id ··· 101 94 (match List.assoc_opt "events" assoc with 102 95 | Some (Jsont.Array (items, _)) -> 103 96 let events = 104 104 - List.fold_left 105 105 - (fun acc item -> 106 106 - match Encode.from_json Event.jsont item with 107 107 - | Ok event -> event :: acc 108 108 - | Error _ -> acc) 109 109 - [] items 110 110 - |> List.rev 97 97 + items |> List.filter_map (fun item -> 98 98 + Encode.from_json Event.jsont item |> Result.to_option) 111 99 in 112 100 { events } 113 101 | Some _ -> { events = [] } ··· 121 109 end 122 110 123 111 let get_events t client ?last_event_id ?dont_block () = 124 124 - let event_id = 125 125 - match last_event_id with Some id -> id | None -> t.last_event_id 126 126 - in 112 112 + let event_id = Option.value last_event_id ~default:t.last_event_id in 127 113 let params = 128 114 [ ("queue_id", t.id); ("last_event_id", string_of_int event_id) ] 129 129 - @ (match dont_block with 130 130 - | Some true -> [ ("dont_block", "true") ] 131 131 - | _ -> []) 115 115 + @ (if dont_block = Some true then [ ("dont_block", "true") ] else []) 132 116 in 133 117 let json = 134 118 Client.request client ~method_:`GET ~path:"/api/v1/events" ~params () 135 119 in 136 136 - match Encode.from_json Events_response.codec json with 137 137 - | Ok response -> 138 138 - Log.debug (fun m -> 139 139 - m "Got %d events from API" (List.length response.events)); 140 140 - (* Update internal last_event_id *) 141 141 - (match response.events with 142 142 - | [] -> () 143 143 - | events -> 144 144 - let max_id = 145 145 - List.fold_left (fun acc e -> max acc (Event.id e)) event_id events 146 146 - in 147 147 - t.last_event_id <- max_id); 148 148 - response.events 149 149 - | Error msg -> 150 150 - Log.warn (fun m -> m "Failed to parse events response: %s" msg); 151 151 - Error.raise_with_context 152 152 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 153 153 - "parsing events from queue %s" t.id 120 120 + let response = Error.decode_or_raise Events_response.codec json (Printf.sprintf "parsing events from queue %s" t.id) in 121 121 + Log.debug (fun m -> m "Got %d events from API" (List.length response.events)); 122 122 + (* Update internal last_event_id *) 123 123 + (match response.events with 124 124 + | [] -> () 125 125 + | events -> 126 126 + let max_id = List.fold_left (fun acc e -> max acc (Event.id e)) event_id events in 127 127 + t.last_event_id <- max_id); 128 128 + response.events 154 129 155 130 let delete t client = 156 131 let params = [ ("queue_id", t.id) ] in

+7 -22

lib/zulip/messages.ml

··· 5 5 Client.request client ~method_:`POST ~path:"/api/v1/messages" ~body 6 6 ~content_type () 7 7 in 8 8 - match Encode.from_json Message_response.jsont response with 9 9 - | Ok msg_response -> msg_response 10 10 - | Error msg -> 11 11 - Error.raise_with_context 12 12 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 13 13 - "parsing message response" 8 8 + Error.decode_or_raise Message_response.jsont response "parsing message response" 14 9 15 10 let get client ~message_id = 16 11 Client.request client ~method_:`GET ··· 20 15 let get_raw client ~message_id = 21 16 let response_codec = 22 17 Jsont.Object.( 23 23 - map ~kind:"RawMessageResponse" (fun content -> content) 24 24 - |> mem "raw_content" Jsont.string ~enc:(fun x -> x) 18 18 + map ~kind:"RawMessageResponse" Fun.id 19 19 + |> mem "raw_content" Jsont.string ~enc:Fun.id 25 20 |> finish) 26 21 in 27 22 let json = ··· 30 25 ~params:[ ("apply_markdown", "false") ] 31 26 () 32 27 in 33 33 - match Encode.from_json response_codec json with 34 34 - | Ok content -> content 35 35 - | Error msg -> 36 36 - Error.raise_with_context 37 37 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 38 38 - "getting raw message %d" message_id 28 28 + Error.decode_or_raise response_codec json (Printf.sprintf "getting raw message %d" message_id) 39 29 40 30 type anchor = Newest | Oldest | First_unread | Message_id of int 41 31 ··· 207 197 let params = [ ("content", content) ] in 208 198 let response_codec = 209 199 Jsont.Object.( 210 210 - map ~kind:"RenderResponse" (fun rendered -> rendered) 211 211 - |> mem "rendered" Jsont.string ~enc:(fun x -> x) 200 200 + map ~kind:"RenderResponse" Fun.id 201 201 + |> mem "rendered" Jsont.string ~enc:Fun.id 212 202 |> finish) 213 203 in 214 204 let json = 215 205 Client.request client ~method_:`POST ~path:"/api/v1/messages/render" ~params 216 206 () 217 207 in 218 218 - match Encode.from_json response_codec json with 219 219 - | Ok rendered -> rendered 220 220 - | Error msg -> 221 221 - Error.raise_with_context 222 222 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 223 223 - "rendering message" 208 208 + Error.decode_or_raise response_codec json "rendering message" 224 209 225 210 let upload_file _client ~filename:_ = 226 211 (* TODO: Implement file upload using multipart/form-data *)

+2 -6

lib/zulip/user.ml

··· 117 117 118 118 let pp fmt t = 119 119 let delivery = 120 120 - match t.delivery_email with 121 121 - | Some email -> Printf.sprintf ", delivery_email=%s" email 122 122 - | None -> "" 120 120 + Option.fold ~none:"" ~some:(Printf.sprintf ", delivery_email=%s") t.delivery_email 123 121 in 124 122 let uid = 125 125 - match t.user_id with 126 126 - | Some id -> Printf.sprintf ", user_id=%d" id 127 127 - | None -> "" 123 123 + Option.fold ~none:"" ~some:(Printf.sprintf ", user_id=%d") t.user_id 128 124 in 129 125 Format.fprintf fmt "User{email=%s, full_name=%s%s%s}" t.email t.full_name uid 130 126 delivery

+39 -105

lib/zulip/users.ml

··· 1 1 let list client = 2 2 let response_codec = 3 3 Jsont.Object.( 4 4 - map ~kind:"UsersResponse" (fun members -> members) 5 5 - |> mem "members" (Jsont.list User.jsont) ~enc:(fun x -> x) 4 4 + map ~kind:"UsersResponse" Fun.id 5 5 + |> mem "members" (Jsont.list User.jsont) ~enc:Fun.id 6 6 |> finish) 7 7 in 8 8 let json = Client.request client ~method_:`GET ~path:"/api/v1/users" () in 9 9 - match Encode.from_json response_codec json with 10 10 - | Ok users -> users 11 11 - | Error msg -> 12 12 - Error.raise_with_context 13 13 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 14 14 - "parsing users list" 9 9 + Error.decode_or_raise response_codec json "parsing users list" 15 10 16 11 let list_all client ?client_gravatar ?include_custom_profile_fields () = 17 12 let params = 18 13 List.filter_map Fun.id 19 14 [ 20 20 - Option.map 21 21 - (fun v -> ("client_gravatar", string_of_bool v)) 22 22 - client_gravatar; 23 23 - Option.map 24 24 - (fun v -> ("include_custom_profile_fields", string_of_bool v)) 25 25 - include_custom_profile_fields; 15 15 + Option.map (fun v -> ("client_gravatar", string_of_bool v)) client_gravatar; 16 16 + Option.map (fun v -> ("include_custom_profile_fields", string_of_bool v)) include_custom_profile_fields; 26 17 ] 27 18 in 28 19 let response_codec = 29 20 Jsont.Object.( 30 30 - map ~kind:"UsersResponse" (fun members -> members) 31 31 - |> mem "members" (Jsont.list User.jsont) ~enc:(fun x -> x) 21 21 + map ~kind:"UsersResponse" Fun.id 22 22 + |> mem "members" (Jsont.list User.jsont) ~enc:Fun.id 32 23 |> finish) 33 24 in 34 25 let json = 35 26 Client.request client ~method_:`GET ~path:"/api/v1/users" ~params () 36 27 in 37 37 - match Encode.from_json response_codec json with 38 38 - | Ok users -> users 39 39 - | Error msg -> 40 40 - Error.raise_with_context 41 41 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 42 42 - "parsing users list" 28 28 + Error.decode_or_raise response_codec json "parsing users list" 43 29 44 30 let user_response_codec = 45 31 Jsont.Object.( 46 46 - map ~kind:"UserResponse" (fun user -> user) 47 47 - |> mem "user" User.jsont ~enc:(fun x -> x) 32 32 + map ~kind:"UserResponse" Fun.id 33 33 + |> mem "user" User.jsont ~enc:Fun.id 48 34 |> finish) 49 35 50 36 let get client ~email = 51 37 let json = 52 38 Client.request client ~method_:`GET ~path:("/api/v1/users/" ^ email) () 53 39 in 54 54 - match Encode.from_json user_response_codec json with 55 55 - | Ok user -> user 56 56 - | Error _ -> ( 57 57 - match Encode.from_json User.jsont json with 58 58 - | Ok user -> user 59 59 - | Error msg -> 60 60 - Error.raise_with_context 61 61 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 62 62 - "parsing user %s" email) 40 40 + Encode.from_json user_response_codec json 41 41 + |> Result.fold 42 42 + ~ok:Fun.id 43 43 + ~error:(fun _ -> 44 44 + Error.decode_or_raise User.jsont json (Printf.sprintf "parsing user %s" email)) 63 45 64 46 let get_by_id client ~user_id ?include_custom_profile_fields () = 65 47 let params = 66 48 List.filter_map Fun.id 67 49 [ 68 68 - Option.map 69 69 - (fun v -> ("include_custom_profile_fields", string_of_bool v)) 70 70 - include_custom_profile_fields; 50 50 + Option.map (fun v -> ("include_custom_profile_fields", string_of_bool v)) include_custom_profile_fields; 71 51 ] 72 52 in 73 53 let json = ··· 75 55 ~path:("/api/v1/users/" ^ string_of_int user_id) 76 56 ~params () 77 57 in 78 78 - match Encode.from_json user_response_codec json with 79 79 - | Ok user -> user 80 80 - | Error _ -> ( 81 81 - match Encode.from_json User.jsont json with 82 82 - | Ok user -> user 83 83 - | Error msg -> 84 84 - Error.raise_with_context 85 85 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 86 86 - "parsing user id %d" user_id) 58 58 + Encode.from_json user_response_codec json 59 59 + |> Result.fold 60 60 + ~ok:Fun.id 61 61 + ~error:(fun _ -> 62 62 + Error.decode_or_raise User.jsont json (Printf.sprintf "parsing user id %d" user_id)) 87 63 88 64 let me client = 89 65 let json = Client.request client ~method_:`GET ~path:"/api/v1/users/me" () in 90 90 - match Encode.from_json User.jsont json with 91 91 - | Ok user -> user 92 92 - | Error msg -> 93 93 - Error.raise_with_context 94 94 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 95 95 - "parsing current user" 66 66 + Error.decode_or_raise User.jsont json "parsing current user" 96 67 97 68 let me_pointer client = 98 69 let response_codec = 99 70 Jsont.Object.( 100 100 - map ~kind:"PointerResponse" (fun pointer -> pointer) 101 101 - |> mem "pointer" Jsont.int ~enc:(fun x -> x) 71 71 + map ~kind:"PointerResponse" Fun.id 72 72 + |> mem "pointer" Jsont.int ~enc:Fun.id 102 73 |> finish) 103 74 in 104 75 let json = 105 76 Client.request client ~method_:`GET ~path:"/api/v1/users/me/pointer" () 106 77 in 107 107 - match Encode.from_json response_codec json with 108 108 - | Ok pointer -> pointer 109 109 - | Error msg -> 110 110 - Error.raise_with_context 111 111 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 112 112 - "getting pointer" 78 78 + Error.decode_or_raise response_codec json "getting pointer" 113 79 114 80 let update_me_pointer client ~pointer = 115 81 let params = [ ("pointer", string_of_int pointer) ] in ··· 159 125 in 160 126 () 161 127 128 128 + let alert_words_codec = 129 129 + Jsont.Object.( 130 130 + map ~kind:"AlertWordsResponse" Fun.id 131 131 + |> mem "alert_words" (Jsont.list Jsont.string) ~enc:Fun.id 132 132 + |> finish) 133 133 + 162 134 let get_alert_words client = 163 163 - let response_codec = 164 164 - Jsont.Object.( 165 165 - map ~kind:"AlertWordsResponse" (fun words -> words) 166 166 - |> mem "alert_words" (Jsont.list Jsont.string) ~enc:(fun x -> x) 167 167 - |> finish) 168 168 - in 169 135 let json = 170 136 Client.request client ~method_:`GET ~path:"/api/v1/users/me/alert_words" () 171 137 in 172 172 - match Encode.from_json response_codec json with 173 173 - | Ok words -> words 174 174 - | Error msg -> 175 175 - Error.raise_with_context 176 176 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 177 177 - "getting alert words" 138 138 + Error.decode_or_raise alert_words_codec json "getting alert words" 178 139 179 140 let add_alert_words client ~words = 180 141 let params = 181 142 [ ("alert_words", Encode.to_json_string (Jsont.list Jsont.string) words) ] 182 143 in 183 183 - let response_codec = 184 184 - Jsont.Object.( 185 185 - map ~kind:"AlertWordsResponse" (fun words -> words) 186 186 - |> mem "alert_words" (Jsont.list Jsont.string) ~enc:(fun x -> x) 187 187 - |> finish) 188 188 - in 189 144 let json = 190 145 Client.request client ~method_:`POST ~path:"/api/v1/users/me/alert_words" 191 146 ~params () 192 147 in 193 193 - match Encode.from_json response_codec json with 194 194 - | Ok words -> words 195 195 - | Error msg -> 196 196 - Error.raise_with_context 197 197 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 198 198 - "adding alert words" 148 148 + Error.decode_or_raise alert_words_codec json "adding alert words" 199 149 200 150 let remove_alert_words client ~words = 201 151 let params = 202 152 [ ("alert_words", Encode.to_json_string (Jsont.list Jsont.string) words) ] 203 203 - in 204 204 - let response_codec = 205 205 - Jsont.Object.( 206 206 - map ~kind:"AlertWordsResponse" (fun words -> words) 207 207 - |> mem "alert_words" (Jsont.list Jsont.string) ~enc:(fun x -> x) 208 208 - |> finish) 209 153 in 210 154 let json = 211 155 Client.request client ~method_:`DELETE ~path:"/api/v1/users/me/alert_words" 212 156 ~params () 213 157 in 214 214 - match Encode.from_json response_codec json with 215 215 - | Ok words -> words 216 216 - | Error msg -> 217 217 - Error.raise_with_context 218 218 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 219 219 - "removing alert words" 158 158 + Error.decode_or_raise alert_words_codec json "removing alert words" 220 159 221 160 type status_emoji = { 222 161 emoji_name : string; ··· 380 319 let get_muted_users client = 381 320 let response_codec = 382 321 Jsont.Object.( 383 383 - map ~kind:"MutedUsersResponse" (fun users -> users) 322 322 + map ~kind:"MutedUsersResponse" Fun.id 384 323 |> mem "muted_users" 385 324 (Jsont.list 386 325 (Jsont.Object.( 387 326 map ~kind:"MutedUser" (fun id _ts -> id) 388 388 - |> mem "id" Jsont.int ~enc:(fun x -> x) 389 389 - |> mem "timestamp" Jsont.int ~dec_absent:0 ~enc:(fun _ -> 0) 327 327 + |> mem "id" Jsont.int ~enc:Fun.id 328 328 + |> mem "timestamp" Jsont.int ~dec_absent:0 ~enc:(Fun.const 0) 390 329 |> finish))) 391 391 - ~enc:(fun x -> x) 330 330 + ~enc:Fun.id 392 331 |> finish) 393 332 in 394 333 let json = 395 334 Client.request client ~method_:`GET ~path:"/api/v1/users/me/muted_users" () 396 335 in 397 397 - match Encode.from_json response_codec json with 398 398 - | Ok users -> users 399 399 - | Error msg -> 400 400 - Error.raise_with_context 401 401 - (Error.make ~code:(Other "json_parse") ~message:msg ()) 402 402 - "getting muted users" 336 336 + Error.decode_or_raise response_codec json "getting muted users" 403 337 404 338 let mute_user client ~user_id = 405 339 let _response =

+7 -14

lib/zulip_bot/bot.ml

··· 18 18 | Jsont.Object (fields, _) -> 19 19 let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in 20 20 let get_int key = 21 21 - match List.assoc_opt key assoc with 22 22 - | Some (Jsont.Number (f, _)) -> int_of_float f 23 23 - | _ -> 0 21 21 + List.assoc_opt key assoc 22 22 + |> Option.fold ~none:0 ~some:(function Jsont.Number (f, _) -> int_of_float f | _ -> 0) 24 23 in 25 24 let get_string key = 26 26 - match List.assoc_opt key assoc with 27 27 - | Some (Jsont.String (s, _)) -> s 28 28 - | _ -> "" 25 25 + List.assoc_opt key assoc 26 26 + |> Option.fold ~none:"" ~some:(function Jsont.String (s, _) -> s | _ -> "") 29 27 in 30 28 { user_id = get_int "user_id"; email = get_string "email"; full_name = get_string "full_name" } 31 29 | _ -> ··· 79 77 match event_data with 80 78 | Jsont.Object (fields, _) -> 81 79 let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in 82 82 - let msg = 83 83 - match List.assoc_opt "message" assoc with 84 84 - | Some m -> m 85 85 - | None -> event_data 86 86 - in 80 80 + let msg = List.assoc_opt "message" assoc |> Option.value ~default:event_data in 87 81 let flgs = 88 88 - match List.assoc_opt "flags" assoc with 89 89 - | Some (Jsont.Array (f, _)) -> f 90 90 - | _ -> [] 82 82 + List.assoc_opt "flags" assoc 83 83 + |> Option.fold ~none:[] ~some:(function Jsont.Array (f, _) -> f | _ -> []) 91 84 in 92 85 (msg, flgs) 93 86 | _ -> (event_data, [])

+2 -1

lib/zulip_bot/dune

··· 3 3 (name zulip_bot) 4 4 (wrapped true) 5 5 (libraries zulip eio jsont jsont.bytesrw logs fmt xdge) 6 6 - (flags (:standard -warn-error -3))) 6 6 + (flags 7 7 + (:standard -warn-error -3)))

+19 -32

lib/zulip_bot/message.ml

··· 133 133 | Jsont.Object (fields, _) -> 134 134 let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in 135 135 let get_int key = 136 136 - match List.assoc_opt key assoc with 137 137 - | Some (Jsont.Number (f, _)) -> Some (int_of_float f) 138 138 - | _ -> None 136 136 + List.assoc_opt key assoc 137 137 + |> Option.fold ~none:None ~some:(function Jsont.Number (f, _) -> Some (int_of_float f) | _ -> None) 139 138 in 140 139 let get_string key = 141 141 - match List.assoc_opt key assoc with 142 142 - | Some (Jsont.String (s, _)) -> Some s 143 143 - | _ -> None 140 140 + List.assoc_opt key assoc 141 141 + |> Option.fold ~none:None ~some:(function Jsont.String (s, _) -> Some s | _ -> None) 144 142 in 145 143 let get_float key default = 146 146 - match List.assoc_opt key assoc with 147 147 - | Some (Jsont.Number (f, _)) -> f 148 148 - | _ -> default 144 144 + List.assoc_opt key assoc 145 145 + |> Option.fold ~none:default ~some:(function Jsont.Number (f, _) -> f | _ -> default) 149 146 in 150 147 let get_bool key default = 151 151 - match List.assoc_opt key assoc with 152 152 - | Some (Jsont.Bool (b, _)) -> b 153 153 - | _ -> default 148 148 + List.assoc_opt key assoc 149 149 + |> Option.fold ~none:default ~some:(function Jsont.Bool (b, _) -> b | _ -> default) 154 150 in 155 151 let get_array key = 156 156 - match List.assoc_opt key assoc with 157 157 - | Some (Jsont.Array (arr, _)) -> Some arr 158 158 - | _ -> None 152 152 + List.assoc_opt key assoc 153 153 + |> Option.fold ~none:None ~some:(function Jsont.Array (arr, _) -> Some arr | _ -> None) 159 154 in 160 155 161 156 (match (get_int "id", get_int "sender_id", get_string "sender_email", get_string "sender_full_name") with ··· 166 161 let content_type = get_string "content_type" |> Option.value ~default:"text/html" in 167 162 168 163 let reactions = 169 169 - match get_array "reactions" with 170 170 - | Some reactions_json -> 171 171 - List.filter_map (fun r -> 172 172 - match parse_reaction_json r with 173 173 - | Ok reaction -> Some reaction 174 174 - | Error msg -> 164 164 + get_array "reactions" 165 165 + |> Option.fold ~none:[] ~some:(List.filter_map (fun r -> 166 166 + parse_reaction_json r 167 167 + |> Result.fold ~ok:Option.some ~error:(fun msg -> 175 168 Log.warn (fun m -> m "Failed to parse reaction: %s" msg); 176 176 - None 177 177 - ) reactions_json 178 178 - | None -> [] 169 169 + None))) 179 170 in 180 171 181 172 let submessages = get_array "submessages" |> Option.value ~default:[] in 182 173 183 174 let flags = 184 184 - match get_array "flags" with 185 185 - | Some flags_json -> 186 186 - List.filter_map (fun f -> 187 187 - match f with 188 188 - | Jsont.String (s, _) -> Some s 189 189 - | _ -> None 190 190 - ) flags_json 191 191 - | None -> [] 175 175 + get_array "flags" 176 176 + |> Option.fold ~none:[] ~some:(List.filter_map (function 177 177 + | Jsont.String (s, _) -> Some s 178 178 + | _ -> None)) 192 179 in 193 180 194 181 let is_me_message = get_bool "is_me_message" false in