diff --git a/.ocamlformat b/.ocamlformat index 8bdf1ac9..222870b0 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,3 +1,3 @@ -version = 0.21.0 +version = 0.26.2 profile = janestreet ocp-indent-compat = true diff --git a/reddit_api_async/bounded_set.ml b/reddit_api_async/bounded_set.ml index 3c0993be..31e51966 100644 --- a/reddit_api_async/bounded_set.ml +++ b/reddit_api_async/bounded_set.ml @@ -24,7 +24,7 @@ module Make (Hashable : Hashtbl.Key_plain) = struct | false -> Hash_queue.enqueue_back_exn hash_queue value (); (match Hash_queue.length hash_queue > capacity with - | false -> () - | true -> Hash_queue.drop hash_queue `front) + | false -> () + | true -> Hash_queue.drop hash_queue `front) ;; end diff --git a/reddit_api_async/connection.ml b/reddit_api_async/connection.ml index a99e2284..8bb8c2e8 100644 --- a/reddit_api_async/connection.ml +++ b/reddit_api_async/connection.ml @@ -186,12 +186,12 @@ let live_cohttp_client library_client_user_agent : (module Cohttp_client_wrapper let get uri ~headers = Monitor.try_with (fun () -> - Cohttp_async.Client.get uri ~headers:(add_user_agent headers)) + Cohttp_async.Client.get uri ~headers:(add_user_agent headers)) ;; let post_form uri ~headers ~params = Monitor.try_with (fun () -> - Cohttp_async.Client.post_form uri ~headers:(add_user_agent headers) ~params) + Cohttp_async.Client.post_form uri ~headers:(add_user_agent headers) ~params) ;; end) ;; @@ -232,9 +232,9 @@ module Local = struct ;; let get_token - (module Cohttp_client_wrapper : Cohttp_client_wrapper) - credentials - ~time_source + (module Cohttp_client_wrapper : Cohttp_client_wrapper) + credentials + ~time_source = match%bind let open Deferred.Result.Let_syntax in @@ -259,23 +259,23 @@ module Local = struct { response; body = Cohttp.Body.of_string body_string }) | `OK -> (match Jsonaf.parse body_string with - | Error error -> - Error - (Json_parsing_error - { error; response; body = Cohttp.Body.of_string body_string }) - | Ok response_json -> - let token = - Jsonaf.member_exn "access_token" response_json |> Jsonaf.string_exn - in - let expiration = - let additional_seconds = - Jsonaf.member_exn "expires_in" response_json - |> Jsonaf.float_exn - |> Time_ns.Span.of_sec - in - Time_ns.add (Time_source.now time_source) additional_seconds - in - Ok { token; expiration }) + | Error error -> + Error + (Json_parsing_error + { error; response; body = Cohttp.Body.of_string body_string }) + | Ok response_json -> + let token = + Jsonaf.member_exn "access_token" response_json |> Jsonaf.string_exn + in + let expiration = + let additional_seconds = + Jsonaf.member_exn "expires_in" response_json + |> Jsonaf.float_exn + |> Time_ns.Span.of_sec + in + Time_ns.add (Time_source.now time_source) additional_seconds + in + Ok { token; expiration }) | _ -> Error (Other_http_error { response; body = Cohttp.Body.of_string body_string }) @@ -298,8 +298,8 @@ module Local = struct | No_outstanding_request None -> get_token () | No_outstanding_request (Some access_token) -> (match Access_token.is_almost_expired access_token ~time_source with - | false -> return (Ok access_token) - | true -> get_token ()) + | false -> return (Ok access_token) + | true -> get_token ()) in match result with | Error _ as error -> return error @@ -335,53 +335,53 @@ module Local = struct ;; let repeat_until_finished_with_result - (state : 'state) - (f : 'state -> ([ `Repeat of 'state | `Finished of 'ok ], 'error) Deferred.Result.t) - : ('ok, 'error) Deferred.Result.t + (state : 'state) + (f : 'state -> ([ `Repeat of 'state | `Finished of 'ok ], 'error) Deferred.Result.t) + : ('ok, 'error) Deferred.Result.t = Deferred.repeat_until_finished state (fun state -> - match%bind f state with - | Ok (`Repeat state) -> return (`Repeat state) - | Ok (`Finished result) -> return (`Finished (Ok result)) - | Error result -> return (`Finished (Error result))) + match%bind f state with + | Ok (`Repeat state) -> return (`Repeat state) + | Ok (`Finished result) -> return (`Finished (Ok result)) + | Error result -> return (`Finished (Error result))) ;; let handle_request - ?sequence - { auth; rate_limiter; cohttp_client_wrapper; time_source; sequencer_table } - ~f - ~headers:initial_headers + ?sequence + { auth; rate_limiter; cohttp_client_wrapper; time_source; sequencer_table } + ~f + ~headers:initial_headers = let run () = repeat_until_finished_with_result () (fun () -> - let open Deferred.Result.Let_syntax in - let%bind headers = - Auth.add_access_token - auth - ~headers:initial_headers - ~cohttp_client_wrapper - ~time_source - |> Deferred.Result.map_error ~f:(fun error -> - Error.Access_token_request_error error) - in - let%bind () = Deferred.ok (Rate_limiter.permit_request rate_limiter) in - let%bind ((response, _body) as result) = f headers in - let authorization_failed = - match Cohttp.Response.status response with - | `Unauthorized -> - (match - Cohttp.Header.get (Cohttp.Response.headers response) "www-authenticate" - with - | Some "Bearer realm=\"reddit\", error=\"invalid_token\"" -> true - | Some _ | None -> false) - | _ -> false - in - Rate_limiter.notify_response rate_limiter response; - match authorization_failed with - | false -> return (`Finished result) - | true -> - auth.access_token <- No_outstanding_request None; - return (`Repeat ())) + let open Deferred.Result.Let_syntax in + let%bind headers = + Auth.add_access_token + auth + ~headers:initial_headers + ~cohttp_client_wrapper + ~time_source + |> Deferred.Result.map_error ~f:(fun error -> + Error.Access_token_request_error error) + in + let%bind () = Deferred.ok (Rate_limiter.permit_request rate_limiter) in + let%bind ((response, _body) as result) = f headers in + let authorization_failed = + match Cohttp.Response.status response with + | `Unauthorized -> + (match + Cohttp.Header.get (Cohttp.Response.headers response) "www-authenticate" + with + | Some "Bearer realm=\"reddit\", error=\"invalid_token\"" -> true + | Some _ | None -> false) + | _ -> false + in + Rate_limiter.notify_response rate_limiter response; + match authorization_failed with + | false -> return (`Finished result) + | true -> + auth.access_token <- No_outstanding_request None; + return (`Repeat ())) in match sequence with | None -> run () @@ -393,16 +393,16 @@ module Local = struct let (module Cohttp_client_wrapper) = t.cohttp_client_wrapper in let headers = Cohttp.Header.init () in handle_request ?sequence t ~headers ~f:(fun headers -> - Cohttp_client_wrapper.post_form ~headers ~params uri - |> Deferred.Result.map_error ~f:(fun exn -> Error.Endpoint_error exn)) + Cohttp_client_wrapper.post_form ~headers ~params uri + |> Deferred.Result.map_error ~f:(fun exn -> Error.Endpoint_error exn)) ;; let get ?sequence t uri = let (module Cohttp_client_wrapper) = t.cohttp_client_wrapper in let headers = Cohttp.Header.init () in handle_request ?sequence t ~headers ~f:(fun headers -> - Cohttp_client_wrapper.get ~headers uri - |> Deferred.Result.map_error ~f:(fun exn -> Error.Endpoint_error exn)) + Cohttp_client_wrapper.get ~headers uri + |> Deferred.Result.map_error ~f:(fun exn -> Error.Endpoint_error exn)) ;; let set_access_token t ~token ~expiration = @@ -456,12 +456,12 @@ let call t api = return (Error (Error.Endpoint_error (Endpoint.Error.Cohttp_raised exn))) | Ok response -> (match api.handle_response response with - | Ok _ as result -> - Prometheus.Counter.inc_one Metrics.ok_responses; - return result - | Error error -> - Prometheus.Counter.inc_one Metrics.endpoint_errors; - return (Error (Error.Endpoint_error error))) + | Ok _ as result -> + Prometheus.Counter.inc_one Metrics.ok_responses; + return result + | Error error -> + Prometheus.Counter.inc_one Metrics.endpoint_errors; + return (Error (Error.Endpoint_error error))) ;; let call_exn t api = @@ -620,12 +620,12 @@ module Remote = struct let get = Rpc.Rpc.implement Protocol.get (fun t (sequence, uri) -> - get_body (get ?sequence t uri)) + get_body (get ?sequence t uri)) ;; let post_form = Rpc.Rpc.implement Protocol.post_form (fun t (sequence, uri, params) -> - get_body (post_form ?sequence t uri ~params)) + get_body (post_form ?sequence t uri ~params)) ;; let implementations = @@ -672,12 +672,12 @@ module For_testing = struct let filter_string t string = Hashtbl.fold t ~init:string ~f:(fun ~key:placeholder ~data:secret string -> - String.substr_replace_all string ~pattern:secret ~with_:placeholder) + String.substr_replace_all string ~pattern:secret ~with_:placeholder) ;; let insert_dummy_strings t string = Hashtbl.fold t ~init:string ~f:(fun ~key:placeholder ~data:secret string -> - String.substr_replace_all string ~pattern:placeholder ~with_:secret) + String.substr_replace_all string ~pattern:placeholder ~with_:secret) ;; end @@ -785,19 +785,19 @@ module For_testing = struct let seal () = printf "Please move the following to test/%s\n\n" filename; Queue.iter queue ~f:(fun interaction -> - (match is_access_token_interaction interaction with - | false -> () - | true -> - let _, body = interaction.response in - let json = Jsonaf.of_string body in - (match Jsonaf.member "access_token" json with + (match is_access_token_interaction interaction with + | false -> () + | true -> + let _, body = interaction.response in + let json = Jsonaf.of_string body in + (match Jsonaf.member "access_token" json with | None -> () | Some json -> let token = Jsonaf.string_exn json in Placeholders.add placeholders ~secret:token ~placeholder:"access_token")); - Interaction.map interaction ~f:(Placeholders.filter_string placeholders) - |> Interaction.sexp_of_t - |> Sexp.output_mach Out_channel.stdout); + Interaction.map interaction ~f:(Placeholders.filter_string placeholders) + |> Interaction.sexp_of_t + |> Sexp.output_mach Out_channel.stdout); printf "\n\nPlease move the above to test/%s" filename ;; @@ -809,9 +809,9 @@ module For_testing = struct (module struct let queue : Interaction.t Queue.t = In_channel.with_file filename ~f:(fun in_channel -> - Sexp.input_sexps in_channel - |> List.map ~f:Interaction.t_of_sexp - |> Queue.of_list) + Sexp.input_sexps in_channel + |> List.map ~f:Interaction.t_of_sexp + |> Queue.of_list) ;; let dequeue_response () = @@ -844,8 +844,8 @@ module For_testing = struct | Post_form _ -> fail () | Get request -> (match Uri.equal uri request.uri && headers_equal headers request.headers with - | false -> fail () - | true -> return (Ok response)) + | false -> fail () + | true -> return (Ok response)) ;; let post_form uri ~headers ~params = @@ -867,8 +867,8 @@ module For_testing = struct && headers_equal headers request.headers && [%equal: (string * string list) list] params request.params with - | false -> fail () - | true -> return (Ok response)) + | false -> fail () + | true -> return (Ok response)) ;; let seal () = assert (Queue.is_empty queue) @@ -883,25 +883,25 @@ module For_testing = struct let with_t filename ~credentials ~f = let placeholders = Placeholders.create () in (match (credentials : Credentials.t) with - | Password { client_id; client_secret; username; password } -> - Placeholders.add placeholders ~secret:client_id ~placeholder:"client_id"; - Placeholders.add placeholders ~secret:client_secret ~placeholder:"client_secret"; - Placeholders.add placeholders ~secret:password ~placeholder:"password"; - Placeholders.add placeholders ~secret:username ~placeholder:"username" - | Refresh_token { client_id; client_secret; refresh_token } -> - Placeholders.add placeholders ~secret:client_id ~placeholder:"client_id"; - Option.iter client_secret ~f:(fun secret -> - Placeholders.add placeholders ~secret ~placeholder:"client_secret"); - Placeholders.add placeholders ~secret:refresh_token ~placeholder:"refresh_token" - | Userless_confidential { client_id; client_secret } -> - Placeholders.add placeholders ~secret:client_id ~placeholder:"client_id"; - Placeholders.add placeholders ~secret:client_secret ~placeholder:"client_secret" - | Userless_public ({ client_id; device_id = _ } as public_credentials) -> - Placeholders.add placeholders ~secret:client_id ~placeholder:"client_id"; - Placeholders.add - placeholders - ~secret:(Credentials.Userless_public.device_id_or_default public_credentials) - ~placeholder:"device_id"); + | Password { client_id; client_secret; username; password } -> + Placeholders.add placeholders ~secret:client_id ~placeholder:"client_id"; + Placeholders.add placeholders ~secret:client_secret ~placeholder:"client_secret"; + Placeholders.add placeholders ~secret:password ~placeholder:"password"; + Placeholders.add placeholders ~secret:username ~placeholder:"username" + | Refresh_token { client_id; client_secret; refresh_token } -> + Placeholders.add placeholders ~secret:client_id ~placeholder:"client_id"; + Option.iter client_secret ~f:(fun secret -> + Placeholders.add placeholders ~secret ~placeholder:"client_secret"); + Placeholders.add placeholders ~secret:refresh_token ~placeholder:"refresh_token" + | Userless_confidential { client_id; client_secret } -> + Placeholders.add placeholders ~secret:client_id ~placeholder:"client_id"; + Placeholders.add placeholders ~secret:client_secret ~placeholder:"client_secret" + | Userless_public ({ client_id; device_id = _ } as public_credentials) -> + Placeholders.add placeholders ~secret:client_id ~placeholder:"client_id"; + Placeholders.add + placeholders + ~secret:(Credentials.Userless_public.device_id_or_default public_credentials) + ~placeholder:"device_id"); Placeholders.add placeholders ~secret:(Credentials.basic_auth_string credentials) diff --git a/reddit_api_async/connection.mli b/reddit_api_async/connection.mli index b4c0887c..0a66b960 100644 --- a/reddit_api_async/connection.mli +++ b/reddit_api_async/connection.mli @@ -8,18 +8,18 @@ writing a long-running process and want to just retry forever on transient errors. - {1 Authentication } + {1 Authentication} [Connection] currently supports a subset of Reddit's OAuth2 app types via the {!module:Credentials} module. See {{:https://github.com/reddit-archive/reddit/wiki/oauth2-app-types} Reddit's documentation on app types}. - {1 Rate-limiting behavior } + {1 Rate-limiting behavior} [Connection] enforces two different forms of rate-limiting: - {2 HTTP rate-limiting headers } + {2 HTTP rate-limiting headers} Reddit tracks API usage and requires that a client make no more than 600 requests in a 10 minute period. @@ -31,13 +31,11 @@ run in parallel, accounting for each others' quota usage without explicit coordination. - {2 Minimum time between requests } + {2 Minimum time between requests} In order to abide by /u/kemitche's - {{:https://www.reddit.com/r/redditdev/comments/1yxrp7/formal_ratelimiting_headers/} - request} to "be reasonable" and not slam all 600 requests in as quickly as - possible, [Connection] also enforces a 100ms delay between requests. -*) + {{:https://www.reddit.com/r/redditdev/comments/1yxrp7/formal_ratelimiting_headers/} request} to "be reasonable" and not slam all 600 requests in as quickly as + possible, [Connection] also enforces a 100ms delay between requests. *) open! Core open! Async @@ -45,11 +43,12 @@ open Reddit_api_kernel module Credentials : sig (** [Password] credentials correspond to Reddit's - {{:https://github.com/reddit-archive/reddit/wiki/oauth2-app-types#script}"script"} + {{:https://github.com/reddit-archive/reddit/wiki/oauth2-app-types#script} "script"} app type. - @see < https://datatracker.ietf.org/doc/html/rfc6749#section-4.3.2 > The - RFC 6749 section describing the corresponding access token request. *) + @see < https://datatracker.ietf.org/doc/html/rfc6749#section-4.3.2 > + The + RFC 6749 section describing the corresponding access token request. *) module Password : sig type t = { client_id : string @@ -61,23 +60,25 @@ module Credentials : sig end (** [Refresh_token] credentials correspond to Reddit's - {{:https://github.com/reddit-archive/reddit/wiki/oauth2-app-types#web-app}"web app"} + {{:https://github.com/reddit-archive/reddit/wiki/oauth2-app-types#web-app} "web app"} and - {{:https://github.com/reddit-archive/reddit/wiki/oauth2-app-types#installed-app}"installed-app"} + {{:https://github.com/reddit-archive/reddit/wiki/oauth2-app-types#installed-app} "installed-app"} app types. @see < https://praw.readthedocs.io/en/stable/tutorials/refresh_token.html - > {{:https://praw.readthedocs.io/}PRAW}'s documentation on refresh tokens - for advice on obtaining a refresh token, which is currently outside the - scope of this project. - - @see < https://datatracker.ietf.org/doc/html/rfc6749#section-6 > The RFC - 6749 section describing the corresponding access token request. *) + > + {{:https://praw.readthedocs.io/} PRAW}'s documentation on refresh tokens + for advice on obtaining a refresh token, which is currently outside the + scope of this project. + + @see < https://datatracker.ietf.org/doc/html/rfc6749#section-6 > + The RFC + 6749 section describing the corresponding access token request. *) module Refresh_token : sig type t = { client_id : string ; client_secret : string option - (** This field is present for web apps and absent for installed apps. *) + (** This field is present for web apps and absent for installed apps. *) ; refresh_token : string } [@@deriving sexp] diff --git a/reddit_api_async/iter_comments.ml b/reddit_api_async/iter_comments.ml index 3d142eff..da6a1da6 100644 --- a/reddit_api_async/iter_comments.ml +++ b/reddit_api_async/iter_comments.ml @@ -21,50 +21,50 @@ let children item ~retry_manager ~link = | `Comment comment -> return (Comment.replies comment) | `More_comments more_comments -> (match More_comments.details more_comments with - | By_children more_comments -> - retry_or_log_unexpected - retry_manager - [%here] - (Endpoint.more_children ~link ~more_comments ~sort:New ()) - | By_parent parent -> - retry_or_log_unexpected - retry_manager - [%here] - (Endpoint.comments ~comment:parent () ~link) - >>| Option.map - ~f:(fun ({ comment_forest; link = _ } as response : Comment_response.t) -> - match comment_forest with - | [ `Comment comment ] -> Comment.replies comment - | _ -> - raise_s - [%message - "Expected single comment at root of response" - (link : Link.Id.t) - (parent : Comment.Id.t) - (response : Comment_response.t)])) + | By_children more_comments -> + retry_or_log_unexpected + retry_manager + [%here] + (Endpoint.more_children ~link ~more_comments ~sort:New ()) + | By_parent parent -> + retry_or_log_unexpected + retry_manager + [%here] + (Endpoint.comments ~comment:parent () ~link) + >>| Option.map + ~f:(fun ({ comment_forest; link = _ } as response : Comment_response.t) -> + match comment_forest with + | [ `Comment comment ] -> Comment.replies comment + | _ -> + raise_s + [%message + "Expected single comment at root of response" + (link : Link.Id.t) + (parent : Comment.Id.t) + (response : Comment_response.t)])) >>| Option.value ~default:[] ;; let iter_comments - retry_manager - ~comment_response:({ link; comment_forest } : Comment_response.t) + retry_manager + ~comment_response:({ link; comment_forest } : Comment_response.t) = let link = Link.id link in let queue = Queue.of_list comment_forest in Pipe.create_reader ~close_on_exception:false (fun writer -> - Deferred.repeat_until_finished () (fun () -> - match Pipe.is_closed writer with - | true -> return (`Finished ()) - | false -> - (match Queue.dequeue queue with - | None -> return (`Finished ()) - | Some item -> - let%bind () = - match item with - | `More_comments _ -> return () - | `Comment comment -> Pipe.write_if_open writer comment - in - let%bind children = children item ~retry_manager ~link in - Queue.enqueue_all queue children; - return (`Repeat ())))) + Deferred.repeat_until_finished () (fun () -> + match Pipe.is_closed writer with + | true -> return (`Finished ()) + | false -> + (match Queue.dequeue queue with + | None -> return (`Finished ()) + | Some item -> + let%bind () = + match item with + | `More_comments _ -> return () + | `Comment comment -> Pipe.write_if_open writer comment + in + let%bind children = children item ~retry_manager ~link in + Queue.enqueue_all queue children; + return (`Repeat ())))) ;; diff --git a/reddit_api_async/rate_limiter.ml b/reddit_api_async/rate_limiter.ml index 469b6cd4..69527a7d 100644 --- a/reddit_api_async/rate_limiter.ml +++ b/reddit_api_async/rate_limiter.ml @@ -68,14 +68,14 @@ module By_headers = struct candidates ~compare: (Comparable.lift Time_ns.Span.compare ~f:(fun time' -> - Time_ns.abs_diff time time')) + Time_ns.abs_diff time time')) |> Option.value_exn ;; let%expect_test _ = List.iter [ "2020-11-30 18:48:01.02Z"; "2020-11-30 18:47:59.02Z" ] ~f:(fun time -> - let time = Time_ns_unix.of_string time in - print_s [%sexp (snap_to_nearest_minute time : Time_ns.Alternate_sexp.t)]); + let time = Time_ns_unix.of_string time in + print_s [%sexp (snap_to_nearest_minute time : Time_ns.Alternate_sexp.t)]); [%expect {| "2020-11-30 18:48:00Z" "2020-11-30 18:48:00Z" |}]; @@ -87,27 +87,27 @@ module By_headers = struct date_string "%3s, %2d %3s %4d %2d:%2d:%2d GMT" (fun day_of_week d month y hr min sec -> - let day_of_week = Day_of_week.of_string day_of_week in - let month = Month.of_string month in - let date = Date.create_exn ~y ~m:month ~d in - (match Day_of_week.equal day_of_week (Date.day_of_week date) with - | true -> () - | false -> - raise_s - [%message - "HTTP response: Day of week did not match parsed date" - (day_of_week : Day_of_week.t) - (date : Date.t) - (date_string : string)]); - let ofday = Time_ns.Ofday.create ~hr ~min ~sec () in - Time_ns.of_date_ofday date ofday ~zone:Time_ns_unix.Zone.utc) + let day_of_week = Day_of_week.of_string day_of_week in + let month = Month.of_string month in + let date = Date.create_exn ~y ~m:month ~d in + (match Day_of_week.equal day_of_week (Date.day_of_week date) with + | true -> () + | false -> + raise_s + [%message + "HTTP response: Day of week did not match parsed date" + (day_of_week : Day_of_week.t) + (date : Date.t) + (date_string : string)]); + let ofday = Time_ns.Ofday.create ~hr ~min ~sec () in + Time_ns.of_date_ofday date ofday ~zone:Time_ns_unix.Zone.utc) ;; let%expect_test _ = print_s [%sexp (parse_http_header_date "Wed, 21 Oct 2015 07:28:00 GMT" - : Time_ns.Alternate_sexp.t)]; + : Time_ns.Alternate_sexp.t)]; [%expect {| "2015-10-21 07:28:00Z" |}]; return () ;; @@ -167,28 +167,28 @@ module By_headers = struct let rec schedule_reset_at_time t time = let schedule_fresh_event () = t.reset_event - <- Some - (Time_source.Event.run_at - t.time_source - time - (fun () -> - Mvar.set t.ready (); - (* In case something prevents our first request from receiving - a response, we will periodically allow retries. *) - schedule_reset_at_time t (Time_ns.add time Time_ns.Span.minute)) - ()) + <- Some + (Time_source.Event.run_at + t.time_source + time + (fun () -> + Mvar.set t.ready (); + (* In case something prevents our first request from receiving + a response, we will periodically allow retries. *) + schedule_reset_at_time t (Time_ns.add time Time_ns.Span.minute)) + ()) in match t.reset_event with | None -> schedule_fresh_event () | Some event -> let scheduled_time = Time_source.Event.scheduled_at event in (match Time_ns.( < ) scheduled_time time with - | false -> () - | true -> - (match Time_source.Event.reschedule_at event time with - | Ok -> () - | Previously_aborted _ -> . - | Previously_happened () -> schedule_fresh_event ())) + | false -> () + | true -> + (match Time_source.Event.reschedule_at event time with + | Ok -> () + | Previously_aborted _ -> . + | Previously_happened () -> schedule_fresh_event ())) ;; let update_server_side_info t ~new_server_side_info = @@ -210,15 +210,15 @@ module By_headers = struct let permit_request t = let%bind () = Mvar.take t.ready in (match t.server_side_info with - | None -> () - | Some ({ remaining_api_calls; _ } as server_side_info) -> - (match remaining_api_calls with - | 0 -> () - | n -> - let new_server_side_info = - { server_side_info with remaining_api_calls = n - 1 } - in - update_server_side_info t ~new_server_side_info)); + | None -> () + | Some ({ remaining_api_calls; _ } as server_side_info) -> + (match remaining_api_calls with + | 0 -> () + | n -> + let new_server_side_info = + { server_side_info with remaining_api_calls = n - 1 } + in + update_server_side_info t ~new_server_side_info)); return () ;; @@ -243,12 +243,12 @@ module By_headers = struct response_server_side_info |> Ordering.of_int with - | Greater | Equal -> () - | Less -> - [%log.debug - Import.log - "Rate limit is resetting" - ~old_remaining_api_calls:(server_side_info.remaining_api_calls : int)]); + | Greater | Equal -> () + | Less -> + [%log.debug + Import.log + "Rate limit is resetting" + ~old_remaining_api_calls:(server_side_info.remaining_api_calls : int)]); Server_side_info.freshest server_side_info response_server_side_info in update_server_side_info t ~new_server_side_info diff --git a/reddit_api_async/retry_manager.ml b/reddit_api_async/retry_manager.ml index 9565d19c..fe546584 100644 --- a/reddit_api_async/retry_manager.ml +++ b/reddit_api_async/retry_manager.ml @@ -29,7 +29,7 @@ module Permanent_error = struct [@@deriving sexp_of] let classify_error (error : Connection.Access_token_request_error.t) - : ('a, t) Transience.t + : ('a, t) Transience.t = match error with | Cohttp_raised _ | Json_parsing_error _ -> Transient_error @@ -37,8 +37,8 @@ module Permanent_error = struct Permanent (Error (Token_request_rejected { response; body })) | Other_http_error { response; body } -> (match Cohttp.Response.status response with - | #Cohttp.Code.server_error_status -> Transient_error - | _ -> Permanent (Error (Other_http_error { response; body }))) + | #Cohttp.Code.server_error_status -> Transient_error + | _ -> Permanent (Error (Other_http_error { response; body }))) ;; end @@ -57,8 +57,8 @@ module Permanent_error = struct | Json_response_errors errors -> Permanent (Error (Json_response_errors errors)) | Http_error { response; body } -> (match Cohttp.Response.status response with - | #Cohttp.Code.server_error_status -> Transient_error - | _ -> Permanent (Error (Http_error { response; body }))) + | #Cohttp.Code.server_error_status -> Transient_error + | _ -> Permanent (Error (Http_error { response; body }))) ;; end @@ -68,7 +68,7 @@ module Permanent_error = struct [@@deriving sexp_of] let classify_response (result : (_, Endpoint.Error.t Connection.Error.t) Result.t) - : (_, _) Transience.t + : (_, _) Transience.t = match result with | Ok result -> Permanent (Ok result) @@ -110,19 +110,19 @@ let on_permanent_response t = let check_server t = Deferred.repeat_until_finished () (fun () -> - let%bind response = get_read_only_page t in - match Permanent_error.classify_response response, t.state with - | Permanent _, Working_normally -> return (`Finished ()) - | Permanent _, Waiting_for_issue_resolution { finished } -> - Ivar.fill_exn finished (); - t.state <- Working_normally; - return (`Finished ()) - | Transient_error, Working_normally -> - t.state <- Waiting_for_issue_resolution { finished = Ivar.create () }; - return (`Repeat ()) - | Transient_error, Waiting_for_issue_resolution _ -> - let%bind () = Clock_ns.after Time_ns.Span.minute in - return (`Repeat ())) + let%bind response = get_read_only_page t in + match Permanent_error.classify_response response, t.state with + | Permanent _, Working_normally -> return (`Finished ()) + | Permanent _, Waiting_for_issue_resolution { finished } -> + Ivar.fill_exn finished (); + t.state <- Working_normally; + return (`Finished ()) + | Transient_error, Working_normally -> + t.state <- Waiting_for_issue_resolution { finished = Ivar.create () }; + return (`Repeat ()) + | Transient_error, Waiting_for_issue_resolution _ -> + let%bind () = Clock_ns.after Time_ns.Span.minute in + return (`Repeat ())) ;; let on_transient_error t = @@ -141,16 +141,16 @@ let rec call t endpoint = | Working_normally -> let%bind response = Connection.call t.connection endpoint in (match Permanent_error.classify_response response with - | Permanent response -> - on_permanent_response t; - return response - | Transient_error -> - let request = endpoint.request in - [%log.error - log - "Transient error" - (request : Endpoint.Request.t) - (response : (_, Endpoint.Error.t Connection.Error.t) Result.t)]; - on_transient_error t; - call t endpoint) + | Permanent response -> + on_permanent_response t; + return response + | Transient_error -> + let request = endpoint.request in + [%log.error + log + "Transient error" + (request : Endpoint.Request.t) + (response : (_, Endpoint.Error.t Connection.Error.t) Result.t)]; + on_transient_error t; + call t endpoint) ;; diff --git a/reddit_api_async/retry_manager.mli b/reddit_api_async/retry_manager.mli index af221054..11ab066c 100644 --- a/reddit_api_async/retry_manager.mli +++ b/reddit_api_async/retry_manager.mli @@ -31,8 +31,7 @@ Forbidden]. We expect that the request will not succeed unless either (a) the request is modified to no longer reference content to which the user does not have access; or (b) the user's permissions are modified outside of - this request. -*) + this request. *) open! Core open! Async @@ -74,8 +73,7 @@ end (** [call t f] immediately calls [f] unless the last result of such a call was a transient error. In the latter case, all calls block, and [call] - periodically calls a read-only API endpoint until service is restored. -*) + periodically calls a read-only API endpoint until service is restored. *) val call : t -> 'a Endpoint.t -> ('a, Permanent_error.t) Deferred.Result.t (** [yield_until_reddit_available] returns immediately if there is no known diff --git a/reddit_api_async/stream.ml b/reddit_api_async/stream.ml index ec20620f..ddc92fab 100644 --- a/reddit_api_async/stream.ml +++ b/reddit_api_async/stream.ml @@ -26,36 +26,36 @@ module State = struct end let stream - (type id) - (module Id : Hashtbl.Key_plain with type t = id) - connection - ~get_listing - ~get_before_parameter + (type id) + (module Id : Hashtbl.Key_plain with type t = id) + connection + ~get_listing + ~get_before_parameter = let module Bounded_set = Bounded_set.Make (Id) in let seen = Bounded_set.create ~capacity:300 in Pipe.create_reader ~close_on_exception:false (fun pipe -> - Deferred.repeat_until_finished - { State.first_pass = true - ; before = None - ; backoff = Backoff.initial - ; cache_busting_counter = 0 - } - (fun ({ first_pass; before; backoff; cache_busting_counter } : Id.t State.t) -> - let loop_after_backoff_and_pushback (state : _ State.t) = - let%bind () = Backoff.after state.backoff - and () = Pipe.pushback pipe in - return (`Repeat state) - in - match Pipe.is_closed pipe with - | true -> return (`Finished ()) - | false -> - let limit, cache_busting_counter = - match before with - | Some _ -> 100, cache_busting_counter - | None -> 100 - cache_busting_counter, (cache_busting_counter + 1) mod 30 - in - (match%bind Connection.call connection (get_listing ~before ~limit) with + Deferred.repeat_until_finished + { State.first_pass = true + ; before = None + ; backoff = Backoff.initial + ; cache_busting_counter = 0 + } + (fun ({ first_pass; before; backoff; cache_busting_counter } : Id.t State.t) -> + let loop_after_backoff_and_pushback (state : _ State.t) = + let%bind () = Backoff.after state.backoff + and () = Pipe.pushback pipe in + return (`Repeat state) + in + match Pipe.is_closed pipe with + | true -> return (`Finished ()) + | false -> + let limit, cache_busting_counter = + match before with + | Some _ -> 100, cache_busting_counter + | None -> 100 - cache_busting_counter, (cache_busting_counter + 1) mod 30 + in + (match%bind Connection.call connection (get_listing ~before ~limit) with | Error _ as response -> Pipe.write_without_pushback_if_open pipe response; let backoff = Backoff.increment backoff in @@ -64,16 +64,16 @@ let stream | Ok list_newest_to_oldest -> let list_newest_to_oldest = List.filter list_newest_to_oldest ~f:(fun child -> - not (Bounded_set.mem seen (get_before_parameter child : id))) + not (Bounded_set.mem seen (get_before_parameter child : id))) in List.iter list_newest_to_oldest ~f:(fun child -> - Bounded_set.add seen (get_before_parameter child)); + Bounded_set.add seen (get_before_parameter child)); (match first_pass with - | true -> () - | false -> - let list_oldest_to_newest = List.rev list_newest_to_oldest in - List.iter list_oldest_to_newest ~f:(fun elt -> - Pipe.write_without_pushback_if_open pipe (Ok elt))); + | true -> () + | false -> + let list_oldest_to_newest = List.rev list_newest_to_oldest in + List.iter list_oldest_to_newest ~f:(fun elt -> + Pipe.write_without_pushback_if_open pipe (Ok elt))); let before = let most_recent_element = List.hd list_newest_to_oldest in Option.map most_recent_element ~f:get_before_parameter diff --git a/reddit_api_kernel/endpoint.ml b/reddit_api_kernel/endpoint.ml index e223a4b2..57f32f3a 100644 --- a/reddit_api_kernel/endpoint.ml +++ b/reddit_api_kernel/endpoint.ml @@ -182,8 +182,8 @@ module Parameters = struct | Self body -> [ "kind", [ "self" ] ; (match body with - | Markdown markdown -> "text", [ markdown ] - | Richtext_json json -> "richtext_json", [ Jsonaf.to_string json ]) + | Markdown markdown -> "text", [ markdown ] + | Richtext_json json -> "richtext_json", [ Jsonaf.to_string json ]) ] | Crosspost link_id -> [ "kind", [ "crosspost" ] @@ -213,7 +213,7 @@ module Parameters = struct type t = | Id of [ `Link of Link.Id.t | `Comment of Comment.Id.t | `Subreddit of Subreddit.Id.t ] - list + list | Subreddit_name of Subreddit_name.t list | Url of Uri_with_string_sexp.t [@@deriving sexp] @@ -297,10 +297,10 @@ module Parameters = struct let params_of_t t = [ ( "how" , [ (match t with - | Mod -> "yes" - | Admin -> "admin" - | Special -> "special" - | Undistinguish -> "no") + | Mod -> "yes" + | Admin -> "admin" + | Special -> "special" + | Undistinguish -> "no") ] ) ] ;; @@ -317,11 +317,11 @@ module Parameters = struct let params_of_t t = [ ( "sort" , [ (match t with - | Relevance -> "relevance" - | Hot -> "hot" - | Top -> "top" - | New -> "new" - | Comments -> "comments") + | Relevance -> "relevance" + | Hot -> "hot" + | Top -> "top" + | New -> "new" + | Comments -> "comments") ] ) ] ;; @@ -356,9 +356,9 @@ module Parameters = struct let params_of_t t = [ ( "link_type" , [ (match t with - | Any -> "any" - | Link -> "link" - | Self -> "self") + | Any -> "any" + | Link -> "link" + | Self -> "self") ] ) ] ;; @@ -595,7 +595,7 @@ let parse_json_response response body = let body_string = Cohttp.Body.to_string body in Jsonaf.parse body_string |> Result.map_error ~f:(fun error -> - Error.Json_parsing_error { error; response; body_string }) + Error.Json_parsing_error { error; response; body_string }) ;; let map t ~f = @@ -654,45 +654,45 @@ let handle_json_response f (response, body) = | [] -> Some json | field :: rest -> (match Jsonaf.member field json with - | None -> None - | Some value -> find_repeated value rest) + | None -> None + | Some value -> find_repeated value rest) in let errors = match find_repeated json [ "json"; "errors" ] with | None -> None | Some list -> - (match Jsonaf.list_exn list with - | [] -> None - | errors -> Some (List.map errors ~f:Json_response_error.of_json_http_success) - : Json_response_error.t list option) + ((match Jsonaf.list_exn list with + | [] -> None + | errors -> Some (List.map errors ~f:Json_response_error.of_json_http_success)) + : Json_response_error.t list option) in (match errors with - | Some errors -> Error (Error.Json_response_errors errors) - | None -> Ok (f json)) + | Some errors -> Error (Error.Json_response_errors errors) + | None -> Ok (f json)) | `Bad_request -> (match Jsonaf.member "reason" json with - | None -> Error (Http_error { response; body }) - | Some reason -> - let error = Jsonaf.string_exn reason in - let error_type = - Jsonaf.member "error_type" json |> Option.map ~f:Jsonaf.string_exn - in - let details = Jsonaf.string_exn (Jsonaf.member_exn "explanation" json) in - let fields = - match Jsonaf.member "fields" json with - | None -> [] - | Some json -> [%of_jsonaf: string list] json - in - Error (Json_response_errors [ { error_type; error; details; fields } ])) + | None -> Error (Http_error { response; body }) + | Some reason -> + let error = Jsonaf.string_exn reason in + let error_type = + Jsonaf.member "error_type" json |> Option.map ~f:Jsonaf.string_exn + in + let details = Jsonaf.string_exn (Jsonaf.member_exn "explanation" json) in + let fields = + match Jsonaf.member "fields" json with + | None -> [] + | Some json -> [%of_jsonaf: string list] json + in + Error (Json_response_errors [ { error_type; error; details; fields } ])) ;; let assert_no_errors = handle_json_response (const ()) let ignore_empty_object = handle_json_response (fun json -> - match json with - | `Object [] -> () - | _ -> raise_s [%message "Unexpected JSON response" (json : Jsonaf.t)]) + match json with + | `Object [] -> () + | _ -> raise_s [%message "Unexpected JSON response" (json : Jsonaf.t)]) ;; let link_or_comment_of_json json = @@ -715,12 +715,12 @@ let get_subreddit_listing = get_listing [%of_jsonaf: Subreddit.t] let get_tropy_list = handle_json_response (fun json -> - match json with - | `Object - [ ("kind", `String "TrophyList") - ; ("data", `Object [ ("trophies", `Array trophies) ]) - ] -> List.map trophies ~f:[%of_jsonaf: Award.t] - | _ -> raise_s [%message "Unexpected \"TrophyList\" JSON" (json : Jsonaf.t)]) + match json with + | `Object + [ ("kind", `String "TrophyList") + ; ("data", `Object [ ("trophies", `Array trophies) ]) + ] -> List.map trophies ~f:[%of_jsonaf: Award.t] + | _ -> raise_s [%message "Unexpected \"TrophyList\" JSON" (json : Jsonaf.t)]) ;; let me = get ~endpoint:"/api/v1/me" ~params:[] (handle_json_response [%of_jsonaf: User.t]) @@ -772,14 +772,14 @@ let messaging = prefs "messaging" (handle_json_response userlist) let trusted = prefs "trusted" (handle_json_response userlist) let select_flair - ?background_color - ?css_class - ?flair_template_id - ?text - ?text_color - () - ~subreddit - ~target + ?background_color + ?css_class + ?flair_template_id + ?text + ?text_color + () + ~subreddit + ~target = let endpoint = optional_subreddit_endpoint ~subreddit "/api/selectflair" in let params = @@ -798,12 +798,12 @@ let select_flair let handle_things_response = handle_json_response (fun json -> - Jsonaf.member_exn "json" json - |> Jsonaf.member_exn "data" - |> Jsonaf.member_exn "things" - |> Jsonaf.list_exn - |> List.hd_exn - |> [%of_jsonaf: Thing.Poly.t]) + Jsonaf.member_exn "json" json + |> Jsonaf.member_exn "data" + |> Jsonaf.member_exn "things" + |> Jsonaf.list_exn + |> List.hd_exn + |> [%of_jsonaf: Thing.Poly.t]) ;; let add_reply_endpoint = "/api/comment" @@ -822,10 +822,9 @@ let add_reply_params ?return_rtjson ?richtext_json () ~parent ~text = let add_comment ?return_rtjson ?richtext_json () ~parent ~text = let params = add_reply_params ?return_rtjson ?richtext_json () ~parent ~text in post ~endpoint:add_reply_endpoint ~params (fun response -> - match%bind handle_things_response response with - | `Comment c -> Ok c - | response -> - raise_s [%message "Expected comment response" (response : Thing.Poly.t)]) + match%bind handle_things_response response with + | `Comment c -> Ok c + | response -> raise_s [%message "Expected comment response" (response : Thing.Poly.t)]) ;; let reply_to_message ?return_rtjson ?richtext_json () ~parent ~text = @@ -833,10 +832,9 @@ let reply_to_message ?return_rtjson ?richtext_json () ~parent ~text = add_reply_params ?return_rtjson ?richtext_json () ~parent:(`Message parent) ~text in post ~endpoint:add_reply_endpoint ~params (fun response -> - match%bind handle_things_response response with - | `Message m -> Ok m - | response -> - raise_s [%message "Expected message response" (response : Thing.Poly.t)]) + match%bind handle_things_response response with + | `Message m -> Ok m + | response -> raise_s [%message "Expected message response" (response : Thing.Poly.t)]) ;; let delete ~id = @@ -861,10 +859,10 @@ let edit ?return_rtjson ?richtext_json () ~id ~text = ] in post ~endpoint ~params (fun response -> - match%bind handle_things_response response with - | (`Link _ | `Comment _) as v -> Ok v - | response -> - raise_s [%message "Expected link or comment response" (response : Thing.Poly.t)]) + match%bind handle_things_response response with + | (`Link _ | `Comment _) as v -> Ok v + | response -> + raise_s [%message "Expected link or comment response" (response : Thing.Poly.t)]) ;; let simple_toggle verb fullnames k direction = @@ -889,13 +887,13 @@ let info query = let endpoint = optional_subreddit_endpoint "/api/info" in let params = Info_query.params_of_t query in get ~endpoint ~params (fun response -> - let handle_json json = - let thing = [%of_jsonaf: Thing.Poly.t] json in - match thing with - | (`Link _ | `Comment _ | `Subreddit _) as thing -> thing - | _ -> raise_s [%message "Unexpected kind in listing" (thing : Thing.Poly.t)] - in - get_listing handle_json response >>| Listing.children) + let handle_json json = + let thing = [%of_jsonaf: Thing.Poly.t] json in + match thing with + | (`Link _ | `Comment _ | `Subreddit _) as thing -> thing + | _ -> raise_s [%message "Unexpected kind in listing" (thing : Thing.Poly.t)] + in + get_listing handle_json response >>| Listing.children) ;; let lock' ~id = simple_toggle' "lock" id ignore_empty_object @@ -922,24 +920,24 @@ let more_children ?limit_children () ~link ~more_comments ~sort = ~endpoint ~params (handle_json_response (fun json -> - Jsonaf.member_exn "json" json - |> Jsonaf.member_exn "data" - |> Jsonaf.member_exn "things" - |> [%of_jsonaf: comment_or_more list])) + Jsonaf.member_exn "json" json + |> Jsonaf.member_exn "data" + |> Jsonaf.member_exn "things" + |> [%of_jsonaf: comment_or_more list])) ;; let report - ?from_modmail - ?from_help_desk - ?additional_info - ?custom_text - ?other_reason - ?rule_reason - ?site_reason - ?sr_name - () - ~target - ~reason + ?from_modmail + ?from_help_desk + ?additional_info + ?custom_text + ?other_reason + ?rule_reason + ?site_reason + ?sr_name + () + ~target + ~reason = let endpoint = "/api/report" in let params = @@ -1047,21 +1045,21 @@ let store_visits ~links = ;; let submit - ?ad - ?nsfw - ?resubmit - ?sendreplies - ?spoiler - ?flair_id - ?flair_text - ?collection_id - ?event_start - ?event_end - ?event_tz - () - ~subreddit - ~title - ~kind + ?ad + ?nsfw + ?resubmit + ?sendreplies + ?spoiler + ?flair_id + ?flair_text + ?collection_id + ?event_start + ?event_end + ?event_tz + () + ~subreddit + ~title + ~kind = let endpoint = "/api/submit" in let params = @@ -1089,10 +1087,10 @@ let submit ~endpoint ~params (handle_json_response (fun json -> - let json = Jsonaf.member_exn "json" json |> Jsonaf.member_exn "data" in - let id = Jsonaf.member_exn "id" json |> Jsonaf.string_exn |> Link.Id.of_string in - let url = Jsonaf.member_exn "url" json |> Jsonaf.string_exn |> Uri.of_string in - id, url)) + let json = Jsonaf.member_exn "json" json |> Jsonaf.member_exn "data" in + let id = Jsonaf.member_exn "id" json |> Jsonaf.string_exn |> Link.Id.of_string in + let url = Jsonaf.member_exn "url" json |> Jsonaf.string_exn |> Uri.of_string in + id, url)) ;; let vote ?rank () ~direction ~target = @@ -1129,18 +1127,18 @@ let links_by_id ~links = ;; let comments - ?subreddit - ?comment - ?context - ?depth - ?limit - ?showedits - ?showmore - ?sort - ?threaded - ?truncate - () - ~link + ?subreddit + ?comment + ?context + ?depth + ?limit + ?showedits + ?showmore + ?sort + ?threaded + ?truncate + () + ~link = let endpoint = optional_subreddit_endpoint ?subreddit (sprintf !"/comments/%{Link.Id}" link) @@ -1163,17 +1161,16 @@ let comments ~endpoint ~params (handle_json_response (fun json -> - match Jsonaf.list_exn json with - | [ link_json; comment_forest_json ] -> - let link = - [%of_jsonaf: Link.t Listing.t] link_json |> Listing.children |> List.hd_exn - in - let comment_forest = - [%of_jsonaf: comment_or_more Listing.t] comment_forest_json - |> Listing.children - in - { Comment_response.link; comment_forest } - | json -> raise_s [%message "Expected two-item response" (json : Jsonaf.t list)])) + match Jsonaf.list_exn json with + | [ link_json; comment_forest_json ] -> + let link = + [%of_jsonaf: Link.t Listing.t] link_json |> Listing.children |> List.hd_exn + in + let comment_forest = + [%of_jsonaf: comment_or_more Listing.t] comment_forest_json |> Listing.children + in + { Comment_response.link; comment_forest } + | json -> raise_s [%message "Expected two-item response" (json : Jsonaf.t list)])) ;; let duplicates' ~listing_params ?crossposts_only ?sort () ~link = @@ -1192,12 +1189,12 @@ let duplicates' ~listing_params ?crossposts_only ?sort () ~link = let duplicates = with_listing_params duplicates' let basic_post_listing' - endpoint_part - ~listing_params - ?include_categories - ?subreddit - () - ~extra_params + endpoint_part + ~listing_params + ?include_categories + ?subreddit + () + ~extra_params = let endpoint = optional_subreddit_endpoint ?subreddit endpoint_part in let params = @@ -1420,17 +1417,17 @@ let distinguish ?sticky () ~id ~how = ~endpoint ~params (handle_json_response (fun json -> - let thing = - Jsonaf.member_exn "json" json - |> Jsonaf.member_exn "data" - |> Jsonaf.member_exn "things" - |> Jsonaf.list_exn - |> List.hd_exn - |> [%of_jsonaf: Thing.Poly.t] - in - match thing with - | (`Comment _ | `Link _) as thing -> thing - | _ -> raise_s [%message "Expected comment or link" (thing : Thing.Poly.t)])) + let thing = + Jsonaf.member_exn "json" json + |> Jsonaf.member_exn "data" + |> Jsonaf.member_exn "things" + |> Jsonaf.list_exn + |> List.hd_exn + |> [%of_jsonaf: Thing.Poly.t] + in + match thing with + | (`Comment _ | `Link _) as thing -> thing + | _ -> raise_s [%message "Expected comment or link" (thing : Thing.Poly.t)])) ;; let ignore_reports' ~id = simple_toggle' "ignore_reports" id ignore_empty_object @@ -1488,15 +1485,15 @@ let reply_modmail_conversation ~body ~conversation_id ~hide_author ~internal = ;; let search' - ~listing_params - ?category - ?include_facets - ?restrict_to_subreddit - ?since - ?sort - ?types - () - ~query + ~listing_params + ?category + ?include_facets + ?restrict_to_subreddit + ?since + ?sort + ?types + () + ~query = let subreddit_part, restrict_param = match restrict_to_subreddit with @@ -1522,54 +1519,52 @@ let search' ~endpoint ~params (handle_json_response (fun json -> - let to_link_opt thing = - match thing with - | `Link link -> Some link - | _ -> None - in - let to_user_or_subreddit_opt thing = - match thing with - | (`User _ | `Subreddit _) as v -> Some v - | _ -> None - in - let listings = - let jsons = - match json with - | `Object _ as json -> [ json ] - | `Array listings -> listings - | _ -> raise_s [%message "Unexpected search response" (json : Jsonaf.t)] - in - List.map jsons ~f:[%of_jsonaf: Thing.Poly.t Listing.t] - in - let find_kinded_listing extract_subkind error_message = - List.find_map listings ~f:(fun listing -> - (* If the first element belongs in one of the result listings... *) - match - Listing.children listing - |> List.hd - |> Option.bind ~f:extract_subkind - |> Option.is_some - with - | false -> None - | true -> - (* ...then expect them all to be in that listing. *) - Some - (Listing.map listing ~f:(fun thing -> - match extract_subkind thing with - | Some v -> v - | None -> raise_s [%message error_message (json : Jsonaf.t)]))) - in - let link_listing = - find_kinded_listing - to_link_opt - "Expected only links in search response listing" - in - let user_or_subreddit_listing = - find_kinded_listing - to_user_or_subreddit_opt - "Expected only users or subreddits in search response listing" + let to_link_opt thing = + match thing with + | `Link link -> Some link + | _ -> None + in + let to_user_or_subreddit_opt thing = + match thing with + | (`User _ | `Subreddit _) as v -> Some v + | _ -> None + in + let listings = + let jsons = + match json with + | `Object _ as json -> [ json ] + | `Array listings -> listings + | _ -> raise_s [%message "Unexpected search response" (json : Jsonaf.t)] in - link_listing, user_or_subreddit_listing)) + List.map jsons ~f:[%of_jsonaf: Thing.Poly.t Listing.t] + in + let find_kinded_listing extract_subkind error_message = + List.find_map listings ~f:(fun listing -> + (* If the first element belongs in one of the result listings... *) + match + Listing.children listing + |> List.hd + |> Option.bind ~f:extract_subkind + |> Option.is_some + with + | false -> None + | true -> + (* ...then expect them all to be in that listing. *) + Some + (Listing.map listing ~f:(fun thing -> + match extract_subkind thing with + | Some v -> v + | None -> raise_s [%message error_message (json : Jsonaf.t)]))) + in + let link_listing = + find_kinded_listing to_link_opt "Expected only links in search response listing" + in + let user_or_subreddit_listing = + find_kinded_listing + to_user_or_subreddit_opt + "Expected only users or subreddits in search response listing" + in + link_listing, user_or_subreddit_listing)) ;; let search = with_listing_params search' @@ -1639,55 +1634,55 @@ let search_subreddits_by_name ?exact ?include_over_18 ?include_unadvertisable () ~endpoint ~params (handle_json_response (fun json -> - Jsonaf.member_exn "names" json - |> [%of_jsonaf: string list] - |> List.map ~f:Subreddit_name.of_string)) + Jsonaf.member_exn "names" json + |> [%of_jsonaf: string list] + |> List.map ~f:Subreddit_name.of_string)) ;; let create_or_edit_subreddit - ?comment_score_hide_mins - ?wiki_edit_age - ?wiki_edit_karma - () - ~all_original_content - ~allow_discovery - ~allow_images - ~allow_post_crossposts - ~allow_top - ~allow_videos - ~api_type - ~collapse_deleted_comments - ~crowd_control_mode - ~description - ~disable_contributor_requests - ~exclude_banned_modqueue - ~free_form_reports - ~g_recaptcha_response - ~header_title - ~hide_ads - ~key_color - ~lang - ~link_type - ~name - ~original_content_tag_enabled - ~over_18 - ~public_description - ~restrict_commenting - ~restrict_posting - ~show_media - ~show_media_preview - ~spam_comments - ~spam_links - ~spam_selfposts - ~spoilers_enabled - ~subreddit - ~submit_link_label - ~submit_text - ~submit_text_label - ~suggested_comment_sort - ~title - ~type_ - ~wiki_mode + ?comment_score_hide_mins + ?wiki_edit_age + ?wiki_edit_karma + () + ~all_original_content + ~allow_discovery + ~allow_images + ~allow_post_crossposts + ~allow_top + ~allow_videos + ~api_type + ~collapse_deleted_comments + ~crowd_control_mode + ~description + ~disable_contributor_requests + ~exclude_banned_modqueue + ~free_form_reports + ~g_recaptcha_response + ~header_title + ~hide_ads + ~key_color + ~lang + ~link_type + ~name + ~original_content_tag_enabled + ~over_18 + ~public_description + ~restrict_commenting + ~restrict_posting + ~show_media + ~show_media_preview + ~spam_comments + ~spam_links + ~spam_selfposts + ~spoilers_enabled + ~subreddit + ~submit_link_label + ~submit_text + ~submit_text_label + ~suggested_comment_sort + ~title + ~type_ + ~wiki_mode = let endpoint = "/api/site_admin" in let params = @@ -1746,12 +1741,12 @@ let submit_text ~subreddit = ;; let subreddit_autocomplete - ?limit - ?include_categories - ?include_over_18 - ?include_profiles - () - ~query + ?limit + ?include_categories + ?include_over_18 + ?include_profiles + () + ~query = let endpoint = "/api/subreddit_autocomplete_v2" in let params = @@ -1857,11 +1852,11 @@ let get_subreddits' ~listing_params ?include_categories () ~relationship = let get_subreddits = with_listing_params get_subreddits' let search_subreddits_by_title_and_description' - ~listing_params - ?show_users - ?sort - () - ~query + ~listing_params + ?show_users + ?sort + () + ~query = let endpoint = "/subreddits/search" in let params = @@ -1925,24 +1920,24 @@ let user_comments = let user_private_overview ~endpoint_suffix = overview_gen ~endpoint_suffix ~handle_response:(fun response -> - match get_link_listing response with - | Ok v -> Ok (`Listing v) - | Error (Http_error { response = { status = `Forbidden; _ }; _ }) -> Ok `Private - | Error _ as error -> error) + match get_link_listing response with + | Ok v -> Ok (`Listing v) + | Error (Http_error { response = { status = `Forbidden; _ }; _ }) -> Ok `Private + | Error _ as error -> error) ;; let user_upvoted = user_private_overview ~endpoint_suffix:"upvoted" let user_downvoted = user_private_overview ~endpoint_suffix:"downvoted" let logged_in_user_overview - ~endpoint_suffix - ~handle_response - ?pagination - ?count - ?limit - ?show_all - () - ~logged_in_username + ~endpoint_suffix + ~handle_response + ?pagination + ?count + ?limit + ?show_all + () + ~logged_in_username = (overview_gen ~endpoint_suffix ~handle_response) ?pagination @@ -1988,15 +1983,15 @@ let list_user_subreddits' ~listing_params ?include_categories () ~sort = let list_user_subreddits = with_listing_params list_user_subreddits' let add_relationship - ?subreddit - ?note - ?ban_reason - ?ban_message - ?ban_context - () - ~relationship - ~username - ~duration + ?subreddit + ?note + ?ban_reason + ?ban_message + ?ban_context + () + ~relationship + ~username + ~duration = let endpoint = optional_subreddit_endpoint ?subreddit "/api/friend" in let params = @@ -2046,11 +2041,11 @@ let add_wiki_editor = add_or_remove_wiki_editor ~act:"add" let remove_wiki_editor = add_or_remove_wiki_editor ~act:"del" let edit_wiki_page - ?previous - ?reason - () - ~content - ~page:({ subreddit; page } : Wiki_page.Id.t) + ?previous + ?reason + () + ~content + ~page:({ subreddit; page } : Wiki_page.Id.t) = let endpoint = optional_subreddit_endpoint ?subreddit "/api/wiki/edit" in let params = @@ -2063,14 +2058,14 @@ let edit_wiki_page ] in post ~endpoint ~params (fun (response, body) -> - match Cohttp.Response.status response with - | `Conflict -> - let%bind json = parse_json_response response body in - Ok (Error ([%of_jsonaf: Wiki_page.Edit_conflict.t] json)) - | _ -> - (match ignore_empty_object (response, body) with - | Ok () -> Ok (Ok ()) - | Error _ as error -> error)) + match Cohttp.Response.status response with + | `Conflict -> + let%bind json = parse_json_response response body in + Ok (Error ([%of_jsonaf: Wiki_page.Edit_conflict.t] json)) + | _ -> + (match ignore_empty_object (response, body) with + | Ok () -> Ok (Ok ()) + | Error _ as error -> error)) ;; let toggle_wiki_revision_visibility ~page:({ subreddit; page } : Wiki_page.Id.t) ~revision @@ -2087,12 +2082,12 @@ let toggle_wiki_revision_visibility ~page:({ subreddit; page } : Wiki_page.Id.t) ~endpoint ~params (handle_json_response (function - | `Object [ ("status", `True) ] -> `Became_hidden - | `Object [ ("status", `False) ] -> `Became_visible - | json -> - raise_s - [%message - "Unexpected toggle_wiki_revision_visibility response" (json : Jsonaf.t)])) + | `Object [ ("status", `True) ] -> `Became_hidden + | `Object [ ("status", `False) ] -> `Became_visible + | json -> + raise_s + [%message + "Unexpected toggle_wiki_revision_visibility response" (json : Jsonaf.t)])) ;; let revert_wiki_page ~page:({ subreddit; page } : Wiki_page.Id.t) ~revision = @@ -2122,7 +2117,7 @@ let wiki_pages ?subreddit () = ~endpoint ~params:[] (handle_json_response (fun json -> - Jsonaf.member_exn "data" json |> [%of_jsonaf: string list])) + Jsonaf.member_exn "data" json |> [%of_jsonaf: string list])) ;; let subreddit_wiki_revisions' ~listing_params ?subreddit () = diff --git a/reddit_api_kernel/endpoint.mli b/reddit_api_kernel/endpoint.mli index 84ef13d0..016f9fbf 100644 --- a/reddit_api_kernel/endpoint.mli +++ b/reddit_api_kernel/endpoint.mli @@ -67,7 +67,7 @@ module Parameters : sig type t = | Id of [ `Link of Link.Id.t | `Comment of Comment.Id.t | `Subreddit of Subreddit.Id.t ] - list + list | Subreddit_name of Subreddit_name.t list | Url of Uri.t [@@deriving sexp] @@ -264,8 +264,8 @@ module Json_response_error : sig type t = { error : string (** An all-caps string acting as an identifier for the error. *) ; error_type : string option - (** An all-caps string identifying a category of errors. May - encompass many different [error] values. *) + (** An all-caps string identifying a category of errors. May + encompass many different [error] values. *) ; details : string (** A human-readable explanation of the error. *) ; fields : string list (** A list of HTTP parameters with erroneous values. *) } @@ -279,8 +279,7 @@ end responses indicating an illegal operation, such as permission errors. It does not include programming errors within [Reddit_api_kernel]; if we - can't parse a response, we raise instead of returning an error value. -*) + can't parse a response, we raise instead of returning an error value. *) module Error : sig type t = | Cohttp_raised of Exn.t @@ -293,19 +292,17 @@ module Error : sig { response : Cohttp.Response.t ; body : Cohttp.Body.t } - (** An [Http_error] represents an HTTP response with an error status for - which we have not parsed details from the JSON body. + (** An [Http_error] represents an HTTP response with an error status for + which we have not parsed details from the JSON body. - [400 Bad Request] responses come with parseable JSON details, so - they are included under [Json_response_errors] instead. - *) + [400 Bad Request] responses come with parseable JSON details, so + they are included under [Json_response_errors] instead. *) | Json_response_errors of Json_response_error.t list [@@deriving sexp_of] end (** A [t] represents the combinaton of an HTTP request to Reddit and a function - for turning the HTTP response into a typed representation. -*) + for turning the HTTP response into a typed representation. *) type 'a t = { request : Request.t ; handle_response : Cohttp.Response.t * Cohttp.Body.t -> ('a, Error.t) Result.t @@ -317,14 +314,13 @@ val map : 'a t -> f:('a -> 'b) -> 'b t (** A value of type [_ with_listing_params] is a function with optional arguments representing Reddit's "listing" pagination protocol. - @see Reddit's listing docs -*) + @see Reddit's listing docs *) type 'a with_listing_params := ?pagination:Listing.Pagination.t -> ?count:int -> ?limit:int -> ?show_all:unit -> 'a -(** {1 Endpoints } *) +(** {1 Endpoints} *) -(** {2 Account } *) +(** {2 Account} *) val me : User.t t val karma : Karma_list.t t @@ -334,7 +330,7 @@ val blocked : (unit -> User_list.t t) with_listing_params val messaging : (unit -> User_list.t t) with_listing_params val trusted : (unit -> User_list.t t) with_listing_params -(** {2 Flair } *) +(** {2 Flair} *) val select_flair : ?background_color:Color.t @@ -347,7 +343,7 @@ val select_flair -> target:Flair_target.t -> unit t -(** {2 Links and comments } *) +(** {2 Links and comments} *) val add_comment : ?return_rtjson:bool @@ -470,10 +466,10 @@ val info | `Link of Thing.Link.t | `Subreddit of Thing.Subreddit.t ] - list - t + list + t -(** {2 Listings } *) +(** {2 Listings} *) val best : (?include_categories:bool -> unit -> Link.t Listing.t t) with_listing_params val links_by_id : links:Link.Id.t list -> Link.t Listing.t t @@ -499,7 +495,7 @@ val duplicates -> unit -> link:Link.Id.t -> Link.t Listing.t t) - with_listing_params + with_listing_params val hot : (?location:string @@ -507,21 +503,21 @@ val hot -> ?subreddit:Subreddit_name.t -> unit -> Link.t Listing.t t) - with_listing_params + with_listing_params val new_ : (?include_categories:bool -> ?subreddit:Subreddit_name.t -> unit -> Link.t Listing.t t) - with_listing_params + with_listing_params val rising : (?include_categories:bool -> ?subreddit:Subreddit_name.t -> unit -> Link.t Listing.t t) - with_listing_params + with_listing_params val top : (?since:Historical_span.t @@ -529,7 +525,7 @@ val top -> ?subreddit:Subreddit_name.t -> unit -> Link.t Listing.t t) - with_listing_params + with_listing_params val controversial : (?since:Historical_span.t @@ -537,11 +533,11 @@ val controversial -> ?subreddit:Subreddit_name.t -> unit -> Link.t Listing.t t) - with_listing_params + with_listing_params val random : ?subreddit:Subreddit_name.t -> unit -> Link.Id.t t -(** {2 Private messages } *) +(** {2 Private messages} *) val block_author : id:[< `Comment of Comment.Id.t | `Message of Message.Id.t ] -> unit t val collapse_message : messages:Message.Id.t list -> unit t @@ -566,7 +562,7 @@ val inbox -> unit -> mark_read:bool -> Inbox_item.t Listing.t t) - with_listing_params + with_listing_params val unread : (?include_categories:bool @@ -574,11 +570,11 @@ val unread -> unit -> mark_read:bool -> Inbox_item.t Listing.t t) - with_listing_params + with_listing_params val sent : (?include_categories:bool -> ?mid:string -> unit -> Message.t Listing.t t) - with_listing_params + with_listing_params val comment_replies : (?include_categories:bool @@ -586,12 +582,12 @@ val comment_replies -> unit -> mark_read:bool -> Inbox_item.Comment.t Listing.t t) - with_listing_params + with_listing_params val subreddit_comments : (unit -> subreddit:Subreddit_name.t -> Comment.t Listing.t t) with_listing_params -(** {2 Moderation } *) +(** {2 Moderation} *) val log : (?mod_filter:Mod_filter.t @@ -599,7 +595,7 @@ val log -> ?type_:string -> unit -> Mod_action.t Listing.t t) - with_listing_params + with_listing_params val reports : (?location:string @@ -607,7 +603,7 @@ val reports -> ?subreddit:Subreddit_name.t -> unit -> [ `Link of Link.t | `Comment of Comment.t ] Listing.t t) - with_listing_params + with_listing_params val spam : (?location:string @@ -615,7 +611,7 @@ val spam -> ?subreddit:Subreddit_name.t -> unit -> [ `Link of Link.t | `Comment of Comment.t ] Listing.t t) - with_listing_params + with_listing_params val modqueue : (?location:string @@ -623,7 +619,7 @@ val modqueue -> ?subreddit:Subreddit_name.t -> unit -> [ `Link of Link.t | `Comment of Comment.t ] Listing.t t) - with_listing_params + with_listing_params val unmoderated : (?location:string @@ -631,7 +627,7 @@ val unmoderated -> ?subreddit:Subreddit_name.t -> unit -> [ `Link of Link.t | `Comment of Comment.t ] Listing.t t) - with_listing_params + with_listing_params val edited : (?location:string @@ -639,7 +635,7 @@ val edited -> ?subreddit:Subreddit_name.t -> unit -> [ `Link of Link.t | `Comment of Comment.t ] Listing.t t) - with_listing_params + with_listing_params val accept_moderator_invite : subreddit:Subreddit_name.t @@ -663,7 +659,7 @@ val mute_message_author : message:Message.Id.t -> unit t val unmute_message_author : message:Message.Id.t -> unit t val stylesheet : subreddit:Subreddit_name.t -> Stylesheet.t t -(** {2 New modmail } *) +(** {2 New modmail} *) val create_modmail_conversation : subject:string @@ -680,7 +676,7 @@ val reply_modmail_conversation -> internal:bool -> Modmail.Conversation.t t -(** {2 Search } *) +(** {2 Search} *) val search : (?category:string @@ -693,10 +689,10 @@ val search -> query:string -> (Thing.Link.t Listing.t option * [ `Subreddit of Thing.Subreddit.t | `User of Thing.User.t ] Listing.t option) - t) - with_listing_params + t) + with_listing_params -(** {2 Subreddits } *) +(** {2 Subreddits} *) val banned : (?include_categories:bool @@ -704,7 +700,7 @@ val banned -> unit -> subreddit:Subreddit_name.t -> Relationship.Ban.t Listing.t t) - with_listing_params + with_listing_params val muted : (?include_categories:bool @@ -712,7 +708,7 @@ val muted -> unit -> subreddit:Subreddit_name.t -> Relationship.Mute.t Listing.t t) - with_listing_params + with_listing_params val wiki_banned : (?include_categories:bool @@ -720,7 +716,7 @@ val wiki_banned -> unit -> subreddit:Subreddit_name.t -> Relationship.Ban.t Listing.t t) - with_listing_params + with_listing_params val contributors : (?include_categories:bool @@ -728,7 +724,7 @@ val contributors -> unit -> subreddit:Subreddit_name.t -> Relationship.Contributor.t Listing.t t) - with_listing_params + with_listing_params val wiki_contributors : (?include_categories:bool @@ -736,7 +732,7 @@ val wiki_contributors -> unit -> subreddit:Subreddit_name.t -> Relationship.Contributor.t Listing.t t) - with_listing_params + with_listing_params val moderators : (?include_categories:bool @@ -744,7 +740,7 @@ val moderators -> unit -> subreddit:Subreddit_name.t -> Relationship.Moderator.t Listing.t t) - with_listing_params + with_listing_params val delete_subreddit_image : subreddit:Subreddit_name.t @@ -832,7 +828,7 @@ val subscribe val search_users : (?sort:Relevance_or_activity.t -> unit -> query:string -> User.t Listing.t t) - with_listing_params + with_listing_params val about_subreddit : subreddit:Subreddit_name.t -> Subreddit.t t @@ -852,7 +848,7 @@ val get_subreddits -> unit -> relationship:Subreddit_relationship.t -> Subreddit.t Listing.t t) - with_listing_params + with_listing_params val search_subreddits_by_title_and_description : (?show_users:bool @@ -860,7 +856,7 @@ val search_subreddits_by_title_and_description -> unit -> query:string -> Subreddit.t Listing.t t) - with_listing_params + with_listing_params val list_subreddits : (?include_categories:bool @@ -868,9 +864,9 @@ val list_subreddits -> unit -> sort:Subreddit_listing_sort.t -> Subreddit.t Listing.t t) - with_listing_params + with_listing_params -(** {2 Users } *) +(** {2 Users} *) val about_user : username:Username.t -> User.t t @@ -878,7 +874,7 @@ val user_overview : (unit -> username:Username.t -> [ `Link of Link.t | `Comment of Comment.t ] Listing.t t) - with_listing_params + with_listing_params val user_submitted : (unit -> username:Username.t -> Link.t Listing.t t) with_listing_params @@ -888,11 +884,11 @@ val user_comments val user_upvoted : (unit -> username:Username.t -> [ `Listing of Link.t Listing.t | `Private ] t) - with_listing_params + with_listing_params val user_downvoted : (unit -> username:Username.t -> [ `Listing of Link.t Listing.t | `Private ] t) - with_listing_params + with_listing_params val user_hidden : (unit -> logged_in_username:Username.t -> Link.t Listing.t t) with_listing_params @@ -901,13 +897,13 @@ val user_saved : (unit -> logged_in_username:Username.t -> [ `Link of Link.t | `Comment of Comment.t ] Listing.t t) - with_listing_params + with_listing_params val user_gilded : (unit -> username:Username.t -> [ `Link of Link.t | `Comment of Comment.t ] Listing.t t) - with_listing_params + with_listing_params val user_trophies : username:Username.t -> Award.t list t @@ -916,7 +912,7 @@ val list_user_subreddits -> unit -> sort:User_subreddit_sort.t -> Subreddit.t Listing.t t) - with_listing_params + with_listing_params val add_relationship : ?subreddit:Subreddit_name.t @@ -937,7 +933,7 @@ val remove_relationship -> username:Username.t -> unit t -(** {2 Wiki } *) +(** {2 Wiki} *) val add_wiki_editor : page:Wiki_page.Id.t -> user:Username.t -> unit t val remove_wiki_editor : page:Wiki_page.Id.t -> user:Username.t -> unit t @@ -964,7 +960,7 @@ val wiki_pages : ?subreddit:Subreddit_name.t -> unit -> string list t val subreddit_wiki_revisions : (?subreddit:Subreddit_name.t -> unit -> Wiki_page.Revision.t Listing.t t) - with_listing_params + with_listing_params val wiki_page_revisions : (unit -> page:Wiki_page.Id.t -> Wiki_page.Revision.t Listing.t t) with_listing_params diff --git a/reddit_api_kernel/id36.ml b/reddit_api_kernel/id36.ml index 9fb8dcac..4e0a1d09 100644 --- a/reddit_api_kernel/id36.ml +++ b/reddit_api_kernel/id36.ml @@ -13,8 +13,8 @@ module M = struct match Int63.equal i Int63.zero with | true -> (match acc with - | [] -> "0" - | _ -> String.of_char_list acc) + | [] -> "0" + | _ -> String.of_char_list acc) | false -> let current_place = Option.value_exn (Int63.to_int Int63.O.(i % base)) in let character = @@ -33,11 +33,11 @@ module M = struct let convert_to_offset base_char = Char.to_int c - Char.to_int base_char in Int63.of_int (match Char.is_alpha c with - | true -> convert_to_offset 'a' + 10 - | false -> convert_to_offset '0') + | true -> convert_to_offset 'a' + 10 + | false -> convert_to_offset '0') in String.fold t ~init:Int63.zero ~f:(fun acc c -> - Int63.O.((acc * base) + convert_char c)) + Int63.O.((acc * base) + convert_char c)) ;; let sexp_of_t t = to_string t |> sexp_of_string diff --git a/reddit_api_kernel/inbox_item.ml b/reddit_api_kernel/inbox_item.ml index 10404e73..7789c276 100644 --- a/reddit_api_kernel/inbox_item.ml +++ b/reddit_api_kernel/inbox_item.ml @@ -4,8 +4,8 @@ module Comment = struct include Json_object.Utils include Json_object.Make_kinded_simple (struct - let kind = "t1" - end) + let kind = "t1" + end) module Type = struct type t = @@ -32,22 +32,21 @@ module Comment = struct let parent_id = required_field "parent_id" (fun json -> - let id_string = string json in - match Thing.Fullname.of_string id_string with - | (`Comment _ | `Link _) as v -> v - | _ -> - raise_s - [%message "Unexpected Inbox.Comment.parent_id kind" (id_string : string)]) + let id_string = string json in + match Thing.Fullname.of_string id_string with + | (`Comment _ | `Link _) as v -> v + | _ -> + raise_s [%message "Unexpected Inbox.Comment.parent_id kind" (id_string : string)]) ;; let new_ = required_field "new" bool let type_ = required_field "type" (fun json : Type.t -> - match string json with - | "post_reply" -> Link_reply - | "comment_reply" -> Comment_reply - | type_ -> raise_s [%message "Unrecognized Inbox.Comment.t type" (type_ : string)]) + match string json with + | "post_reply" -> Link_reply + | "comment_reply" -> Comment_reply + | type_ -> raise_s [%message "Unrecognized Inbox.Comment.t type" (type_ : string)]) ;; let link_id = required_field "context" (uri >> Thing.Link.Id.of_uri) diff --git a/reddit_api_kernel/inbox_item.mli b/reddit_api_kernel/inbox_item.mli index fc7f0279..46f81e3b 100644 --- a/reddit_api_kernel/inbox_item.mli +++ b/reddit_api_kernel/inbox_item.mli @@ -1,6 +1,5 @@ (** An inbox item is either a {!type:Thing.Message.t} or else a representation - of a comment with different fields from a {!Thing.Comment.t}. -*) + of a comment with different fields from a {!Thing.Comment.t}. *) open! Core diff --git a/reddit_api_kernel/json_object.ml b/reddit_api_kernel/json_object.ml index d3611ba6..124be2b8 100644 --- a/reddit_api_kernel/json_object.ml +++ b/reddit_api_kernel/json_object.ml @@ -50,13 +50,13 @@ module Make_kinded (Param : Kinded_param) = struct | None -> Param.of_data_field json | Some (`String kind) -> (match String.equal Param.kind kind with - | true -> Param.of_data_field (Jsonaf.member_exn "data" json) - | false -> - raise_s - [%message - "Unexpected JSON object kind" - ~expected:(Param.kind : string) - (json : Jsonaf.t)]) + | true -> Param.of_data_field (Jsonaf.member_exn "data" json) + | false -> + raise_s + [%message + "Unexpected JSON object kind" + ~expected:(Param.kind : string) + (json : Jsonaf.t)]) | Some kind -> raise_s [%message "JSON object kind is not a string" (kind : Jsonaf.t) (json : Jsonaf.t)] @@ -68,12 +68,12 @@ module Make_kinded (Param : Kinded_param) = struct end module Make_kinded_simple (Param : sig - val kind : string -end) = + val kind : string + end) = Make_kinded (struct - type t = Utils.t [@@deriving sexp_of] + type t = Utils.t [@@deriving sexp_of] - let kind = Param.kind - let of_data_field = [%of_jsonaf: t] - let to_data_field = [%jsonaf_of: t] -end) + let kind = Param.kind + let of_data_field = [%of_jsonaf: t] + let to_data_field = [%jsonaf_of: t] + end) diff --git a/reddit_api_kernel/json_object_intf.ml b/reddit_api_kernel/json_object_intf.ml index b16de111..4204a8f7 100644 --- a/reddit_api_kernel/json_object_intf.ml +++ b/reddit_api_kernel/json_object_intf.ml @@ -54,6 +54,6 @@ module type Json_object = sig module Make_kinded (Param : Kinded_param) : S_with_kind with type t := Param.t module Make_kinded_simple (Param : sig - val kind : string - end) : S_with_kind with type t := Utils.t + val kind : string + end) : S_with_kind with type t := Utils.t end diff --git a/reddit_api_kernel/karma_list.ml b/reddit_api_kernel/karma_list.ml index 22bb2744..b237bff5 100644 --- a/reddit_api_kernel/karma_list.ml +++ b/reddit_api_kernel/karma_list.ml @@ -18,14 +18,14 @@ end type t = Entry.t list [@@deriving sexp] include Json_object.Make_kinded (struct - type nonrec t = t [@@deriving sexp_of] + type nonrec t = t [@@deriving sexp_of] - let of_data_field json = - match Jsonaf.list json with - | Some entries -> List.map entries ~f:[%of_jsonaf: Entry.t] - | None -> raise_s [%message "Invalid [Karma_list] JSON" (json : Jsonaf.t)] - ;; + let of_data_field json = + match Jsonaf.list json with + | Some entries -> List.map entries ~f:[%of_jsonaf: Entry.t] + | None -> raise_s [%message "Invalid [Karma_list] JSON" (json : Jsonaf.t)] + ;; - let to_data_field t = `Array (List.map t ~f:[%jsonaf_of: Entry.t]) - let kind = "KarmaList" -end) + let to_data_field t = `Array (List.map t ~f:[%jsonaf_of: Entry.t]) + let kind = "KarmaList" + end) diff --git a/reddit_api_kernel/mod_action.ml b/reddit_api_kernel/mod_action.ml index 0b22910b..51da23e9 100644 --- a/reddit_api_kernel/mod_action.ml +++ b/reddit_api_kernel/mod_action.ml @@ -16,8 +16,8 @@ end include Json_object.Utils include Json_object.Make_kinded_simple (struct - let kind = "modaction" -end) + let kind = "modaction" + end) let id = required_field "id" (string >> Id.of_json_string) let action = required_field "action" string diff --git a/reddit_api_kernel/modmail.ml b/reddit_api_kernel/modmail.ml index 5d35b336..a96cce71 100644 --- a/reddit_api_kernel/modmail.ml +++ b/reddit_api_kernel/modmail.ml @@ -7,14 +7,14 @@ module Conversation = struct include Id36 include Identifiable.Make (struct - include Id36 + include Id36 - let module_name = "Modmail.Conversation.Id" - end) + let module_name = "Modmail.Conversation.Id" + end) end let id = required_field "conversation" (fun json -> - Jsonaf.member_exn "id" json |> string |> Id.of_string) + Jsonaf.member_exn "id" json |> string |> Id.of_string) ;; end diff --git a/reddit_api_kernel/stylesheet.ml b/reddit_api_kernel/stylesheet.ml index e6767a34..5371d2dc 100644 --- a/reddit_api_kernel/stylesheet.ml +++ b/reddit_api_kernel/stylesheet.ml @@ -18,8 +18,8 @@ end include Json_object.Utils include Json_object.Make_kinded_simple (struct - let kind = "stylesheet" -end) + let kind = "stylesheet" + end) let images = required_field "images" [%of_jsonaf: Image.t list] let subreddit_id = required_field "subreddit_id" (string >> Thing.Subreddit.Id.of_string) diff --git a/reddit_api_kernel/subreddit_name.ml b/reddit_api_kernel/subreddit_name.ml index bb046d0e..009ba191 100644 --- a/reddit_api_kernel/subreddit_name.ml +++ b/reddit_api_kernel/subreddit_name.ml @@ -3,18 +3,20 @@ open! Core type t = string include Identifiable.Make (struct - include String.Caseless + include String.Caseless - let module_name = "Subreddit_name" - let to_string = Fn.id + let module_name = "Subreddit_name" + let to_string = Fn.id - let of_string string = - let try_prefix = List.find_map ~f:(fun prefix -> String.chop_prefix string ~prefix) in - match try_prefix [ "u/"; "/u/" ] with - | Some username -> "u_" ^ username - | None -> try_prefix [ "r/"; "/r/" ] |> Option.value ~default:string - ;; -end) + let of_string string = + let try_prefix = + List.find_map ~f:(fun prefix -> String.chop_prefix string ~prefix) + in + match try_prefix [ "u/"; "/u/" ] with + | Some username -> "u_" ^ username + | None -> try_prefix [ "r/"; "/r/" ] |> Option.value ~default:string + ;; + end) let user_subreddit username = of_string ("u_" ^ Username.to_string username) let all = "all" diff --git a/reddit_api_kernel/subreddit_name.mli b/reddit_api_kernel/subreddit_name.mli index fd47baf1..72d2fc21 100644 --- a/reddit_api_kernel/subreddit_name.mli +++ b/reddit_api_kernel/subreddit_name.mli @@ -2,8 +2,7 @@ - Hashes and comparisons are caseless. - "r/" and "/r/" prefixes are dropped. - - "u/" and "/u/" prefixes cause the string to be converted to the user's subreddit. -*) + - "u/" and "/u/" prefixes cause the string to be converted to the user's subreddit. *) open! Core @@ -13,17 +12,14 @@ type t Exceptions: - {ol - {- Some subreddits are excluded by Reddit administrators.} - {- Some subreddits opt out of inclusion.} - {- Users can filter individual subreddits out of their view of /r/all.}} -*) + + Some subreddits are excluded by Reddit administrators. + + Some subreddits opt out of inclusion. + + Users can filter individual subreddits out of their view of /r/all. *) val all : t (** [combine l] is a subreddit name representing the combination of the subreddits named in [l]. In general, when [combine l] is used as an API - parameter the response contains items from all the subreddits in [l]. -*) + parameter the response contains items from all the subreddits in [l]. *) val combine : t list -> t (** [user_subreddit user] is the name of the special subreddit associated with diff --git a/reddit_api_kernel/subreddit_settings.ml b/reddit_api_kernel/subreddit_settings.ml index 9dd25586..8b9a6143 100644 --- a/reddit_api_kernel/subreddit_settings.ml +++ b/reddit_api_kernel/subreddit_settings.ml @@ -2,5 +2,5 @@ open! Core include Json_object.Utils include Json_object.Make_kinded_simple (struct - let kind = "subreddit_settings" -end) + let kind = "subreddit_settings" + end) diff --git a/reddit_api_kernel/thing.ml b/reddit_api_kernel/thing.ml index 6fc553f9..d174d6e6 100644 --- a/reddit_api_kernel/thing.ml +++ b/reddit_api_kernel/thing.ml @@ -3,14 +3,14 @@ open Jsonaf.Export include Thing_intf module Make (Param : sig - val kind : Thing_kind.t -end) = + val kind : Thing_kind.t + end) = struct include Json_object.Utils include Json_object.Make_kinded_simple (struct - let kind = Thing_kind.to_string Param.kind - end) + let kind = Thing_kind.to_string Param.kind + end) type t = Jsonaf.t Map.M(String).t [@@deriving sexp] @@ -21,15 +21,15 @@ struct include Id36 include Identifiable.Make (struct - include Id36 + include Id36 - let module_name = sprintf "%s.Id" module_name + let module_name = sprintf "%s.Id" module_name - let of_string s = - let prefix = sprintf !"%{Thing_kind}_" Param.kind in - Id36.of_string (String.chop_prefix_if_exists s ~prefix) - ;; - end) + let of_string s = + let prefix = sprintf !"%{Thing_kind}_" Param.kind in + Id36.of_string (String.chop_prefix_if_exists s ~prefix) + ;; + end) end include T @@ -61,15 +61,15 @@ struct required_field "permalink" (string - >> Uri.of_string - >> Uri.with_uri ~scheme:(Some "https") ~host:(Some "reddit.com")) + >> Uri.of_string + >> Uri.with_uri ~scheme:(Some "https") ~host:(Some "reddit.com")) ;; end module Link = struct include Make (struct - let kind = Thing_kind.Link - end) + let kind = Thing_kind.Link + end) module Id = struct include (Id : module type of Id) @@ -103,8 +103,8 @@ end module Comment' = struct include Make (struct - let kind = Thing_kind.Comment - end) + let kind = Thing_kind.Comment + end) module Score = struct type t = @@ -128,34 +128,34 @@ module Comment' = struct end module Message = Make (struct - let kind = Thing_kind.Message -end) + let kind = Thing_kind.Message + end) module Subreddit = struct include Make (struct - let kind = Thing_kind.Subreddit - end) + let kind = Thing_kind.Subreddit + end) let name = required_field "display_name" subreddit_name end module User = struct include Make (struct - let kind = Thing_kind.User - end) + let kind = Thing_kind.User + end) let name = required_field "name" username let subreddit = required_field "subreddit" [%of_jsonaf: Subreddit.t] end module Award = Make (struct - let kind = Thing_kind.Award -end) + let kind = Thing_kind.Award + end) module More_comments = struct include Make (struct - let kind = Thing_kind.More_comments - end) + let kind = Thing_kind.More_comments + end) module Details = struct module By_children = struct @@ -179,8 +179,8 @@ module More_comments = struct end module Modmail_conversation = Make (struct - let kind = Thing_kind.Modmail_conversation -end) + let kind = Thing_kind.Modmail_conversation + end) module Fullname = struct module M = struct @@ -253,7 +253,7 @@ module Comment = struct [%of_jsonaf: Poly.t Listing.t] json |> Listing.children |> List.map ~f:(function - | (`Comment _ | `More_comments _) as v -> v - | _ -> assert false) + | (`Comment _ | `More_comments _) as v -> v + | _ -> assert false) ;; end diff --git a/reddit_api_kernel/thing_kind.ml b/reddit_api_kernel/thing_kind.ml index 8f090ed7..05e169af 100644 --- a/reddit_api_kernel/thing_kind.ml +++ b/reddit_api_kernel/thing_kind.ml @@ -71,16 +71,16 @@ let of_polymorphic_tag_with_uniform_data = function ;; let to_polymorphic_tag - t - ~data - ~award - ~comment - ~link - ~message - ~modmail_conversation - ~more_comments - ~subreddit - ~user + t + ~data + ~award + ~comment + ~link + ~message + ~modmail_conversation + ~more_comments + ~subreddit + ~user = match t with | Comment -> `Comment (comment data) diff --git a/reddit_api_kernel/uri_with_string_sexp.mli b/reddit_api_kernel/uri_with_string_sexp.mli index 3614a295..ef8191b7 100644 --- a/reddit_api_kernel/uri_with_string_sexp.mli +++ b/reddit_api_kernel/uri_with_string_sexp.mli @@ -1,8 +1,7 @@ (** [Uri_with_string_sexp] is {!module:Uri_sexp} with a different sexp serialization: - [sexp_of_t t = Atom (Uri.to_string t)] -*) + [sexp_of_t t = Atom (Uri.to_string t)] *) open! Core include module type of struct diff --git a/reddit_api_kernel/username.ml b/reddit_api_kernel/username.ml index f5a8e0ce..911dc6db 100644 --- a/reddit_api_kernel/username.ml +++ b/reddit_api_kernel/username.ml @@ -3,16 +3,16 @@ open! Core type t = string include Identifiable.Make (struct - include String.Caseless + include String.Caseless - let module_name = "Username" - let to_string = Fn.id + let module_name = "Username" + let to_string = Fn.id - let of_string string = - List.find_map [ "u/"; "/u/" ] ~f:(fun prefix -> String.chop_prefix string ~prefix) - |> Option.value ~default:string - ;; -end) + let of_string string = + List.find_map [ "u/"; "/u/" ] ~f:(fun prefix -> String.chop_prefix string ~prefix) + |> Option.value ~default:string + ;; + end) let of_string_or_deleted string = match string with diff --git a/reddit_api_kernel/username.mli b/reddit_api_kernel/username.mli index b2eb5840..78c122c4 100644 --- a/reddit_api_kernel/username.mli +++ b/reddit_api_kernel/username.mli @@ -1,8 +1,7 @@ (** [Username] is a string identifier module that does some normalization: - - Hashes and comparisons are caseless. - - "u/" and "/u/" prefixes are dropped. -*) + - Hashes and comparisons are caseless. + - "u/" and "/u/" prefixes are dropped. *) open! Core include Identifiable.S diff --git a/reddit_api_kernel/wiki_page.ml b/reddit_api_kernel/wiki_page.ml index 6567441b..138954f3 100644 --- a/reddit_api_kernel/wiki_page.ml +++ b/reddit_api_kernel/wiki_page.ml @@ -32,8 +32,8 @@ module Permissions = struct include Json_object.Utils include Json_object.Make_kinded_simple (struct - let kind = "wikipagesettings" - end) + let kind = "wikipagesettings" + end) module Level = struct type t = @@ -66,8 +66,8 @@ end include Json_object.Utils include Json_object.Make_kinded_simple (struct - let kind = "wikipage" -end) + let kind = "wikipage" + end) let may_revise = required_field "may_revise" bool let revision_id = required_field "revision_id" (string >> Uuid.of_string) diff --git a/test/import.ml b/test/import.ml index 40511d21..a5c03c6c 100644 --- a/test/import.ml +++ b/test/import.ml @@ -37,6 +37,6 @@ let get_link_exn connection id = in return (match link with - | `Link link -> link - | _ -> raise_s [%message "Unexpected response item"]) + | `Link link -> link + | _ -> raise_s [%message "Unexpected response item"]) ;; diff --git a/test/test_account.ml b/test/test_account.ml index 2474c840..94ba811d 100644 --- a/test/test_account.ml +++ b/test/test_account.ml @@ -4,44 +4,44 @@ open! Import let%expect_test "friends" = with_cassette "friends" ~f:(fun connection -> - let%bind body = Connection.call_exn connection (Endpoint.friends ()) in - print_s [%sexp (body : User_list.t)]; - [%expect - {| + let%bind body = Connection.call_exn connection (Endpoint.friends ()) in + print_s [%sexp (body : User_list.t)]; + [%expect + {| (((date (Number 1598656681.0)) (id (String t2_1w72)) (name (String spez)) (rel_id (String r9_1voxr1)))) |}]; - return ()) + return ()) ;; let%expect_test "blocked" = with_cassette "blocked" ~f:(fun connection -> - let%bind body = Connection.call_exn connection (Endpoint.blocked ()) in - print_s [%sexp (body : User_list.t)]; - [%expect - {| + let%bind body = Connection.call_exn connection (Endpoint.blocked ()) in + print_s [%sexp (body : User_list.t)]; + [%expect + {| (((date (Number 1598788910.0)) (id (String t2_nn0q)) (name (String ketralnis)) (rel_id (String r9_1vt16j)))) |}]; - return ()) + return ()) ;; let%expect_test "messaging" = with_cassette "messaging" ~f:(fun connection -> - let%bind body = Connection.call_exn connection (Endpoint.messaging ()) in - print_s [%sexp (body : User_list.t)]; - [%expect - {| + let%bind body = Connection.call_exn connection (Endpoint.messaging ()) in + print_s [%sexp (body : User_list.t)]; + [%expect + {| (((date (Number 1598789198.0)) (id (String t2_1w72)) (name (String spez)) (rel_id (String r9_1vt1em)))) |}]; - return ()) + return ()) ;; let%expect_test "trusted" = with_cassette "trusted" ~f:(fun connection -> - let%bind body = Connection.call_exn connection (Endpoint.trusted ()) in - print_s [%sexp (body : User_list.t)]; - [%expect - {| + let%bind body = Connection.call_exn connection (Endpoint.trusted ()) in + print_s [%sexp (body : User_list.t)]; + [%expect + {| (((date (Number 1598789198.0)) (id (String t2_1w72)) (name (String spez)) (rel_id (String r9_1vt1em)))) |}]; - return ()) + return ()) ;; diff --git a/test/test_api.ml b/test/test_api.ml index f1935e98..b914bded 100644 --- a/test/test_api.ml +++ b/test/test_api.ml @@ -4,9 +4,9 @@ open! Import let%expect_test "me" = with_cassette "me" ~f:(fun connection -> - let%bind me = Connection.call_exn connection Endpoint.me in - let id = Thing.User.id me in - print_s [%sexp (id : Thing.User.Id.t)]; - [%expect {| 16r83m |}]; - return ()) + let%bind me = Connection.call_exn connection Endpoint.me in + let id = Thing.User.id me in + print_s [%sexp (id : Thing.User.Id.t)]; + [%expect {| 16r83m |}]; + return ()) ;; diff --git a/test/test_comment_fields.ml b/test/test_comment_fields.ml index 26b14bf9..6abaf324 100644 --- a/test/test_comment_fields.ml +++ b/test/test_comment_fields.ml @@ -4,48 +4,47 @@ open! Import let%expect_test "comment_fields" = with_cassette "comment_fields" ~f:(fun connection -> - let link = Thing.Link.Id.of_string "hle3h4" in - let%bind ({ comment_forest; _ } : Comment_response.t) = - Connection.call_exn connection (Endpoint.comments () ~link) - in - let first_comment = - match List.hd_exn comment_forest with - | `Comment comment -> comment - | _ -> assert false - in - let keys_from_comment_page = Thing.Comment.field_map first_comment |> Map.key_set in - let comment_id = Thing.Comment.id first_comment in - let%bind keys_from_info_page = - match%bind - Connection.call_exn connection (Endpoint.info (Id [ `Comment comment_id ])) - >>| List.hd_exn - with - | `Comment comment -> return (Thing.Comment.field_map comment |> Map.key_set) - | _ -> assert false - in - let diff = - Set.symmetric_diff keys_from_comment_page keys_from_info_page |> Sequence.to_list - in - print_s [%sexp (diff : (string, string) Either.t list)]; - [%expect {| ((First depth)) |}]; - print_s [%sexp (Thing.Comment.depth first_comment : int option)]; - [%expect {| (0) |}]; - print_s - [%sexp - (Thing.Comment.body first_comment |> String.split ~on:'\n' |> List.hd_exn - : string)]; - [%expect - {| "- Textual/HTML pretty printing: https://github.com/c-cube/printbox/" |}]; - print_s [%sexp (Thing.Comment.score first_comment : Thing.Comment.Score.t)]; - [%expect {| (Score 11) |}]; - print_s [%sexp (Thing.Comment.link first_comment : Thing.Link.Id.t)]; - [%expect {| hle3h4 |}]; - print_s [%sexp (Thing.Comment.permalink first_comment |> Uri.to_string : string)]; - [%expect - {| https://reddit.com/r/ocaml/comments/hle3h4/ocaml_is_superbly_suited_to_defining_and/fwzc1p0/ |}]; - print_s [%sexp (keys_from_info_page : Set.M(String).t)]; - [%expect - {| + let link = Thing.Link.Id.of_string "hle3h4" in + let%bind ({ comment_forest; _ } : Comment_response.t) = + Connection.call_exn connection (Endpoint.comments () ~link) + in + let first_comment = + match List.hd_exn comment_forest with + | `Comment comment -> comment + | _ -> assert false + in + let keys_from_comment_page = Thing.Comment.field_map first_comment |> Map.key_set in + let comment_id = Thing.Comment.id first_comment in + let%bind keys_from_info_page = + match%bind + Connection.call_exn connection (Endpoint.info (Id [ `Comment comment_id ])) + >>| List.hd_exn + with + | `Comment comment -> return (Thing.Comment.field_map comment |> Map.key_set) + | _ -> assert false + in + let diff = + Set.symmetric_diff keys_from_comment_page keys_from_info_page |> Sequence.to_list + in + print_s [%sexp (diff : (string, string) Either.t list)]; + [%expect {| ((First depth)) |}]; + print_s [%sexp (Thing.Comment.depth first_comment : int option)]; + [%expect {| (0) |}]; + print_s + [%sexp + (Thing.Comment.body first_comment |> String.split ~on:'\n' |> List.hd_exn + : string)]; + [%expect {| "- Textual/HTML pretty printing: https://github.com/c-cube/printbox/" |}]; + print_s [%sexp (Thing.Comment.score first_comment : Thing.Comment.Score.t)]; + [%expect {| (Score 11) |}]; + print_s [%sexp (Thing.Comment.link first_comment : Thing.Link.Id.t)]; + [%expect {| hle3h4 |}]; + print_s [%sexp (Thing.Comment.permalink first_comment |> Uri.to_string : string)]; + [%expect + {| https://reddit.com/r/ocaml/comments/hle3h4/ocaml_is_superbly_suited_to_defining_and/fwzc1p0/ |}]; + print_s [%sexp (keys_from_info_page : Set.M(String).t)]; + [%expect + {| (all_awardings approved_at_utc approved_by archived associated_award author author_flair_background_color author_flair_css_class author_flair_richtext author_flair_template_id author_flair_text author_flair_text_color @@ -58,5 +57,5 @@ let%expect_test "comment_fields" = replies report_reasons saved score score_hidden send_replies stickied subreddit subreddit_id subreddit_name_prefixed subreddit_type top_awarded_type total_awards_received treatment_tags ups user_reports) |}]; - return ()) + return ()) ;; diff --git a/test/test_comment_page.ml b/test/test_comment_page.ml index 6385562e..2a12dc33 100644 --- a/test/test_comment_page.ml +++ b/test/test_comment_page.ml @@ -6,7 +6,7 @@ let%expect_test _ = let link = Thing.Link.Id.of_string "g7vyxy" in let%bind ({ comment_forest; _ } : Comment_response.t) = with_cassette "comments" ~f:(fun connection -> - Connection.call_exn connection (Endpoint.comments () ~link)) + Connection.call_exn connection (Endpoint.comments () ~link)) in let ids = List.map comment_forest ~f:Thing.Poly.fullname in print_s [%message "" (ids : Thing.Fullname.t list)]; @@ -31,20 +31,20 @@ let%expect_test _ = match List.last_exn comment_forest with | `More_comments more_comments -> (match Thing.More_comments.details more_comments with - | By_children x -> x - | By_parent _ -> assert false) + | By_children x -> x + | By_parent _ -> assert false) | _ -> assert false in let%bind children = with_cassette "more_comments" ~f:(fun connection -> - Connection.call_exn - connection - (Endpoint.more_children ~link ~more_comments ~sort:New ())) + Connection.call_exn + connection + (Endpoint.more_children ~link ~more_comments ~sort:New ())) in let comments, more_comments = List.partition_map children ~f:(function - | `Comment v -> First v - | `More_comments v -> Second v) + | `Comment v -> First v + | `More_comments v -> Second v) in let first_comment = List.hd comments in print_s diff --git a/test/test_delete.ml b/test/test_delete.ml index 2905bf14..b3f7669d 100644 --- a/test/test_delete.ml +++ b/test/test_delete.ml @@ -4,8 +4,8 @@ open! Import let%expect_test "delete" = with_cassette "delete" ~f:(fun connection -> - let id = `Comment (Thing.Comment.Id.of_string "g3f4icy") in - let%bind () = Connection.call_exn connection (Endpoint.delete ~id) in - [%expect]; - return ()) + let id = `Comment (Thing.Comment.Id.of_string "g3f4icy") in + let%bind () = Connection.call_exn connection (Endpoint.delete ~id) in + [%expect]; + return ()) ;; diff --git a/test/test_error_handling.ml b/test/test_error_handling.ml index 8375713a..8d0f5dd5 100644 --- a/test/test_error_handling.ml +++ b/test/test_error_handling.ml @@ -14,75 +14,74 @@ let%expect_test "Json error" = print_s [%sexp (String.length ban_message : int)]; [%expect {| 1155 |}]; with_cassette "ban__long_message" ~f:(fun connection -> - let%bind () = - match%bind - Connection.call - connection - (Endpoint.add_relationship - ~relationship:Banned - ~username:(Username.of_string "spez") - ~duration:Permanent - ~subreddit:(Subreddit_name.of_string "thirdrealm") - ~ban_message - ()) - with - | Ok () -> raise_s [%message "Expected API error"] - | Error error -> - print_s [%message "" (error : Endpoint.Error.t Connection.Error.t)]; - return () - in - [%expect - {| + let%bind () = + match%bind + Connection.call + connection + (Endpoint.add_relationship + ~relationship:Banned + ~username:(Username.of_string "spez") + ~duration:Permanent + ~subreddit:(Subreddit_name.of_string "thirdrealm") + ~ban_message + ()) + with + | Ok () -> raise_s [%message "Expected API error"] + | Error error -> + print_s [%message "" (error : Endpoint.Error.t Connection.Error.t)]; + return () + in + [%expect + {| (error (Endpoint_error (Json_response_errors (((error TOO_LONG) (error_type ()) (details "this is too long (max: 1000)") (fields (ban_message))))))) |}]; - return ()) + return ()) ;; let%expect_test "HTTP error" = with_cassette "ban__wrong_subreddit" ~f:(fun connection -> - let%bind () = - match%bind - Connection.call - connection - (Endpoint.add_relationship - ~relationship:Banned - ~username:(Username.of_string "spez") - ~duration:Permanent - ~subreddit:(Subreddit_name.of_string "thirdrealm") - ()) - with - | Error (Endpoint_error (Http_error _)) -> - print_s [%message "HTTP error"]; - return () - | Ok () | Error _ -> raise_s [%message "Expected HTTP error"] - in - [%expect {| "HTTP error" |}]; - return ()) + let%bind () = + match%bind + Connection.call + connection + (Endpoint.add_relationship + ~relationship:Banned + ~username:(Username.of_string "spez") + ~duration:Permanent + ~subreddit:(Subreddit_name.of_string "thirdrealm") + ()) + with + | Error (Endpoint_error (Http_error _)) -> + print_s [%message "HTTP error"]; + return () + | Ok () | Error _ -> raise_s [%message "Expected HTTP error"] + in + [%expect {| "HTTP error" |}]; + return ()) ;; let%expect_test "Bad request" = with_cassette "user_trophies__nonexistent_user" ~f:(fun connection -> - let%bind () = - match%bind - Connection.call - connection - (Endpoint.user_trophies - ~username:(Username.of_string "thisusershouldnotexist")) - with - | Ok _ -> raise_s [%message "Expected error"] - | Error error -> - print_s [%message "" (error : Endpoint.Error.t Connection.Error.t)]; - return () - in - [%expect - {| + let%bind () = + match%bind + Connection.call + connection + (Endpoint.user_trophies ~username:(Username.of_string "thisusershouldnotexist")) + with + | Ok _ -> raise_s [%message "Expected error"] + | Error error -> + print_s [%message "" (error : Endpoint.Error.t Connection.Error.t)]; + return () + in + [%expect + {| (error (Endpoint_error (Json_response_errors (((error USER_DOESNT_EXIST) (error_type ()) (details "that user doesn't exist") (fields (id))))))) |}]; - return ()) + return ()) ;; diff --git a/test/test_hot.ml b/test/test_hot.ml index e2536536..53344d03 100644 --- a/test/test_hot.ml +++ b/test/test_hot.ml @@ -4,48 +4,48 @@ open! Import let%expect_test "hot" = with_cassette "hot" ~f:(fun connection -> - let%bind link = - Connection.call_exn - connection - (Endpoint.hot ~limit:1 ~subreddit:(Subreddit_name.of_string "ThirdRealm") ()) - >>| Listing.children - >>| List.hd_exn - in - print_s - [%sexp - { id : Thing.Link.Id.t = Thing.Link.id link - ; title : string = Thing.Link.title link - ; author : Username.t option = Thing.Link.author link - ; creation_time : Time_ns.t = Thing.Link.creation_time link - ; is_stickied : bool = Thing.Link.is_stickied link - }]; - [%expect - {| + let%bind link = + Connection.call_exn + connection + (Endpoint.hot ~limit:1 ~subreddit:(Subreddit_name.of_string "ThirdRealm") ()) + >>| Listing.children + >>| List.hd_exn + in + print_s + [%sexp + { id : Thing.Link.Id.t = Thing.Link.id link + ; title : string = Thing.Link.title link + ; author : Username.t option = Thing.Link.author link + ; creation_time : Time_ns.t = Thing.Link.creation_time link + ; is_stickied : bool = Thing.Link.is_stickied link + }]; + [%expect + {| ((id fa5dg9) (title "/r/thirdrealm Open Discussion Thread | February 26, 2020") (author (BernardJOrtcutt)) (creation_time (2020-02-27 02:55:31.000000000Z)) (is_stickied true)) |}]; - return ()) + return ()) ;; let%expect_test "hot__multiple_subreddits" = with_cassette "hot__multiple_subreddits" ~f:(fun connection -> - let subreddit = - List.map [ "aww"; "programming" ] ~f:Subreddit_name.of_string - |> Subreddit_name.combine - in - let%bind links = - Connection.call_exn connection (Endpoint.hot ~limit:10 ~subreddit ()) - >>| Listing.children - in - List.iter links ~f:(fun link -> - print_s - [%sexp - { subreddit : Subreddit_name.t = Thing.Link.subreddit link - ; id : Thing.Link.Id.t = Thing.Link.id link - }]); - [%expect - {| + let subreddit = + List.map [ "aww"; "programming" ] ~f:Subreddit_name.of_string + |> Subreddit_name.combine + in + let%bind links = + Connection.call_exn connection (Endpoint.hot ~limit:10 ~subreddit ()) + >>| Listing.children + in + List.iter links ~f:(fun link -> + print_s + [%sexp + { subreddit : Subreddit_name.t = Thing.Link.subreddit link + ; id : Thing.Link.Id.t = Thing.Link.id link + }]); + [%expect + {| ((subreddit aww) (id j0q3oj)) ((subreddit programming) (id j0oriz)) ((subreddit aww) (id j0omwl)) @@ -56,5 +56,5 @@ let%expect_test "hot__multiple_subreddits" = ((subreddit aww) (id j0og2d)) ((subreddit aww) (id j0li9w)) ((subreddit aww) (id j0njcb)) |}]; - return ()) + return ()) ;; diff --git a/test/test_id36.ml b/test/test_id36.ml index a5907826..6de4b797 100644 --- a/test/test_id36.ml +++ b/test/test_id36.ml @@ -20,15 +20,15 @@ let%expect_test "roundtrip: string -> int -> string" = | "0" -> string | _ -> (match string.[0] with - | '0' -> drop_unnecessary_zeroes_from_string (String.drop_prefix string 1) - | _ -> string) + | '0' -> drop_unnecessary_zeroes_from_string (String.drop_prefix string 1) + | _ -> string) in Quickcheck.test (Int.gen_incl 1 11 - |> Quickcheck.Generator.bind ~f:(fun length -> - String.gen_with_length - length - (Quickcheck.Generator.union [ Char.gen_lowercase; Char.gen_digit ]))) + |> Quickcheck.Generator.bind ~f:(fun length -> + String.gen_with_length + length + (Quickcheck.Generator.union [ Char.gen_lowercase; Char.gen_digit ]))) ~f:(fun string -> assert ( String.equal @@ -54,7 +54,7 @@ let%expect_test "roundtrip: string -> int -> string" = let%expect_test "prefixes" = List.iter [ "0"; "a1"; "aklzj"; "t1_0"; "t1_a1"; "t1_aklzj" ] ~f:(fun test_case -> - Thing.Comment.Id.of_string test_case |> [%sexp_of: Thing.Comment.Id.t] |> print_s); + Thing.Comment.Id.of_string test_case |> [%sexp_of: Thing.Comment.Id.t] |> print_s); [%expect {| 0 a1 diff --git a/test/test_info.ml b/test/test_info.ml index 0563cdf3..f300e06d 100644 --- a/test/test_info.ml +++ b/test/test_info.ml @@ -4,46 +4,45 @@ open! Import let%expect_test "info" = with_cassette "info" ~f:(fun connection -> - let%bind link = - Connection.call_exn - connection - (Endpoint.info (Id [ `Link (Thing.Link.Id.of_string "hmjd8r") ])) - >>| List.hd_exn - in - let link = - match link with - | `Link link -> link - | _ -> raise_s [%message "Unexpected response item"] - in - print_s - [%sexp - { id : Thing.Link.Id.t = Thing.Link.id link - ; title : string = Thing.Link.title link - ; author : Username.t option = Thing.Link.author link - ; creation_time : Time_ns.t = Thing.Link.creation_time link - ; is_stickied : bool = Thing.Link.is_stickied link - }]; - [%expect - {| + let%bind link = + Connection.call_exn + connection + (Endpoint.info (Id [ `Link (Thing.Link.Id.of_string "hmjd8r") ])) + >>| List.hd_exn + in + let link = + match link with + | `Link link -> link + | _ -> raise_s [%message "Unexpected response item"] + in + print_s + [%sexp + { id : Thing.Link.Id.t = Thing.Link.id link + ; title : string = Thing.Link.title link + ; author : Username.t option = Thing.Link.author link + ; creation_time : Time_ns.t = Thing.Link.creation_time link + ; is_stickied : bool = Thing.Link.is_stickied link + }]; + [%expect + {| ((id hmjd8r) (title "This is a title") (author (BJO_test_user)) (creation_time (2020-07-06 23:42:12.000000000Z)) (is_stickied false)) |}]; - return ()) + return ()) ;; let%expect_test "info__by_subreddit_name" = with_cassette "info__by_subreddit_name" ~f:(fun connection -> - let%bind subreddits = - Connection.call_exn - connection - (Endpoint.info - (Subreddit_name - (List.map [ "ocaml"; "redditdev"; "python" ] ~f:Subreddit_name.of_string))) - >>| List.map ~f:(function - | `Subreddit subreddit -> subreddit - | _ -> raise_s [%message "Unexpected response item"]) - in - print_s - [%sexp (List.map subreddits ~f:Thing.Subreddit.name : Subreddit_name.t list)]; - [%expect {| (redditdev ocaml Python) |}]; - return ()) + let%bind subreddits = + Connection.call_exn + connection + (Endpoint.info + (Subreddit_name + (List.map [ "ocaml"; "redditdev"; "python" ] ~f:Subreddit_name.of_string))) + >>| List.map ~f:(function + | `Subreddit subreddit -> subreddit + | _ -> raise_s [%message "Unexpected response item"]) + in + print_s [%sexp (List.map subreddits ~f:Thing.Subreddit.name : Subreddit_name.t list)]; + [%expect {| (redditdev ocaml Python) |}]; + return ()) ;; diff --git a/test/test_link_fields.ml b/test/test_link_fields.ml index f7b27b6c..32cbe51a 100644 --- a/test/test_link_fields.ml +++ b/test/test_link_fields.ml @@ -4,31 +4,31 @@ open! Import let%expect_test "link_fields__url_contents" = with_cassette "link_fields__url_contents" ~f:(fun connection -> - let link = Thing.Link.Id.of_string "lfx8ac" in - let%bind ({ link; _ } : Comment_response.t) = - Connection.call_exn connection (Endpoint.comments () ~link) - in - let contents = Thing.Link.contents link in - print_s [%sexp (contents : Thing.Link.Contents.t)]; - [%expect {| (Url https://i.redd.it/ap95zxoqleg61.jpg) |}]; - return ()) + let link = Thing.Link.Id.of_string "lfx8ac" in + let%bind ({ link; _ } : Comment_response.t) = + Connection.call_exn connection (Endpoint.comments () ~link) + in + let contents = Thing.Link.contents link in + print_s [%sexp (contents : Thing.Link.Contents.t)]; + [%expect {| (Url https://i.redd.it/ap95zxoqleg61.jpg) |}]; + return ()) ;; let%expect_test "link_fields__self_contents" = with_cassette "link_fields__self_contents" ~f:(fun connection -> - let link = Thing.Link.Id.of_string "kvzaot" in - let%bind ({ link; _ } : Comment_response.t) = - Connection.call_exn connection (Endpoint.comments () ~link) - in - let contents : Thing.Link.Contents.t = - match Thing.Link.contents link with - | Self_text text -> Self_text (String.prefix text 100) - | v -> v - in - print_s [%sexp (contents : Thing.Link.Contents.t)]; - [%expect - {| + let link = Thing.Link.Id.of_string "kvzaot" in + let%bind ({ link; _ } : Comment_response.t) = + Connection.call_exn connection (Endpoint.comments () ~link) + in + let contents : Thing.Link.Contents.t = + match Thing.Link.contents link with + | Self_text text -> Self_text (String.prefix text 100) + | v -> v + in + print_s [%sexp (contents : Thing.Link.Contents.t)]; + [%expect + {| (Self_text "As part of modernizing our OAuth2 infrastructure, we\226\128\153re implementing some potentially breaking cha") |}]; - return ()) + return ()) ;; diff --git a/test/test_links_and_comments.ml b/test/test_links_and_comments.ml index 45a48c5e..47936721 100644 --- a/test/test_links_and_comments.ml +++ b/test/test_links_and_comments.ml @@ -4,88 +4,88 @@ open! Import let%expect_test "edit" = with_cassette "edit" ~f:(fun connection -> - let id = `Comment (Thing.Comment.Id.of_string "g3krlj5") in - let%bind comment = - Connection.call_exn connection (Endpoint.edit () ~id ~text:"edited text") - in - print_s [%sexp (Thing.Poly.fullname comment : Thing.Fullname.t)]; - [%expect {| (Comment g3krlj5) |}]; - return ()) + let id = `Comment (Thing.Comment.Id.of_string "g3krlj5") in + let%bind comment = + Connection.call_exn connection (Endpoint.edit () ~id ~text:"edited text") + in + print_s [%sexp (Thing.Poly.fullname comment : Thing.Fullname.t)]; + [%expect {| (Comment g3krlj5) |}]; + return ()) ;; let%expect_test "save" = with_cassette "save" ~f:(fun connection -> - let id = `Comment (Thing.Comment.Id.of_string "g3krlj5") in - let%bind () = Connection.call_exn connection (Endpoint.save () ~id) in - [%expect {| |}]; - return ()) + let id = `Comment (Thing.Comment.Id.of_string "g3krlj5") in + let%bind () = Connection.call_exn connection (Endpoint.save () ~id) in + [%expect {| |}]; + return ()) ;; let%expect_test "unsave" = with_cassette "unsave" ~f:(fun connection -> - let id = `Comment (Thing.Comment.Id.of_string "g3krlj5") in - let%bind () = Connection.call_exn connection (Endpoint.unsave ~id) in - (* Unsave is idempotent *) - let%bind () = Connection.call_exn connection (Endpoint.unsave ~id) in - [%expect {| |}]; - return ()) + let id = `Comment (Thing.Comment.Id.of_string "g3krlj5") in + let%bind () = Connection.call_exn connection (Endpoint.unsave ~id) in + (* Unsave is idempotent *) + let%bind () = Connection.call_exn connection (Endpoint.unsave ~id) in + [%expect {| |}]; + return ()) ;; let%expect_test "send_replies" = with_cassette "send_replies" ~f:(fun connection -> - let id = `Comment (Thing.Comment.Id.of_string "g3krlj5") in - let%bind () = - Connection.call_exn connection (Endpoint.send_replies ~id ~enabled:true) - in - [%expect]; - let%bind () = - Connection.call_exn connection (Endpoint.send_replies ~id ~enabled:false) - in - [%expect]; - return ()) + let id = `Comment (Thing.Comment.Id.of_string "g3krlj5") in + let%bind () = + Connection.call_exn connection (Endpoint.send_replies ~id ~enabled:true) + in + [%expect]; + let%bind () = + Connection.call_exn connection (Endpoint.send_replies ~id ~enabled:false) + in + [%expect]; + return ()) ;; let%expect_test "set_contest_mode" = with_cassette "set_contest_mode" ~f:(fun connection -> - let link = Thing.Link.Id.of_string "hofd3k" in - let%bind () = - Connection.call_exn connection (Endpoint.set_contest_mode ~link ~enabled:true) - in - let%bind () = - Connection.call_exn connection (Endpoint.set_contest_mode ~link ~enabled:false) - in - [%expect]; - return ()) + let link = Thing.Link.Id.of_string "hofd3k" in + let%bind () = + Connection.call_exn connection (Endpoint.set_contest_mode ~link ~enabled:true) + in + let%bind () = + Connection.call_exn connection (Endpoint.set_contest_mode ~link ~enabled:false) + in + [%expect]; + return ()) ;; let%expect_test "spoiler" = with_cassette "spoiler" ~f:(fun connection -> - let link = Thing.Link.Id.of_string "hofd3k" in - let%bind () = Connection.call_exn connection (Endpoint.spoiler ~link) in - [%expect]; - return ()) + let link = Thing.Link.Id.of_string "hofd3k" in + let%bind () = Connection.call_exn connection (Endpoint.spoiler ~link) in + [%expect]; + return ()) ;; let%expect_test "unspoiler" = with_cassette "unspoiler" ~f:(fun connection -> - let link = Thing.Link.Id.of_string "hofd3k" in - let%bind () = Connection.call_exn connection (Endpoint.unspoiler ~link) in - [%expect]; - return ()) + let link = Thing.Link.Id.of_string "hofd3k" in + let%bind () = Connection.call_exn connection (Endpoint.unspoiler ~link) in + [%expect]; + return ()) ;; let%expect_test "vote" = with_cassette "vote" ~f:(fun connection -> - let target = `Comment (Thing.Comment.Id.of_string "g3krlj5") in - let%bind () = - Connection.call_exn connection (Endpoint.vote () ~target ~direction:Down) - in - let%bind () = - Connection.call_exn connection (Endpoint.vote () ~target ~direction:Neutral) - in - let%bind () = - Connection.call_exn connection (Endpoint.vote () ~target ~direction:Up) - in - [%expect]; - return ()) + let target = `Comment (Thing.Comment.Id.of_string "g3krlj5") in + let%bind () = + Connection.call_exn connection (Endpoint.vote () ~target ~direction:Down) + in + let%bind () = + Connection.call_exn connection (Endpoint.vote () ~target ~direction:Neutral) + in + let%bind () = + Connection.call_exn connection (Endpoint.vote () ~target ~direction:Up) + in + [%expect]; + return ()) ;; diff --git a/test/test_listings.ml b/test/test_listings.ml index 77c97303..0882a6e0 100644 --- a/test/test_listings.ml +++ b/test/test_listings.ml @@ -4,50 +4,50 @@ open! Import let%expect_test "best" = with_cassette "best" ~f:(fun connection -> - let%bind listing = Connection.call_exn connection (Endpoint.best ()) in - let child_ids = Listing.children listing |> List.map ~f:Thing.Link.id in - print_s [%sexp (child_ids : Thing.Link.Id.t list)]; - [%expect - {| + let%bind listing = Connection.call_exn connection (Endpoint.best ()) in + let child_ids = Listing.children listing |> List.map ~f:Thing.Link.id in + print_s [%sexp (child_ids : Thing.Link.Id.t list)]; + [%expect + {| (ikj8uc ikuyq6 iksp32 ikpbi4 ikveil ikdwtu ikg3cx ikksvt ikrful iki288 ikpyqv ikl4g6 iknntd ikrrxo ikl05w ikn7gl iksu0i ikqhgj ikp413 ikpayi ikkxfh ikkwlk ikoad9 ikudf8 ikmxz9) |}]; - return ()) + return ()) ;; let%expect_test "links_by_id" = with_cassette "links_by_id" ~f:(fun connection -> - let links = List.map ~f:Thing.Link.Id.of_string [ "icqrut"; "ikksvt" ] in - let%bind listing = Connection.call_exn connection (Endpoint.links_by_id ~links) in - let ids = Listing.children listing |> List.map ~f:Thing.Link.id in - print_s [%sexp (ids : Thing.Link.Id.t list)]; - [%expect {| (icqrut ikksvt) |}]; - return ()) + let links = List.map ~f:Thing.Link.Id.of_string [ "icqrut"; "ikksvt" ] in + let%bind listing = Connection.call_exn connection (Endpoint.links_by_id ~links) in + let ids = Listing.children listing |> List.map ~f:Thing.Link.id in + print_s [%sexp (ids : Thing.Link.Id.t list)]; + [%expect {| (icqrut ikksvt) |}]; + return ()) ;; let%expect_test "random" = with_cassette "random" ~f:(fun connection -> - let%bind link_id = - Connection.call_exn - connection - (Endpoint.random ~subreddit:(Subreddit_name.of_string "ocaml") ()) - in - print_s [%sexp (link_id : Thing.Link.Id.t)]; - [%expect {| feyhbv |}]; - return ()) + let%bind link_id = + Connection.call_exn + connection + (Endpoint.random ~subreddit:(Subreddit_name.of_string "ocaml") ()) + in + print_s [%sexp (link_id : Thing.Link.Id.t)]; + [%expect {| feyhbv |}]; + return ()) ;; let%expect_test "user_overview" = with_cassette "user_overview" ~f:(fun connection -> - let%bind listing = - Connection.call_exn - connection - (Endpoint.user_overview () ~username:(Username.of_string "spez")) - in - let child_fullnames = Listing.children listing |> List.map ~f:Thing.Poly.fullname in - print_s [%sexp (child_fullnames : Thing.Fullname.t list)]; - [%expect - {| + let%bind listing = + Connection.call_exn + connection + (Endpoint.user_overview () ~username:(Username.of_string "spez")) + in + let child_fullnames = Listing.children listing |> List.map ~f:Thing.Poly.fullname in + print_s [%sexp (child_fullnames : Thing.Fullname.t list)]; + [%expect + {| ((Comment hroelsq) (Comment hrdseug) (Comment hgsd3e4) (Comment hf0kd4r) (Comment hbhuafj) (Comment hbhpx8f) (Comment hbhmscu) (Link pbmy5y) (Comment h0xuw5y) (Comment gzof6q0) (Comment gvyvlig) (Link mcisdf) @@ -55,5 +55,5 @@ let%expect_test "user_overview" = (Comment glroko6) (Comment gl07p47) (Comment ggbcn1t) (Comment gf2hmo6) (Comment gdlk75z) (Comment gbjoobr) (Comment gbdoob3) (Comment ga80wbq) (Comment g9u720a)) |}]; - return ()) + return ()) ;; diff --git a/test/test_messages.ml b/test/test_messages.ml index d800a7a3..ffb6d8cf 100644 --- a/test/test_messages.ml +++ b/test/test_messages.ml @@ -6,61 +6,59 @@ let message_id = Thing.Message.Id.of_string "rdjz4y" let%expect_test "block_author" = with_cassette "block_author" ~f:(fun connection -> - let id = `Message message_id in - let%bind () = Connection.call_exn connection (Endpoint.block_author ~id) in - [%expect]; - return ()) + let id = `Message message_id in + let%bind () = Connection.call_exn connection (Endpoint.block_author ~id) in + [%expect]; + return ()) ;; let%expect_test "collapse_message" = with_cassette "collapse_message" ~f:(fun connection -> - let messages = [ message_id ] in - let%bind () = - Connection.call_exn connection (Endpoint.collapse_message ~messages) - in - [%expect]; - return ()) + let messages = [ message_id ] in + let%bind () = Connection.call_exn connection (Endpoint.collapse_message ~messages) in + [%expect]; + return ()) ;; let%expect_test "uncollapse_message" = with_cassette "uncollapse_message" ~f:(fun connection -> - let messages = [ message_id ] in - let%bind () = - Connection.call_exn connection (Endpoint.uncollapse_message ~messages) - in - [%expect]; - return ()) + let messages = [ message_id ] in + let%bind () = + Connection.call_exn connection (Endpoint.uncollapse_message ~messages) + in + [%expect]; + return ()) ;; let%expect_test "read_message" = with_cassette "read_message" ~f:(fun connection -> - let messages = [ message_id ] in - let%bind () = Connection.call_exn connection (Endpoint.read_message ~messages) in - [%expect]; - return ()) + let messages = [ message_id ] in + let%bind () = Connection.call_exn connection (Endpoint.read_message ~messages) in + [%expect]; + return ()) ;; let%expect_test "unread_message" = with_cassette "unread_message" ~f:(fun connection -> - let messages = [ message_id ] in - let%bind () = Connection.call_exn connection (Endpoint.unread_message ~messages) in - [%expect]; - return ()) + let messages = [ message_id ] in + let%bind () = Connection.call_exn connection (Endpoint.unread_message ~messages) in + [%expect]; + return ()) ;; let%expect_test "compose_message" = with_cassette "compose_message" ~f:(fun connection -> - let%bind () = - Connection.call_exn - connection - (Endpoint.compose_message - () - ~to_:(Username.of_string "BJO_test_user") - ~subject:"This is a message" - ~text:"This is its body") - in - [%expect]; - return ()) + let%bind () = + Connection.call_exn + connection + (Endpoint.compose_message + () + ~to_:(Username.of_string "BJO_test_user") + ~subject:"This is a message" + ~text:"This is its body") + in + [%expect]; + return ()) ;; let inbox_item_fullname (item : Inbox_item.t) = @@ -71,45 +69,44 @@ let inbox_item_fullname (item : Inbox_item.t) = let%expect_test "inbox" = with_cassette "inbox" ~f:(fun connection -> - let%bind listing = - Connection.call_exn connection (Endpoint.inbox ~limit:2 () ~mark_read:false) - in - Listing.children listing - |> List.iter ~f:(fun thing -> - print_s [%sexp (inbox_item_fullname thing : Thing.Fullname.t)]); - [%expect {| + let%bind listing = + Connection.call_exn connection (Endpoint.inbox ~limit:2 () ~mark_read:false) + in + Listing.children listing + |> List.iter ~f:(fun thing -> + print_s [%sexp (inbox_item_fullname thing : Thing.Fullname.t)]); + [%expect {| (Comment g3u0ce8) (Message rdjz4y) |}]; - return ()) + return ()) ;; let%expect_test "inbox" = with_cassette "comment_replies" ~f:(fun connection -> - let%bind listing = - Connection.call_exn - connection - (Endpoint.comment_replies ~limit:1 () ~mark_read:false) - in - let comment = List.hd_exn (Listing.children listing) in - print_s - [%sexp - { id : Thing.Comment.Id.t = Inbox_item.Comment.id comment - ; body : string = Inbox_item.Comment.body comment `markdown - ; author : Username.t option = Inbox_item.Comment.author comment - ; subreddit : Subreddit_name.t = Inbox_item.Comment.subreddit comment - ; creation_time : Time_ns.t = Inbox_item.Comment.creation_time comment - ; score : int = Inbox_item.Comment.score comment - ; parent_id : Thing.Fullname.t = - (Inbox_item.Comment.parent_id comment :> Thing.Fullname.t) - ; new_ : bool = Inbox_item.Comment.new_ comment - ; type_ : Inbox_item.Comment.Type.t = Inbox_item.Comment.type_ comment - ; link_id : Thing.Link.Id.t = Inbox_item.Comment.link_id comment - ; link_title : string = Inbox_item.Comment.link_title comment - ; num_comments_in_thread : int = - Inbox_item.Comment.num_comments_in_thread comment - }]; - [%expect - {| + let%bind listing = + Connection.call_exn + connection + (Endpoint.comment_replies ~limit:1 () ~mark_read:false) + in + let comment = List.hd_exn (Listing.children listing) in + print_s + [%sexp + { id : Thing.Comment.Id.t = Inbox_item.Comment.id comment + ; body : string = Inbox_item.Comment.body comment `markdown + ; author : Username.t option = Inbox_item.Comment.author comment + ; subreddit : Subreddit_name.t = Inbox_item.Comment.subreddit comment + ; creation_time : Time_ns.t = Inbox_item.Comment.creation_time comment + ; score : int = Inbox_item.Comment.score comment + ; parent_id : Thing.Fullname.t = + (Inbox_item.Comment.parent_id comment :> Thing.Fullname.t) + ; new_ : bool = Inbox_item.Comment.new_ comment + ; type_ : Inbox_item.Comment.Type.t = Inbox_item.Comment.type_ comment + ; link_id : Thing.Link.Id.t = Inbox_item.Comment.link_id comment + ; link_title : string = Inbox_item.Comment.link_title comment + ; num_comments_in_thread : int = Inbox_item.Comment.num_comments_in_thread comment + }]; + [%expect + {| ((id daaiwot) (body "Your comment was not up to our subreddit's standards. Please read [our posting guidelines](https://www.reddit.com/r/askphilosophy/comments/47egl3/dont_answer_questions_unless_you_have_the/) before answering questions.") @@ -118,29 +115,29 @@ let%expect_test "inbox" = (parent_id (Comment daaivi7)) (new_ false) (type_ Comment_reply) (link_id 5dtzvo) (link_title "What would Nietzsche think of Donald Trump?") (num_comments_in_thread 58)) |}]; - return ()) + return ()) ;; let%expect_test "unread" = with_cassette "unread" ~f:(fun connection -> - let%bind listing = - Connection.call_exn connection (Endpoint.unread () ~mark_read:false) - in - Listing.children listing - |> List.iter ~f:(fun thing -> - print_s [%sexp (inbox_item_fullname thing : Thing.Fullname.t)]); - [%expect {| (Comment g3u0ce8) |}]; - return ()) + let%bind listing = + Connection.call_exn connection (Endpoint.unread () ~mark_read:false) + in + Listing.children listing + |> List.iter ~f:(fun thing -> + print_s [%sexp (inbox_item_fullname thing : Thing.Fullname.t)]); + [%expect {| (Comment g3u0ce8) |}]; + return ()) ;; let%expect_test "sent" = with_cassette "sent" ~f:(fun connection -> - let%bind listing = Connection.call_exn connection (Endpoint.sent ~limit:2 ()) in - Listing.children listing - |> List.iter ~f:(fun message -> - print_s [%sexp (Thing.Message.id message : Thing.Message.Id.t)]); - [%expect {| + let%bind listing = Connection.call_exn connection (Endpoint.sent ~limit:2 ()) in + Listing.children listing + |> List.iter ~f:(fun message -> + print_s [%sexp (Thing.Message.id message : Thing.Message.Id.t)]); + [%expect {| rdkr3p rdk8sp |}]; - return ()) + return ()) ;; diff --git a/test/test_moderation.ml b/test/test_moderation.ml index 7be703dd..ea91798f 100644 --- a/test/test_moderation.ml +++ b/test/test_moderation.ml @@ -4,148 +4,147 @@ open! Import let%expect_test "remove" = with_cassette "remove" ~f:(fun connection -> - let id = `Link (Thing.Link.Id.of_string "j4z0ig") in - let%bind () = Connection.call_exn connection (Endpoint.remove ~id ~spam:false) in - [%expect]; - return ()) + let id = `Link (Thing.Link.Id.of_string "j4z0ig") in + let%bind () = Connection.call_exn connection (Endpoint.remove ~id ~spam:false) in + [%expect]; + return ()) ;; let%expect_test "distinguish" = with_cassette "distinguish" ~f:(fun connection -> - let id = `Comment (Thing.Comment.Id.of_string "g7ol4ce") in - let%bind comment = - Connection.call_exn connection (Endpoint.distinguish () ~id ~how:Mod) - in - print_s [%sexp (Thing.Poly.fullname comment : Thing.Fullname.t)]; - [%expect {| (Comment g7ol4ce) |}]; - return ()) + let id = `Comment (Thing.Comment.Id.of_string "g7ol4ce") in + let%bind comment = + Connection.call_exn connection (Endpoint.distinguish () ~id ~how:Mod) + in + print_s [%sexp (Thing.Poly.fullname comment : Thing.Fullname.t)]; + [%expect {| (Comment g7ol4ce) |}]; + return ()) ;; let%expect_test "log" = with_cassette "log" ~f:(fun connection -> - let%bind listing = Connection.call_exn connection (Endpoint.log ~limit:2 ()) in - let modactions = Listing.children listing in - print_s [%sexp (List.map modactions ~f:Mod_action.id : Mod_action.Id.t list)]; - [%expect - {| (6fbb7e1a-ef15-11ea-a905-0e73145e80df a0c30278-ef13-11ea-b8fd-0e6edeb4a85b) |}]; - print_s [%sexp (List.map modactions ~f:Mod_action.created : Time_ns.t list)]; - [%expect {| ((2020-09-05 01:16:33.000000000Z) (2020-09-05 01:03:36.000000000Z)) |}]; - print_s - [%sexp (List.map modactions ~f:Mod_action.moderator : Username.t option list)]; - [%expect {| ((L72_Elite_Kraken) (L72_Elite_Kraken)) |}]; - return ()) + let%bind listing = Connection.call_exn connection (Endpoint.log ~limit:2 ()) in + let modactions = Listing.children listing in + print_s [%sexp (List.map modactions ~f:Mod_action.id : Mod_action.Id.t list)]; + [%expect + {| (6fbb7e1a-ef15-11ea-a905-0e73145e80df a0c30278-ef13-11ea-b8fd-0e6edeb4a85b) |}]; + print_s [%sexp (List.map modactions ~f:Mod_action.created : Time_ns.t list)]; + [%expect {| ((2020-09-05 01:16:33.000000000Z) (2020-09-05 01:03:36.000000000Z)) |}]; + print_s [%sexp (List.map modactions ~f:Mod_action.moderator : Username.t option list)]; + [%expect {| ((L72_Elite_Kraken) (L72_Elite_Kraken)) |}]; + return ()) ;; let%expect_test "reports" = with_cassette "reports" ~f:(fun connection -> - let%bind listing = Connection.call_exn connection (Endpoint.reports ()) in - let children = Listing.children listing |> List.map ~f:Thing.Poly.fullname in - print_s [%sexp (children : Thing.Fullname.t list)]; - [%expect {| ((Link hoeti3)) |}]; - return ()) + let%bind listing = Connection.call_exn connection (Endpoint.reports ()) in + let children = Listing.children listing |> List.map ~f:Thing.Poly.fullname in + print_s [%sexp (children : Thing.Fullname.t list)]; + [%expect {| ((Link hoeti3)) |}]; + return ()) ;; let%expect_test "spam" = with_cassette "spam" ~f:(fun connection -> - let%bind listing = Connection.call_exn connection (Endpoint.spam ~limit:1 ()) in - let children = Listing.children listing |> List.map ~f:Thing.Poly.fullname in - print_s [%sexp (children : Thing.Fullname.t list)]; - [%expect {| ((Link hmjd8r)) |}]; - return ()) + let%bind listing = Connection.call_exn connection (Endpoint.spam ~limit:1 ()) in + let children = Listing.children listing |> List.map ~f:Thing.Poly.fullname in + print_s [%sexp (children : Thing.Fullname.t list)]; + [%expect {| ((Link hmjd8r)) |}]; + return ()) ;; let%expect_test "modqueue" = with_cassette "modqueue" ~f:(fun connection -> - let%bind listing = Connection.call_exn connection (Endpoint.modqueue ()) in - let children = Listing.children listing |> List.map ~f:Thing.Poly.fullname in - print_s [%sexp (children : Thing.Fullname.t list)]; - [%expect {| ((Link hoeti3)) |}]; - return ()) + let%bind listing = Connection.call_exn connection (Endpoint.modqueue ()) in + let children = Listing.children listing |> List.map ~f:Thing.Poly.fullname in + print_s [%sexp (children : Thing.Fullname.t list)]; + [%expect {| ((Link hoeti3)) |}]; + return ()) ;; let%expect_test "unmoderated" = with_cassette "unmoderated" ~f:(fun connection -> - let%bind listing = - Connection.call_exn connection (Endpoint.unmoderated ~limit:1 ()) - in - let children = Listing.children listing |> List.map ~f:Thing.Poly.fullname in - print_s [%sexp (children : Thing.Fullname.t list)]; - [%expect {| ((Link ili4vc)) |}]; - return ()) + let%bind listing = + Connection.call_exn connection (Endpoint.unmoderated ~limit:1 ()) + in + let children = Listing.children listing |> List.map ~f:Thing.Poly.fullname in + print_s [%sexp (children : Thing.Fullname.t list)]; + [%expect {| ((Link ili4vc)) |}]; + return ()) ;; let%expect_test "edited" = with_cassette "edited" ~f:(fun connection -> - let%bind listing = Connection.call_exn connection (Endpoint.edited ()) in - let children = Listing.children listing |> List.map ~f:Thing.Poly.fullname in - print_s [%sexp (children : Thing.Fullname.t list)]; - [%expect {| ((Comment g3krlj5)) |}]; - return ()) + let%bind listing = Connection.call_exn connection (Endpoint.edited ()) in + let children = Listing.children listing |> List.map ~f:Thing.Poly.fullname in + print_s [%sexp (children : Thing.Fullname.t list)]; + [%expect {| ((Comment g3krlj5)) |}]; + return ()) ;; let%expect_test "ignore_reports" = with_cassette "ignore_reports" ~f:(fun connection -> - let%bind () = - Connection.call_exn - connection - (Endpoint.ignore_reports ~id:(`Link (Thing.Link.Id.of_string "ili4vc"))) - in - [%expect {| |}]; - return ()) + let%bind () = + Connection.call_exn + connection + (Endpoint.ignore_reports ~id:(`Link (Thing.Link.Id.of_string "ili4vc"))) + in + [%expect {| |}]; + return ()) ;; let%expect_test "unignore_reports" = with_cassette "unignore_reports" ~f:(fun connection -> - let%bind () = - Connection.call_exn - connection - (Endpoint.unignore_reports ~id:(`Link (Thing.Link.Id.of_string "ili4vc"))) - in - [%expect {| |}]; - return ()) + let%bind () = + Connection.call_exn + connection + (Endpoint.unignore_reports ~id:(`Link (Thing.Link.Id.of_string "ili4vc"))) + in + [%expect {| |}]; + return ()) ;; let%expect_test "leavecontributor" = with_cassette "leavecontributor" ~f:(fun connection -> - let%bind () = - Connection.call_exn - connection - (Endpoint.leavecontributor ~subreddit:(Thing.Subreddit.Id.of_string "390u2")) - in - [%expect {| |}]; - return ()) + let%bind () = + Connection.call_exn + connection + (Endpoint.leavecontributor ~subreddit:(Thing.Subreddit.Id.of_string "390u2")) + in + [%expect {| |}]; + return ()) ;; let%expect_test "leavemoderator" = with_cassette "leavemoderator" ~f:(fun connection -> - let%bind () = - Connection.call_exn - connection - (Endpoint.leavemoderator ~subreddit:(Thing.Subreddit.Id.of_string "390u2")) - in - [%expect {| |}]; - return ()) + let%bind () = + Connection.call_exn + connection + (Endpoint.leavemoderator ~subreddit:(Thing.Subreddit.Id.of_string "390u2")) + in + [%expect {| |}]; + return ()) ;; let%expect_test "stylesheet" = with_cassette "stylesheet" ~f:(fun connection -> - let%bind stylesheet = - Connection.call_exn - connection - (Endpoint.stylesheet ~subreddit:(Subreddit_name.of_string "Thirdrealm")) - in - let images = - List.map (Stylesheet.images stylesheet) ~f:(fun image -> - [%sexp { url : string = Stylesheet.Image.link image }]) - in - print_s - [%sexp - { stylesheet : string = Stylesheet.stylesheet_text stylesheet - ; images : Sexp.t list - }]; - [%expect - {| + let%bind stylesheet = + Connection.call_exn + connection + (Endpoint.stylesheet ~subreddit:(Subreddit_name.of_string "Thirdrealm")) + in + let images = + List.map (Stylesheet.images stylesheet) ~f:(fun image -> + [%sexp { url : string = Stylesheet.Image.link image }]) + in + print_s + [%sexp + { stylesheet : string = Stylesheet.stylesheet_text stylesheet + ; images : Sexp.t list + }]; + [%expect + {| ((stylesheet "body {font-family: monospace}") (images (((url "url(%%leviroth%%)"))))) |}]; - return ()) + return ()) ;; diff --git a/test/test_modmail.ml b/test/test_modmail.ml index 8687d4c1..7a2f7859 100644 --- a/test/test_modmail.ml +++ b/test/test_modmail.ml @@ -4,19 +4,19 @@ open! Import let%expect_test "create_modmail_conversation" = with_cassette "create_modmail_conversation" ~f:(fun connection -> - let%bind conversation = - Connection.call_exn - connection - (Endpoint.create_modmail_conversation - ~subject:"Test subject" - ~body:"Test body" - ~subreddit:(Subreddit_name.of_string "ThirdRealm") - ~to_:(User (Username.of_string "BJO_test_user")) - ~hide_author:false) - in - print_s [%sexp (conversation : Modmail.Conversation.t)]; - [%expect - {| + let%bind conversation = + Connection.call_exn + connection + (Endpoint.create_modmail_conversation + ~subject:"Test subject" + ~body:"Test body" + ~subreddit:(Subreddit_name.of_string "ThirdRealm") + ~to_:(User (Username.of_string "BJO_test_user")) + ~hide_author:false) + in + print_s [%sexp (conversation : Modmail.Conversation.t)]; + [%expect + {| ((conversation (Object ((isAuto False) @@ -53,25 +53,25 @@ let%expect_test "create_modmail_conversation" = (isInternal False) (date (String 2020-07-26T21:18:43.146061+00:00)) (bodyMarkdown (String "Test body")) (id (String osvgj)))))))) (modActions (Object ()))) |}]; - return ()) + return ()) ;; let%expect_test "reply_modmail_conversation" = with_cassette "reply_modmail_conversation" ~f:(fun connection -> - let%bind conversation = - Connection.call_exn - connection - (Endpoint.reply_modmail_conversation - ~conversation_id:(Modmail.Conversation.Id.of_string "fsv44") - ~body:"Message body" - ~hide_author:false - ~internal:false) - in - print_s - [%sexp - { conversation_id : Modmail.Conversation.Id.t = - Modmail.Conversation.id conversation - }]; - [%expect {| ((conversation_id fsv44)) |}]; - return ()) + let%bind conversation = + Connection.call_exn + connection + (Endpoint.reply_modmail_conversation + ~conversation_id:(Modmail.Conversation.Id.of_string "fsv44") + ~body:"Message body" + ~hide_author:false + ~internal:false) + in + print_s + [%sexp + { conversation_id : Modmail.Conversation.Id.t = + Modmail.Conversation.id conversation + }]; + [%expect {| ((conversation_id fsv44)) |}]; + return ()) ;; diff --git a/test/test_oauth2_refresh_token.ml b/test/test_oauth2_refresh_token.ml index 49c2c228..a202d505 100644 --- a/test/test_oauth2_refresh_token.ml +++ b/test/test_oauth2_refresh_token.ml @@ -20,27 +20,27 @@ let with_cassette cassette_name ~f = let%expect_test "oauth2_refresh_token" = with_cassette "oauth2_refresh_token" ~f:(fun connection -> - let%bind link = get_link_exn connection "odlsl2" in - print_s - [%sexp - { id : Thing.Link.Id.t = Thing.Link.id link - ; title : string = Thing.Link.title link - }]; - [%expect {| ((id odlsl2) (title test)) |}]; - return ()) + let%bind link = get_link_exn connection "odlsl2" in + print_s + [%sexp + { id : Thing.Link.Id.t = Thing.Link.id link + ; title : string = Thing.Link.title link + }]; + [%expect {| ((id odlsl2) (title test)) |}]; + return ()) ;; let%expect_test "oauth2_refresh_token_insufficient_scope" = let%bind () = with_cassette "oauth2_refresh_token_insufficient_scope" ~f:(fun connection -> - Expect_test_helpers_async.show_raise_async (fun () -> - let%bind link = get_link_exn connection "odlsl2" in - print_s - [%sexp - { id : Thing.Link.Id.t = Thing.Link.id link - ; title : string = Thing.Link.title link - }]; - return ())) + Expect_test_helpers_async.show_raise_async (fun () -> + let%bind link = get_link_exn connection "odlsl2" in + print_s + [%sexp + { id : Thing.Link.Id.t = Thing.Link.id link + ; title : string = Thing.Link.title link + }]; + return ())) in [%expect {| @@ -88,9 +88,9 @@ let%expect_test "oauth2_refresh_token_insufficient_scope" = let%expect_test "oauth2_refresh_token__bad_token" = let%bind () = with_cassette "oauth2_refresh_token__bad_token" ~f:(fun connection -> - Expect_test_helpers_async.show_raise_async (fun () -> - let%bind _link = get_link_exn connection "odlsl2" in - return ())) + Expect_test_helpers_async.show_raise_async (fun () -> + let%bind _link = get_link_exn connection "odlsl2" in + return ())) in [%expect {| @@ -134,20 +134,20 @@ let%expect_test "oauth2_refresh_token__bad_token" = let%expect_test "oauth2_expired_access_token" = with_cassette "oauth2_expired_access_token" ~f:(fun connection -> - (* Note this is a bit of a hack: the test time source is currently also - pinned to [Time_ns.max_value_representable], but the implementation - details of [Auth.is_almsot_expired] are such that we will not treat the - token as expired, and we will make an actual request (as desired). *) - Connection.For_testing.set_access_token - connection - ~token:"71814082-xYAyuuglNJA8Br9B4Sot-Ws5CBi6BA" - ~expiration:Time_ns.max_value_representable; - let%bind link = get_link_exn connection "odlsl2" in - print_s - [%sexp - { id : Thing.Link.Id.t = Thing.Link.id link - ; title : string = Thing.Link.title link - }]; - [%expect {| ((id odlsl2) (title test)) |}]; - return ()) + (* Note this is a bit of a hack: the test time source is currently also + pinned to [Time_ns.max_value_representable], but the implementation + details of [Auth.is_almsot_expired] are such that we will not treat the + token as expired, and we will make an actual request (as desired). *) + Connection.For_testing.set_access_token + connection + ~token:"71814082-xYAyuuglNJA8Br9B4Sot-Ws5CBi6BA" + ~expiration:Time_ns.max_value_representable; + let%bind link = get_link_exn connection "odlsl2" in + print_s + [%sexp + { id : Thing.Link.Id.t = Thing.Link.id link + ; title : string = Thing.Link.title link + }]; + [%expect {| ((id odlsl2) (title test)) |}]; + return ()) ;; diff --git a/test/test_oauth2_userless.ml b/test/test_oauth2_userless.ml index 1ac422f3..6c5f19e1 100644 --- a/test/test_oauth2_userless.ml +++ b/test/test_oauth2_userless.ml @@ -9,12 +9,12 @@ let with_cassette cassette_name ~f ~is_confidential = Sexp.load_sexp_conv_exn credential_path [%of_sexp: Connection.Credentials.t] | None -> (match is_confidential with - | true -> - Userless_confidential - { client_id = "TEST_CLIENT_ID"; client_secret = "TEST_CLIENT_SECRET" } - | false -> - Userless_public - { client_id = "TEST_CLIENT_ID"; device_id = Some "TEST_DEVICE_ID" }) + | true -> + Userless_confidential + { client_id = "TEST_CLIENT_ID"; client_secret = "TEST_CLIENT_SECRET" } + | false -> + Userless_public + { client_id = "TEST_CLIENT_ID"; device_id = Some "TEST_DEVICE_ID" }) in let filename = "cassettes" ^/ sprintf "%s.sexp" cassette_name in Connection.For_testing.with_cassette filename ~credentials ~f diff --git a/test/test_rate_limiter.ml b/test/test_rate_limiter.ml index 02841303..dc0363eb 100644 --- a/test/test_rate_limiter.ml +++ b/test/test_rate_limiter.ml @@ -127,10 +127,10 @@ let%expect_test _ = (* Exhausting the remaining limit causes us to be not-ready. *) let%bind () = Deferred.repeat_until_finished 10 (function - | 0 -> return (`Finished ()) - | n -> - let%bind () = Rate_limiter.permit_request rate_limiter in - return (`Repeat (n - 1))) + | 0 -> return (`Finished ()) + | n -> + let%bind () = Rate_limiter.permit_request rate_limiter in + return (`Repeat (n - 1))) in print (); [%expect diff --git a/test/test_report.ml b/test/test_report.ml index 1d5d97fa..0738a2e8 100644 --- a/test/test_report.ml +++ b/test/test_report.ml @@ -4,10 +4,10 @@ open! Import let%expect_test "report" = with_cassette "report" ~f:(fun connection -> - let target = `Link (Thing.Link.Id.of_string "hony5b") in - let%bind () = - Connection.call_exn connection (Endpoint.report () ~target ~reason:"Test report") - in - [%expect {| |}]; - return ()) + let target = `Link (Thing.Link.Id.of_string "hony5b") in + let%bind () = + Connection.call_exn connection (Endpoint.report () ~target ~reason:"Test report") + in + [%expect {| |}]; + return ()) ;; diff --git a/test/test_search.ml b/test/test_search.ml index 4c0b465a..28dec666 100644 --- a/test/test_search.ml +++ b/test/test_search.ml @@ -7,23 +7,23 @@ let children_of_optional_listing opt = Option.to_list opt |> List.bind ~f:Listin let print_links links = let children = children_of_optional_listing links in List.iter children ~f:(fun link -> - print_s [%sexp (Thing.Link.id link : Thing.Link.Id.t)]) + print_s [%sexp (Thing.Link.id link : Thing.Link.Id.t)]) ;; let print_users_and_subreddits listing = let children = children_of_optional_listing listing in List.iter children ~f:(fun thing -> - print_s [%sexp (Thing.Poly.fullname thing : Thing.Fullname.t)]) + print_s [%sexp (Thing.Poly.fullname thing : Thing.Fullname.t)]) ;; let%expect_test "search" = with_cassette "search" ~f:(fun connection -> - let%bind links, users_and_subreddits = - Connection.call_exn connection (Endpoint.search () ~query:"ocaml") - in - print_links links; - [%expect - {| + let%bind links, users_and_subreddits = + Connection.call_exn connection (Endpoint.search () ~query:"ocaml") + in + print_links links; + [%expect + {| ihn5kn idh5be idq8tq @@ -49,26 +49,26 @@ let%expect_test "search" = i6e9gz i4mtbv icqrut |}]; - print_users_and_subreddits users_and_subreddits; - [%expect]; - return ()) + print_users_and_subreddits users_and_subreddits; + [%expect]; + return ()) ;; let%expect_test "search__subreddits" = with_cassette "search__subreddits" ~f:(fun connection -> - let%bind links, users_and_subreddits = - Connection.call_exn - connection - (Endpoint.search - () - ~types:(Set.singleton (module Endpoint.Parameters.Search_type) Subreddit) - ~query:"ocaml") - in - print_links links; - [%expect]; - print_users_and_subreddits users_and_subreddits; - [%expect - {| + let%bind links, users_and_subreddits = + Connection.call_exn + connection + (Endpoint.search + () + ~types:(Set.singleton (module Endpoint.Parameters.Search_type) Subreddit) + ~query:"ocaml") + in + print_links links; + [%expect]; + print_users_and_subreddits users_and_subreddits; + [%expect + {| (Subreddit 2qh60) (Subreddit 2qh36) (Subreddit 3fcct) @@ -94,22 +94,22 @@ let%expect_test "search__subreddits" = (Subreddit 2sslb) (Subreddit 3cmf4) (Subreddit 3cv1n) |}]; - return ()) + return ()) ;; let%expect_test "search__all" = with_cassette "search__all" ~f:(fun connection -> - let%bind links, users_and_subreddits = - Connection.call_exn - connection - (Endpoint.search - () - ~types:Endpoint.Parameters.Search_type.(Set.of_list all) - ~query:"spez") - in - print_links links; - [%expect - {| + let%bind links, users_and_subreddits = + Connection.call_exn + connection + (Endpoint.search + () + ~types:Endpoint.Parameters.Search_type.(Set.of_list all) + ~query:"spez") + in + print_links links; + [%expect + {| ipiwyi iav0ir ipjm8d @@ -132,11 +132,11 @@ let%expect_test "search__all" = h7uh5b iot9mx ig4086 |}]; - print_users_and_subreddits users_and_subreddits; - [%expect - {| + print_users_and_subreddits users_and_subreddits; + [%expect + {| (Subreddit 2qij9) (User 1w72) (Subreddit 3glzb) |}]; - return ()) + return ()) ;; diff --git a/test/test_select_flair.ml b/test/test_select_flair.ml index b695ecb9..125b3b47 100644 --- a/test/test_select_flair.ml +++ b/test/test_select_flair.ml @@ -4,14 +4,14 @@ open! Import let%expect_test "select_flair" = with_cassette "select_flair" ~f:(fun connection -> - let subreddit = Subreddit_name.of_string "ThirdRealm" in - let link = Thing.Link.Id.of_string "hmjghn" in - let flair_template_id = Uuid.of_string "6c5ea4bc-c16c-11ea-9a01-0ea60516144b" in - let%bind () = - Connection.call_exn - connection - (Endpoint.select_flair ~flair_template_id () ~subreddit ~target:(Link link)) - in - [%expect {| |}]; - return ()) + let subreddit = Subreddit_name.of_string "ThirdRealm" in + let link = Thing.Link.Id.of_string "hmjghn" in + let flair_template_id = Uuid.of_string "6c5ea4bc-c16c-11ea-9a01-0ea60516144b" in + let%bind () = + Connection.call_exn + connection + (Endpoint.select_flair ~flair_template_id () ~subreddit ~target:(Link link)) + in + [%expect {| |}]; + return ()) ;; diff --git a/test/test_set_subreddit_sticky.ml b/test/test_set_subreddit_sticky.ml index 16ad0998..bd072415 100644 --- a/test/test_set_subreddit_sticky.ml +++ b/test/test_set_subreddit_sticky.ml @@ -4,21 +4,18 @@ open! Import let%expect_test "set_subreddit_sticky" = with_cassette "set_subreddit_sticky" ~f:(fun connection -> - let link = Thing.Link.Id.of_string "f7vspj" in - let%bind () = - Connection.call_exn - connection - (Endpoint.set_subreddit_sticky - () - ~link - ~sticky_state:(Sticky { slot = Some 2 })) - in - [%expect]; - let%bind () = - Connection.call_exn - connection - (Endpoint.set_subreddit_sticky () ~link ~sticky_state:Unsticky) - in - [%expect]; - return ()) + let link = Thing.Link.Id.of_string "f7vspj" in + let%bind () = + Connection.call_exn + connection + (Endpoint.set_subreddit_sticky () ~link ~sticky_state:(Sticky { slot = Some 2 })) + in + [%expect]; + let%bind () = + Connection.call_exn + connection + (Endpoint.set_subreddit_sticky () ~link ~sticky_state:Unsticky) + in + [%expect]; + return ()) ;; diff --git a/test/test_set_suggested_sort.ml b/test/test_set_suggested_sort.ml index 556b4b93..5df071c4 100644 --- a/test/test_set_suggested_sort.ml +++ b/test/test_set_suggested_sort.ml @@ -4,12 +4,10 @@ open! Import let%expect_test "set_suggested_sort" = with_cassette "set_suggested_sort" ~f:(fun connection -> - let link = Thing.Link.Id.of_string "hmjghn" in - let%bind () = - Connection.call_exn - connection - (Endpoint.set_suggested_sort ~sort:(Some New) ~link) - in - [%expect {| |}]; - return ()) + let link = Thing.Link.Id.of_string "hmjghn" in + let%bind () = + Connection.call_exn connection (Endpoint.set_suggested_sort ~sort:(Some New) ~link) + in + [%expect {| |}]; + return ()) ;; diff --git a/test/test_submit.ml b/test/test_submit.ml index 598e489b..7604604f 100644 --- a/test/test_submit.ml +++ b/test/test_submit.ml @@ -4,46 +4,46 @@ open! Import let%expect_test "submit" = with_cassette "submit" ~f:(fun connection -> - let title = "Test post title" in - let subreddit = Subreddit_name.of_string "ThirdRealm" in - let%bind id, uri = - Connection.call_exn - connection - (Endpoint.submit - () - ~title - ~subreddit - ~kind:(Self (Markdown "This is a post body."))) - in - print_s - [%message - "Submission attributes" (id : Thing.Link.Id.t) ~uri:(Uri.to_string uri : string)]; - [%expect - {| + let title = "Test post title" in + let subreddit = Subreddit_name.of_string "ThirdRealm" in + let%bind id, uri = + Connection.call_exn + connection + (Endpoint.submit + () + ~title + ~subreddit + ~kind:(Self (Markdown "This is a post body."))) + in + print_s + [%message + "Submission attributes" (id : Thing.Link.Id.t) ~uri:(Uri.to_string uri : string)]; + [%expect + {| ("Submission attributes" (id hmjghn) (uri https://www.reddit.com/r/ThirdRealm/comments/hmjghn/test_post_title/)) |}]; - return ()) + return ()) ;; let%expect_test "submit__crosspost" = with_cassette "submit__crosspost" ~f:(fun connection -> - let title = "Crosspost" in - let subreddit = Subreddit_name.of_string "ThirdRealm" in - let%bind id, uri = - Connection.call_exn - connection - (Endpoint.submit - () - ~title - ~subreddit - ~kind:(Crosspost (Thing.Link.Id.of_string "box80e"))) - in - print_s - [%message - "Submission attributes" (id : Thing.Link.Id.t) ~uri:(Uri.to_string uri : string)]; - [%expect - {| + let title = "Crosspost" in + let subreddit = Subreddit_name.of_string "ThirdRealm" in + let%bind id, uri = + Connection.call_exn + connection + (Endpoint.submit + () + ~title + ~subreddit + ~kind:(Crosspost (Thing.Link.Id.of_string "box80e"))) + in + print_s + [%message + "Submission attributes" (id : Thing.Link.Id.t) ~uri:(Uri.to_string uri : string)]; + [%expect + {| ("Submission attributes" (id ili4vc) (uri https://www.reddit.com/r/ThirdRealm/comments/ili4vc/crosspost/)) |}]; - return ()) + return ()) ;; diff --git a/test/test_subreddit_fields.ml b/test/test_subreddit_fields.ml index b6dbec3f..a481d620 100644 --- a/test/test_subreddit_fields.ml +++ b/test/test_subreddit_fields.ml @@ -4,24 +4,24 @@ open! Import let%expect_test "subreddit_fields" = with_cassette "subreddit_fields" ~f:(fun connection -> - let%bind subreddit = - Connection.call_exn - connection - (Endpoint.about_subreddit ~subreddit:(Subreddit_name.of_string "ocaml")) - in - print_s [%sexp (Thing.Subreddit.name subreddit : Subreddit_name.t)]; - [%expect {| ocaml |}]; - print_s [%sexp (Thing.Subreddit.title subreddit : string)]; - [%expect {| "let reddit = OCaml;;" |}]; - print_s [%sexp (String.prefix (Thing.Subreddit.description subreddit) 80 : string)]; - [%expect - {| + let%bind subreddit = + Connection.call_exn + connection + (Endpoint.about_subreddit ~subreddit:(Subreddit_name.of_string "ocaml")) + in + print_s [%sexp (Thing.Subreddit.name subreddit : Subreddit_name.t)]; + [%expect {| ocaml |}]; + print_s [%sexp (Thing.Subreddit.title subreddit : string)]; + [%expect {| "let reddit = OCaml;;" |}]; + print_s [%sexp (String.prefix (Thing.Subreddit.description subreddit) 80 : string)]; + [%expect + {| "[OCaml](http://ocaml.org/) is a statically typed functional programming language" |}]; - print_s [%sexp (Thing.Subreddit.subscribers subreddit : int)]; - [%expect {| 7554 |}]; - print_s [%sexp (Thing.Subreddit.active_users subreddit : int)]; - [%expect {| 12 |}]; - print_s [%sexp (Thing.Subreddit.creation_time subreddit : Time_ns.t)]; - [%expect {| (2008-01-25 13:24:41.000000000Z) |}]; - return ()) + print_s [%sexp (Thing.Subreddit.subscribers subreddit : int)]; + [%expect {| 7554 |}]; + print_s [%sexp (Thing.Subreddit.active_users subreddit : int)]; + [%expect {| 12 |}]; + print_s [%sexp (Thing.Subreddit.creation_time subreddit : Time_ns.t)]; + [%expect {| (2008-01-25 13:24:41.000000000Z) |}]; + return ()) ;; diff --git a/test/test_subreddits.ml b/test/test_subreddits.ml index 3fcc672c..71c7ab8a 100644 --- a/test/test_subreddits.ml +++ b/test/test_subreddits.ml @@ -7,145 +7,141 @@ let subreddit = Subreddit_name.of_string "ThirdRealm" let%expect_test "banned" = with_cassette "banned" ~f:(fun connection -> - let%bind () = - Connection.call_exn connection (Endpoint.banned () ~subreddit) - >>| Listing.children - >>| List.iter ~f:(fun ban -> - print_s - [%sexp - { relationship_id : Ban.Id.t = Ban.relationship_id ban - ; username : Username.t = Ban.username ban - ; user_id : Thing.User.Id.t = Ban.user_id ban - ; note : string = Ban.note ban - ; days_left : int option = Ban.days_left ban - ; date : Time_ns.t = Ban.date ban - }]) - in - [%expect - {| + let%bind () = + Connection.call_exn connection (Endpoint.banned () ~subreddit) + >>| Listing.children + >>| List.iter ~f:(fun ban -> + print_s + [%sexp + { relationship_id : Ban.Id.t = Ban.relationship_id ban + ; username : Username.t = Ban.username ban + ; user_id : Thing.User.Id.t = Ban.user_id ban + ; note : string = Ban.note ban + ; days_left : int option = Ban.days_left ban + ; date : Time_ns.t = Ban.date ban + }]) + in + [%expect + {| ((relationship_id rb_26zyq4m) (username ketralnis) (user_id nn0q) (note "blah blah blah") (days_left (2)) (date (2020-09-17 12:50:33.000000000Z))) ((relationship_id rb_26zynhm) (username spez) (user_id 1w72) (note "blah blah blah: Capricious ban") (days_left ()) (date (2020-09-17 12:49:32.000000000Z))) |}]; - return ()) + return ()) ;; let%expect_test "muted" = with_cassette "muted" ~f:(fun connection -> - let%bind () = - Connection.call_exn connection (Endpoint.muted () ~subreddit) - >>| Listing.children - >>| List.iter ~f:(fun mute -> - print_s - [%sexp - { relationship_id : Mute.Id.t = Mute.relationship_id mute - ; username : Username.t = Mute.username mute - ; user_id : Thing.User.Id.t = Mute.user_id mute - ; date : Time_ns.t = Mute.date mute - }]) - in - [%expect - {| + let%bind () = + Connection.call_exn connection (Endpoint.muted () ~subreddit) + >>| Listing.children + >>| List.iter ~f:(fun mute -> + print_s + [%sexp + { relationship_id : Mute.Id.t = Mute.relationship_id mute + ; username : Username.t = Mute.username mute + ; user_id : Thing.User.Id.t = Mute.user_id mute + ; date : Time_ns.t = Mute.date mute + }]) + in + [%expect + {| ((relationship_id Mute_c00caa20-fac7-11ea-a7ae-22f314d2d040) (username BJO_test_user) (user_id xw1ym) (date (2020-09-19 22:30:41.000000000Z))) |}]; - return ()) + return ()) ;; let%expect_test "wiki_banned" = with_cassette "wiki_banned" ~f:(fun connection -> - let%bind () = - Connection.call_exn connection (Endpoint.wiki_banned () ~subreddit) - >>| Listing.children - >>| List.iter ~f:(fun ban -> - print_s - [%sexp - { relationship_id : Ban.Id.t = Ban.relationship_id ban - ; username : Username.t = Ban.username ban - ; user_id : Thing.User.Id.t = Ban.user_id ban - ; note : string = Ban.note ban - ; days_left : int option = Ban.days_left ban - ; date : Time_ns.t = Ban.date ban - }]) - in - [%expect - {| + let%bind () = + Connection.call_exn connection (Endpoint.wiki_banned () ~subreddit) + >>| Listing.children + >>| List.iter ~f:(fun ban -> + print_s + [%sexp + { relationship_id : Ban.Id.t = Ban.relationship_id ban + ; username : Username.t = Ban.username ban + ; user_id : Thing.User.Id.t = Ban.user_id ban + ; note : string = Ban.note ban + ; days_left : int option = Ban.days_left ban + ; date : Time_ns.t = Ban.date ban + }]) + in + [%expect + {| ((relationship_id rb_276wzg3) (username BJO_test_user) (user_id xw1ym) (note bar) (days_left (2)) (date (2020-09-19 22:39:05.000000000Z))) |}]; - return ()) + return ()) ;; let%expect_test "contributors" = with_cassette "contributors" ~f:(fun connection -> - let%bind () = - Connection.call_exn connection (Endpoint.contributors () ~subreddit) - >>| Listing.children - >>| List.iter ~f:(fun contributor -> - print_s - [%sexp - { relationship_id : Contributor.Id.t = - Contributor.relationship_id contributor - ; username : Username.t = Contributor.username contributor - ; user_id : Thing.User.Id.t = Contributor.user_id contributor - ; date : Time_ns.t = Contributor.date contributor - }]) - in - [%expect - {| + let%bind () = + Connection.call_exn connection (Endpoint.contributors () ~subreddit) + >>| Listing.children + >>| List.iter ~f:(fun contributor -> + print_s + [%sexp + { relationship_id : Contributor.Id.t = Contributor.relationship_id contributor + ; username : Username.t = Contributor.username contributor + ; user_id : Thing.User.Id.t = Contributor.user_id contributor + ; date : Time_ns.t = Contributor.date contributor + }]) + in + [%expect + {| ((relationship_id rb_rktlv8) (username BJO_test_user) (user_id xw1ym) (date (2017-10-17 22:31:49.000000000Z))) ((relationship_id rb_g6xsft) (username BJO_test_mod) (user_id xw27h) (date (2016-06-05 02:12:22.000000000Z))) |}]; - return ()) + return ()) ;; let%expect_test "wiki_contributors" = with_cassette "wiki_contributors" ~f:(fun connection -> - let%bind () = - Connection.call_exn connection (Endpoint.wiki_contributors () ~subreddit) - >>| Listing.children - >>| List.iter ~f:(fun contributor -> - print_s - [%sexp - { relationship_id : Contributor.Id.t = - Contributor.relationship_id contributor - ; username : Username.t = Contributor.username contributor - ; user_id : Thing.User.Id.t = Contributor.user_id contributor - ; date : Time_ns.t = Contributor.date contributor - }]) - in - [%expect - {| + let%bind () = + Connection.call_exn connection (Endpoint.wiki_contributors () ~subreddit) + >>| Listing.children + >>| List.iter ~f:(fun contributor -> + print_s + [%sexp + { relationship_id : Contributor.Id.t = Contributor.relationship_id contributor + ; username : Username.t = Contributor.username contributor + ; user_id : Thing.User.Id.t = Contributor.user_id contributor + ; date : Time_ns.t = Contributor.date contributor + }]) + in + [%expect + {| ((relationship_id rb_278zt5u) (username L72_Elite_Kraken) (user_id 16r83m) (date (2020-09-20 16:45:27.000000000Z))) |}]; - return ()) + return ()) ;; let%expect_test "moderators" = with_cassette "moderators" ~f:(fun connection -> - let%bind () = - Connection.call_exn - connection - (Endpoint.moderators () ~subreddit:(Subreddit_name.of_string "redditdev")) - >>| Listing.children - >>| List.iter ~f:(fun moderator -> - print_s - [%sexp - { relationship_id : Moderator.Id.t = - Moderator.relationship_id moderator - ; username : Username.t = Moderator.username moderator - ; user_id : Thing.User.Id.t = Moderator.user_id moderator - ; date : Time_ns.t = Moderator.date moderator - ; permissions : string list = Moderator.permissions moderator - ; flair_text : string option = Moderator.flair_text moderator - ; flair_css_class : string option = - Moderator.flair_css_class moderator - }]) - in - [%expect - {| + let%bind () = + Connection.call_exn + connection + (Endpoint.moderators () ~subreddit:(Subreddit_name.of_string "redditdev")) + >>| Listing.children + >>| List.iter ~f:(fun moderator -> + print_s + [%sexp + { relationship_id : Moderator.Id.t = Moderator.relationship_id moderator + ; username : Username.t = Moderator.username moderator + ; user_id : Thing.User.Id.t = Moderator.user_id moderator + ; date : Time_ns.t = Moderator.date moderator + ; permissions : string list = Moderator.permissions moderator + ; flair_text : string option = Moderator.flair_text moderator + ; flair_css_class : string option = Moderator.flair_css_class moderator + }]) + in + [%expect + {| ((relationship_id rb_l5k8) (username ketralnis) (user_id nn0q) (date (2008-06-18 15:51:21.000000000Z)) (permissions (all)) (flair_text ("reddit admin")) (flair_css_class ())) @@ -183,159 +179,157 @@ let%expect_test "moderators" = (date (2018-06-22 06:23:11.000000000Z)) (permissions (posts access mail config flair)) (flair_text ("Pushshift.io data scientist")) (flair_css_class ())) |}]; - return ()) + return ()) ;; let%expect_test "delete_subreddit_banner" = with_cassette "delete_subreddit_banner" ~f:(fun connection -> - let%bind () = - Connection.call_exn - connection - (Endpoint.delete_subreddit_image ~subreddit ~image:Mobile_banner) - in - [%expect {| |}]; - return ()) + let%bind () = + Connection.call_exn + connection + (Endpoint.delete_subreddit_image ~subreddit ~image:Mobile_banner) + in + [%expect {| |}]; + return ()) ;; let%expect_test "delete_subreddit_header" = with_cassette "delete_subreddit_header" ~f:(fun connection -> - let%bind () = - Connection.call_exn - connection - (Endpoint.delete_subreddit_image ~subreddit ~image:Header) - in - [%expect {| |}]; - return ()) + let%bind () = + Connection.call_exn + connection + (Endpoint.delete_subreddit_image ~subreddit ~image:Header) + in + [%expect {| |}]; + return ()) ;; let%expect_test "delete_subreddit_icon" = with_cassette "delete_subreddit_icon" ~f:(fun connection -> - let%bind () = - Connection.call_exn - connection - (Endpoint.delete_subreddit_image ~subreddit ~image:Mobile_icon) - in - [%expect {| |}]; - return ()) + let%bind () = + Connection.call_exn + connection + (Endpoint.delete_subreddit_image ~subreddit ~image:Mobile_icon) + in + [%expect {| |}]; + return ()) ;; let%expect_test "delete_subreddit_image" = with_cassette "delete_subreddit_image" ~f:(fun connection -> - let%bind () = - Connection.call_exn - connection - (Endpoint.delete_subreddit_image - ~subreddit - ~image:(Stylesheet_image { name = "leviroth" })) - in - [%expect {| |}]; - return ()) + let%bind () = + Connection.call_exn + connection + (Endpoint.delete_subreddit_image + ~subreddit + ~image:(Stylesheet_image { name = "leviroth" })) + in + [%expect {| |}]; + return ()) ;; let%expect_test "search_subreddits_by_name" = with_cassette "search_subreddits_by_name" ~f:(fun connection -> - let%bind subreddits = - Connection.call_exn - connection - (Endpoint.search_subreddits_by_name () ~query:"python") - in - print_s [%sexp (subreddits : Subreddit_name.t list)]; - [%expect - {| + let%bind subreddits = + Connection.call_exn + connection + (Endpoint.search_subreddits_by_name () ~query:"python") + in + print_s [%sexp (subreddits : Subreddit_name.t list)]; + [%expect + {| (Python pythontips PythonProjects2 pythonforengineers python_netsec PythonJobs pythoncoding PythonGUI PythonNoobs pythonclass) |}]; - return ()) + return ()) ;; let%expect_test "submit_text" = with_cassette "submit_text" ~f:(fun connection -> - let%bind submit_text = - Connection.call_exn - connection - (Endpoint.submit_text ~subreddit:(Subreddit_name.of_string "philosophy")) - in - List.iter [ `markdown; `HTML ] ~f:(fun markup -> - print_s - [%sexp - (Submit_text.submit_text markup submit_text |> String.sub ~pos:0 ~len:80 - : string)]); - [%expect - {| + let%bind submit_text = + Connection.call_exn + connection + (Endpoint.submit_text ~subreddit:(Subreddit_name.of_string "philosophy")) + in + List.iter [ `markdown; `HTML ] ~f:(fun markup -> + print_s + [%sexp + (Submit_text.submit_text markup submit_text |> String.sub ~pos:0 ~len:80 + : string)]); + [%expect + {| "Please make sure you have read the /r/philosophy posting rules which can be foun" "

Please make sure you have read the - let%bind () = - Connection.call_exn - connection - (Endpoint.subreddit_autocomplete () ~query:"python") - >>| Listing.children - >>| List.iter ~f:(fun subreddit -> - print_s [%sexp (Thing.Subreddit.name subreddit : Subreddit_name.t)]) - in - [%expect - {| + let%bind () = + Connection.call_exn connection (Endpoint.subreddit_autocomplete () ~query:"python") + >>| Listing.children + >>| List.iter ~f:(fun subreddit -> + print_s [%sexp (Thing.Subreddit.name subreddit : Subreddit_name.t)]) + in + [%expect + {| Python pythontips pythoncoding PythonProjects2 pythonforengineers |}]; - return ()) + return ()) ;; let%expect_test "set_subreddit_stylesheet" = with_cassette "set_subreddit_stylesheet" ~f:(fun connection -> - let%bind () = - Connection.call_exn - connection - (Endpoint.set_subreddit_stylesheet - () - ~subreddit - ~stylesheet_contents:"body {font-family: monospace}") - in - [%expect]; - return ()) + let%bind () = + Connection.call_exn + connection + (Endpoint.set_subreddit_stylesheet + () + ~subreddit + ~stylesheet_contents:"body {font-family: monospace}") + in + [%expect]; + return ()) ;; let%expect_test "subscribe" = let%bind () = with_cassette "subscribe__by_name" ~f:(fun connection -> - let%bind () = - Connection.call_exn - connection - (Endpoint.subscribe - () - ~action:Subscribe - ~subreddits:(By_name [ Subreddit_name.of_string "python" ])) - in - [%expect]; - return ()) - in - with_cassette "subscribe__by_id" ~f:(fun connection -> let%bind () = Connection.call_exn connection (Endpoint.subscribe () ~action:Subscribe - ~subreddits:(By_id [ Thing.Subreddit.Id.of_string "2qh0y" ])) + ~subreddits:(By_name [ Subreddit_name.of_string "python" ])) in [%expect]; return ()) + in + with_cassette "subscribe__by_id" ~f:(fun connection -> + let%bind () = + Connection.call_exn + connection + (Endpoint.subscribe + () + ~action:Subscribe + ~subreddits:(By_id [ Thing.Subreddit.Id.of_string "2qh0y" ])) + in + [%expect]; + return ()) ;; let%expect_test "search_users" = with_cassette "search_users" ~f:(fun connection -> - let%bind () = - Connection.call_exn connection (Endpoint.search_users () ~query:"python") - >>| Listing.children - >>| List.iter ~f:(fun user -> print_s [%sexp (Thing.User.name user : Username.t)]) - in - [%expect - {| + let%bind () = + Connection.call_exn connection (Endpoint.search_users () ~query:"python") + >>| Listing.children + >>| List.iter ~f:(fun user -> print_s [%sexp (Thing.User.name user : Username.t)]) + in + [%expect + {| MrAstroThomas python_boti python_js @@ -348,41 +342,41 @@ let%expect_test "search_users" = PythonTech PythonMaster66677 python |}]; - return ()) + return ()) ;; let%expect_test "subreddit_settings" = with_cassette "subreddit_settings" ~f:(fun connection -> - let%bind subreddit_settings = - Connection.call_exn connection (Endpoint.subreddit_settings () ~subreddit) - in - print_s - [%sexp - (Subreddit_settings.get_field_exn subreddit_settings "restrict_posting" - |> Jsonaf.bool_exn - : bool)]; - [%expect {| true |}]; - return ()) + let%bind subreddit_settings = + Connection.call_exn connection (Endpoint.subreddit_settings () ~subreddit) + in + print_s + [%sexp + (Subreddit_settings.get_field_exn subreddit_settings "restrict_posting" + |> Jsonaf.bool_exn + : bool)]; + [%expect {| true |}]; + return ()) ;; let%expect_test "subreddit_rules" = with_cassette "subreddit_rules" ~f:(fun connection -> - let%bind rules = - Connection.call_exn connection (Endpoint.subreddit_rules ~subreddit) - in - List.iter (Subreddit_rules.subreddit_rules rules) ~f:(fun rule -> - let open Subreddit_rules.Rule in - print_s - [%sexp - { kind : Kind.t = kind rule - ; description : string = description rule `markdown - ; short_name : string = short_name rule - ; report_reason : string = report_reason rule - ; creation_time : Time_ns.t = creation_time rule - ; priority : int = priority rule - }]); - [%expect - {| + let%bind rules = + Connection.call_exn connection (Endpoint.subreddit_rules ~subreddit) + in + List.iter (Subreddit_rules.subreddit_rules rules) ~f:(fun rule -> + let open Subreddit_rules.Rule in + print_s + [%sexp + { kind : Kind.t = kind rule + ; description : string = description rule `markdown + ; short_name : string = short_name rule + ; report_reason : string = report_reason rule + ; creation_time : Time_ns.t = creation_time rule + ; priority : int = priority rule + }]); + [%expect + {| ((kind All) (description "Rule 1 - details") (short_name "Rule 1") (report_reason "Rule 1 - report reason") (creation_time (2016-01-26 06:41:52.000000000Z)) (priority 0)) @@ -392,100 +386,98 @@ let%expect_test "subreddit_rules" = ((kind Comment) (description "Rule 3 - details - with *markdown*.") (short_name "Rule 3") (report_reason "Rule 3 - report reason") (creation_time (2016-11-15 03:13:28.000000000Z)) (priority 2)) |}]; - ignore (Subreddit_rules.site_rules rules : Jsonaf.t); - ignore (Subreddit_rules.site_rules_flow rules : Jsonaf.t); - return ()) + ignore (Subreddit_rules.site_rules rules : Jsonaf.t); + ignore (Subreddit_rules.site_rules_flow rules : Jsonaf.t); + return ()) ;; let%expect_test "subreddit_traffic" = with_cassette "subreddit_traffic" ~f:(fun connection -> - let%bind traffic = - Connection.call_exn connection (Endpoint.subreddit_traffic ~subreddit) - in - let by_date = List.take (Subreddit_traffic.by_date traffic) 4 in - print_s [%sexp (by_date : Subreddit_traffic.By_date.t list)]; - [%expect - {| + let%bind traffic = + Connection.call_exn connection (Endpoint.subreddit_traffic ~subreddit) + in + let by_date = List.take (Subreddit_traffic.by_date traffic) 4 in + print_s [%sexp (by_date : Subreddit_traffic.By_date.t list)]; + [%expect + {| (((date 2020-10-24) (uniques 0) (pageviews 0) (subscriptions 0)) ((date 2020-10-23) (uniques 0) (pageviews 0) (subscriptions 0)) ((date 2020-10-22) (uniques 0) (pageviews 0) (subscriptions 0)) ((date 2020-10-21) (uniques 1) (pageviews 7) (subscriptions 0))) |}]; - let by_month = List.take (Subreddit_traffic.by_month traffic) 4 in - print_s [%sexp (by_month : Subreddit_traffic.By_month.t list)]; - [%expect - {| + let by_month = List.take (Subreddit_traffic.by_month traffic) 4 in + print_s [%sexp (by_month : Subreddit_traffic.By_month.t list)]; + [%expect + {| (((year 2020) (month Oct) (uniques 3) (pageviews 215)) ((year 2020) (month Sep) (uniques 3) (pageviews 114)) ((year 2020) (month Aug) (uniques 2) (pageviews 58)) ((year 2020) (month Jul) (uniques 5) (pageviews 154))) |}]; - let by_hour = List.take (Subreddit_traffic.by_hour traffic) 4 in - print_s [%sexp (by_hour : Subreddit_traffic.By_hour.t list)]; - [%expect - {| + let by_hour = List.take (Subreddit_traffic.by_hour traffic) 4 in + print_s [%sexp (by_hour : Subreddit_traffic.By_hour.t list)]; + [%expect + {| (((hour "2020-10-24 17:00:00Z") (uniques 0) (pageviews 0)) ((hour "2020-10-24 16:00:00Z") (uniques 0) (pageviews 0)) ((hour "2020-10-24 15:00:00Z") (uniques 0) (pageviews 0)) ((hour "2020-10-24 14:00:00Z") (uniques 0) (pageviews 0))) |}]; - return ()) + return ()) ;; let%expect_test "subreddit_sticky" = with_cassette "subreddit_sticky" ~f:(fun connection -> - let%bind sticky_id = - Connection.call_exn connection (Endpoint.get_sticky ~number:2 () ~subreddit) - in - print_s [%sexp (sticky_id : Thing.Link.Id.t)]; - [%expect {| jhgtn4 |}]; - return ()) + let%bind sticky_id = + Connection.call_exn connection (Endpoint.get_sticky ~number:2 () ~subreddit) + in + print_s [%sexp (sticky_id : Thing.Link.Id.t)]; + [%expect {| jhgtn4 |}]; + return ()) ;; let%expect_test "get_subreddits" = with_cassette "get_subreddits" ~f:(fun connection -> - let%bind subreddits = - Connection.call_exn - connection - (Endpoint.get_subreddits () ~relationship:Moderator) - >>| Listing.children - >>| List.map ~f:Thing.Subreddit.name - in - print_s [%sexp (subreddits : Subreddit_name.t list)]; - [%expect {| (ThirdRealm u_BJO_test_user) |}]; - return ()) + let%bind subreddits = + Connection.call_exn connection (Endpoint.get_subreddits () ~relationship:Moderator) + >>| Listing.children + >>| List.map ~f:Thing.Subreddit.name + in + print_s [%sexp (subreddits : Subreddit_name.t list)]; + [%expect {| (ThirdRealm u_BJO_test_user) |}]; + return ()) ;; let%expect_test "search_subreddits_by_title_and_description" = with_cassette "search_subreddits_by_title_and_description" ~f:(fun connection -> - let%bind subreddits = - Connection.call_exn - connection - (Endpoint.search_subreddits_by_title_and_description () ~query:"python") - >>| Listing.children - >>| List.map ~f:Thing.Subreddit.name - in - print_s [%sexp (subreddits : Subreddit_name.t list)]; - [%expect - {| + let%bind subreddits = + Connection.call_exn + connection + (Endpoint.search_subreddits_by_title_and_description () ~query:"python") + >>| Listing.children + >>| List.map ~f:Thing.Subreddit.name + in + print_s [%sexp (subreddits : Subreddit_name.t list)]; + [%expect + {| (Python algotrading raspberry_pi montypython shittyprogramming vim MachineLearning pythontips learnpython learnprogramming snakes programmingcirclejerk ballpython ProgrammerTIL linux emacs programming datascience WTF EliteDangerous coding coolgithubprojects todayilearned gamedev HowToHack) |}]; - return ()) + return ()) ;; let%expect_test "list_subreddits" = with_cassette "list_subreddits" ~f:(fun connection -> - let%bind subreddits = - Connection.call_exn connection (Endpoint.list_subreddits () ~sort:Popular) - >>| Listing.children - >>| List.map ~f:Thing.Subreddit.name - in - print_s [%sexp (subreddits : Subreddit_name.t list)]; - [%expect - {| + let%bind subreddits = + Connection.call_exn connection (Endpoint.list_subreddits () ~sort:Popular) + >>| Listing.children + >>| List.map ~f:Thing.Subreddit.name + in + print_s [%sexp (subreddits : Subreddit_name.t list)]; + [%expect + {| (Home AskReddit PublicFreakout pics politics news worldnews funny NoStupidQuestions nextfuckinglevel leagueoflegends tifu interestingasfuck relationship_advice modernwarfare videos AnimalCrossing gaming aww todayilearned gtaonline Minecraft memes gifs Art) |}]; - return ()) + return ()) ;; diff --git a/test/test_trophies.ml b/test/test_trophies.ml index 3214140d..3072d874 100644 --- a/test/test_trophies.ml +++ b/test/test_trophies.ml @@ -4,10 +4,10 @@ open! Import let%expect_test _ = with_cassette "trophies" ~f:(fun connection -> - let%bind trophies = Connection.call_exn connection Endpoint.trophies in - print_s [%message "" (trophies : Thing.Award.t list)]; - [%expect - {| + let%bind trophies = Connection.call_exn connection Endpoint.trophies in + print_s [%message "" (trophies : Thing.Award.t list)]; + [%expect + {| (trophies (((award_id (String v)) (description (String "Since January 2021")) (granted_at (Number 1609678143)) @@ -25,19 +25,19 @@ let%expect_test _ = (icon_70 (String https://www.redditstatic.com/awards2/verified_email-70.png)) (id (String 1qr5eq)) (name (String "Verified Email")) (url Null)))) |}]; - return ()) + return ()) ;; let%expect_test _ = with_cassette "user_trophies" ~f:(fun connection -> - let%bind trophies = - Connection.call_exn - connection - (Endpoint.user_trophies ~username:(Username.of_string "spez")) - in - print_s [%message "" ~trophies:(List.take trophies 5 : Thing.Award.t list)]; - [%expect - {| + let%bind trophies = + Connection.call_exn + connection + (Endpoint.user_trophies ~username:(Username.of_string "spez")) + in + print_s [%message "" ~trophies:(List.take trophies 5 : Thing.Award.t list)]; + [%expect + {| (trophies (((award_id Null) (description Null) (granted_at (Number 1591416000)) (icon_40 @@ -68,5 +68,5 @@ let%expect_test _ = (url (String /r/announcements/comments/gxas21/upcoming_changes_to_our_content_policy_our_board/ft0ekhk/?context=5#ft0ekhk))))) |}]; - return ()) + return ()) ;; diff --git a/test/test_user_fields.ml b/test/test_user_fields.ml index 4991dce4..9de54b8a 100644 --- a/test/test_user_fields.ml +++ b/test/test_user_fields.ml @@ -4,27 +4,26 @@ open! Import let%expect_test "user_fields" = with_cassette "user_fields" ~f:(fun connection -> - let%bind user = - Connection.call_exn - connection - (Endpoint.about_user ~username:(Username.of_string "spez")) - in - print_s [%sexp (Thing.User.name user : Username.t)]; - [%expect {| spez |}]; - print_s [%sexp (Thing.User.creation_time user : Time_ns.t)]; - [%expect {| (2005-06-06 04:00:00.000000000Z) |}]; - print_s [%sexp (Thing.User.link_karma user : int)]; - [%expect {| 138988 |}]; - print_s [%sexp (Thing.User.comment_karma user : int)]; - [%expect {| 743899 |}]; - print_s [%sexp (Thing.User.awarder_karma user : int)]; - [%expect {| 625 |}]; - print_s [%sexp (Thing.User.awardee_karma user : int)]; - [%expect {| 62329 |}]; - print_s [%sexp (Thing.User.total_karma user : int)]; - [%expect {| 945841 |}]; - print_s - [%sexp (Thing.User.subreddit user |> Thing.Subreddit.name : Subreddit_name.t)]; - [%expect {| u_spez |}]; - return ()) + let%bind user = + Connection.call_exn + connection + (Endpoint.about_user ~username:(Username.of_string "spez")) + in + print_s [%sexp (Thing.User.name user : Username.t)]; + [%expect {| spez |}]; + print_s [%sexp (Thing.User.creation_time user : Time_ns.t)]; + [%expect {| (2005-06-06 04:00:00.000000000Z) |}]; + print_s [%sexp (Thing.User.link_karma user : int)]; + [%expect {| 138988 |}]; + print_s [%sexp (Thing.User.comment_karma user : int)]; + [%expect {| 743899 |}]; + print_s [%sexp (Thing.User.awarder_karma user : int)]; + [%expect {| 625 |}]; + print_s [%sexp (Thing.User.awardee_karma user : int)]; + [%expect {| 62329 |}]; + print_s [%sexp (Thing.User.total_karma user : int)]; + [%expect {| 945841 |}]; + print_s [%sexp (Thing.User.subreddit user |> Thing.Subreddit.name : Subreddit_name.t)]; + [%expect {| u_spez |}]; + return ()) ;; diff --git a/test/test_users.ml b/test/test_users.ml index c6489d72..1e6738fc 100644 --- a/test/test_users.ml +++ b/test/test_users.ml @@ -4,11 +4,11 @@ open! Import let%expect_test "user_upvoted" = with_cassette "user_upvoted" ~f:(fun connection -> - match%bind - Connection.call_exn - connection - (Endpoint.user_upvoted () ~username:(Username.of_string "spez")) - with - | `Private -> return () - | `Listing _ -> failwith "Got listing unexpectedly") + match%bind + Connection.call_exn + connection + (Endpoint.user_upvoted () ~username:(Username.of_string "spez")) + with + | `Private -> return () + | `Listing _ -> failwith "Got listing unexpectedly") ;; diff --git a/test/test_wiki_page.ml b/test/test_wiki_page.ml index 34c50511..fedb2788 100644 --- a/test/test_wiki_page.ml +++ b/test/test_wiki_page.ml @@ -7,71 +7,71 @@ let page : Wiki_page.Id.t = { subreddit = Some subreddit; page = "index" } let%expect_test "add_wiki_editor" = with_cassette "add_wiki_editor" ~f:(fun connection -> - Connection.call_exn - connection - (Endpoint.add_wiki_editor ~page ~user:(Username.of_string "L72_Elite_Kraken"))) + Connection.call_exn + connection + (Endpoint.add_wiki_editor ~page ~user:(Username.of_string "L72_Elite_Kraken"))) ;; let%expect_test "remove_wiki_editor" = with_cassette "remove_wiki_editor" ~f:(fun connection -> - Connection.call_exn - connection - (Endpoint.remove_wiki_editor ~page ~user:(Username.of_string "L72_Elite_Kraken"))) + Connection.call_exn + connection + (Endpoint.remove_wiki_editor ~page ~user:(Username.of_string "L72_Elite_Kraken"))) ;; let%expect_test "toggle_wiki_revision_visibility" = with_cassette "toggle_wiki_revision_visibility" ~f:(fun connection -> - let%bind result = - Connection.call_exn - connection - (Endpoint.toggle_wiki_revision_visibility - ~page - ~revision: - (Wiki_page.Revision.Id.of_string "8048c97c-52ba-11e7-ab00-0ad38c20ef7e")) - in - print_s [%sexp (result : [ `Became_hidden | `Became_visible ])]; - [%expect {| Became_hidden |}]; - return ()) -;; - -let%expect_test "revert_wiki_page" = - with_cassette "revert_wiki_page" ~f:(fun connection -> + let%bind result = Connection.call_exn connection - (Endpoint.revert_wiki_page + (Endpoint.toggle_wiki_revision_visibility ~page ~revision: - (Wiki_page.Revision.Id.of_string "e4d3d130-52b9-11e7-9d0c-0e1b806ed802"))) + (Wiki_page.Revision.Id.of_string "8048c97c-52ba-11e7-ab00-0ad38c20ef7e")) + in + print_s [%sexp (result : [ `Became_hidden | `Became_visible ])]; + [%expect {| Became_hidden |}]; + return ()) +;; + +let%expect_test "revert_wiki_page" = + with_cassette "revert_wiki_page" ~f:(fun connection -> + Connection.call_exn + connection + (Endpoint.revert_wiki_page + ~page + ~revision: + (Wiki_page.Revision.Id.of_string "e4d3d130-52b9-11e7-9d0c-0e1b806ed802"))) ;; let%expect_test "wiki_page_revisions" = with_cassette "wiki_page_revisions" ~f:(fun connection -> - let%bind revisions = - Connection.call_exn - connection - (Endpoint.wiki_page_revisions - ~pagination: - (After - (Listing.Page_id.of_string - "WikiRevision_bde92910-52b1-11e7-bf40-120ea8b0860a")) - ~limit:3 - () - ~page) - >>| Listing.children - in - List.iter revisions ~f:(fun revision -> - print_s - [%sexp - { author : Username.t option = - Wiki_page.Revision.author revision |> Option.map ~f:Thing.User.name - ; page_name : string = Wiki_page.Revision.page_name revision - ; id : Wiki_page.Revision.Id.t = Wiki_page.Revision.id revision - ; reason : string option = Wiki_page.Revision.reason revision - ; timestamp : Time_ns.t = Wiki_page.Revision.timestamp revision - ; hidden : bool = Wiki_page.Revision.hidden revision - }]); - [%expect - {| + let%bind revisions = + Connection.call_exn + connection + (Endpoint.wiki_page_revisions + ~pagination: + (After + (Listing.Page_id.of_string + "WikiRevision_bde92910-52b1-11e7-bf40-120ea8b0860a")) + ~limit:3 + () + ~page) + >>| Listing.children + in + List.iter revisions ~f:(fun revision -> + print_s + [%sexp + { author : Username.t option = + Wiki_page.Revision.author revision |> Option.map ~f:Thing.User.name + ; page_name : string = Wiki_page.Revision.page_name revision + ; id : Wiki_page.Revision.Id.t = Wiki_page.Revision.id revision + ; reason : string option = Wiki_page.Revision.reason revision + ; timestamp : Time_ns.t = Wiki_page.Revision.timestamp revision + ; hidden : bool = Wiki_page.Revision.hidden revision + }]); + [%expect + {| ((author (BJO_test_mod)) (page_name index) (id 7b080602-52b1-11e7-9041-0ed4553efb98) (reason ()) (timestamp (2017-06-16 16:33:08.000000000Z)) (hidden false)) @@ -81,96 +81,91 @@ let%expect_test "wiki_page_revisions" = ((author (BJO_test_mod)) (page_name index) (id 610979ca-52b1-11e7-ad39-0e1b806ed802) (reason ()) (timestamp (2017-06-16 16:32:24.000000000Z)) (hidden false)) |}]; - return ()) + return ()) ;; let%expect_test "wiki_discussions" = with_cassette "wiki_discussions" ~f:(fun connection -> - let%bind discussions = - Connection.call_exn connection (Endpoint.wiki_discussions () ~page) - >>| Listing.children - in - List.iter discussions ~f:(fun link -> - print_s [%sexp (Thing.Link.id link : Thing.Link.Id.t)]); - [%expect {| jhvugk |}]; - return ()) + let%bind discussions = + Connection.call_exn connection (Endpoint.wiki_discussions () ~page) + >>| Listing.children + in + List.iter discussions ~f:(fun link -> + print_s [%sexp (Thing.Link.id link : Thing.Link.Id.t)]); + [%expect {| jhvugk |}]; + return ()) ;; let%expect_test "wiki_pages" = with_cassette "wiki_pages" ~f:(fun connection -> - let%bind pages = - Connection.call_exn connection (Endpoint.wiki_pages () ~subreddit) - in - print_s [%sexp (pages : string list)]; - [%expect - {| + let%bind pages = Connection.call_exn connection (Endpoint.wiki_pages () ~subreddit) in + print_s [%sexp (pages : string list)]; + [%expect + {| (config/automoderator config/description config/sidebar config/stylesheet config/submit_text index praw_test_page tbsettings toolbox usernotes wiki/index) |}]; - return ()) + return ()) ;; let%expect_test "subreddit_wiki_revisions" = with_cassette "subreddit_wiki_revisions" ~f:(fun connection -> - let%bind revisions = - Connection.call_exn - connection - (Endpoint.subreddit_wiki_revisions ~subreddit ~limit:1 ()) - >>| Listing.children - in - List.iter revisions ~f:(fun revision -> - print_s - [%sexp - { author : Username.t option = - Wiki_page.Revision.author revision |> Option.map ~f:Thing.User.name - ; page_name : string = Wiki_page.Revision.page_name revision - ; id : Wiki_page.Revision.Id.t = Wiki_page.Revision.id revision - ; reason : string option = Wiki_page.Revision.reason revision - ; timestamp : Time_ns.t = Wiki_page.Revision.timestamp revision - ; hidden : bool = Wiki_page.Revision.hidden revision - }]); - [%expect - {| + let%bind revisions = + Connection.call_exn + connection + (Endpoint.subreddit_wiki_revisions ~subreddit ~limit:1 ()) + >>| Listing.children + in + List.iter revisions ~f:(fun revision -> + print_s + [%sexp + { author : Username.t option = + Wiki_page.Revision.author revision |> Option.map ~f:Thing.User.name + ; page_name : string = Wiki_page.Revision.page_name revision + ; id : Wiki_page.Revision.Id.t = Wiki_page.Revision.id revision + ; reason : string option = Wiki_page.Revision.reason revision + ; timestamp : Time_ns.t = Wiki_page.Revision.timestamp revision + ; hidden : bool = Wiki_page.Revision.hidden revision + }]); + [%expect + {| ((author (BJO_test_user)) (page_name index) (id f36c8b31-16d6-11eb-9cbb-0e03a79c97b5) (reason ("reverted back 3 years")) (timestamp (2020-10-25 15:30:02.000000000Z)) (hidden false)) |}]; - return ()) + return ()) ;; let%expect_test "wiki_permissions" = with_cassette "wiki_permissions" ~f:(fun connection -> - let%bind permissions = - Connection.call_exn connection (Endpoint.wiki_permissions ~page) - in - print_s - [%sexp - { level : Wiki_page.Permissions.Level.t = - Wiki_page.Permissions.level permissions - ; contributors : Username.t list = - Wiki_page.Permissions.contributors permissions - |> List.map ~f:Thing.User.name - ; listed : bool = Wiki_page.Permissions.listed permissions - }]; - [%expect - {| + let%bind permissions = + Connection.call_exn connection (Endpoint.wiki_permissions ~page) + in + print_s + [%sexp + { level : Wiki_page.Permissions.Level.t = Wiki_page.Permissions.level permissions + ; contributors : Username.t list = + Wiki_page.Permissions.contributors permissions |> List.map ~f:Thing.User.name + ; listed : bool = Wiki_page.Permissions.listed permissions + }]; + [%expect + {| ((level Only_approved_contributors_for_this_page) (contributors (L72_Elite_Kraken)) (listed true)) |}]; - return ()) + return ()) ;; let%expect_test "set_wiki_permissions" = with_cassette "set_wiki_permissions" ~f:(fun connection -> - let%bind permissions = - Connection.call_exn - connection - (Endpoint.set_wiki_permissions ~level:Only_moderators ~listed:true ~page) - in - print_s - [%sexp - { level : Wiki_page.Permissions.Level.t = - Wiki_page.Permissions.level permissions - ; listed : bool = Wiki_page.Permissions.listed permissions - }]; - [%expect {| ((level Only_moderators) (listed true)) |}]; - return ()) + let%bind permissions = + Connection.call_exn + connection + (Endpoint.set_wiki_permissions ~level:Only_moderators ~listed:true ~page) + in + print_s + [%sexp + { level : Wiki_page.Permissions.Level.t = Wiki_page.Permissions.level permissions + ; listed : bool = Wiki_page.Permissions.listed permissions + }]; + [%expect {| ((level Only_moderators) (listed true)) |}]; + return ()) ;;