My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** JSON API Helpers for Requests *)
2
3(** {1 Response Helpers} *)
4
5let read_body response = Requests.Response.body response |> Eio.Flow.read_all
6
7let check_2xx response =
8 let status = Requests.Response.status_code response in
9 let body = read_body response in
10 if status >= 200 && status < 300 then Ok body
11 else Error (status, body)
12
13let check_ok response =
14 let status = Requests.Response.status_code response in
15 let body = read_body response in
16 if status = 200 then Ok body
17 else Error (status, body)
18
19(** {1 Request Helpers with Status Checking} *)
20
21let get_result session url =
22 try
23 let response = Requests.get session url in
24 check_2xx response
25 with exn ->
26 Error (0, Printexc.to_string exn)
27
28(** {1 JSON Helpers} *)
29
30let parse_json parser body_str =
31 Ezjsonm.from_string body_str |> parser
32
33let parse_json_result parser body_str =
34 try Ok (parse_json parser body_str)
35 with exn -> Error (Printexc.to_string exn)
36
37let get_json_exn session url parser =
38 let response = Requests.get session url in
39 let status = Requests.Response.status_code response in
40 if status < 200 || status >= 300 then
41 failwith (Printf.sprintf "HTTP %d" status);
42 read_body response |> parse_json parser
43
44let get_json session url parser =
45 match get_result session url with
46 | Ok body ->
47 (match parse_json_result parser body with
48 | Ok result -> Ok result
49 | Error msg -> Error (`Json_error msg))
50 | Error (status, body) -> Error (`Http (status, body))
51
52let post_json session url json_value =
53 let body_str = Ezjsonm.value_to_string json_value in
54 let body = Requests.Body.of_string Requests.Mime.json body_str in
55 Requests.post session url ~body
56
57let post_json_exn session url json_value =
58 let response = post_json session url json_value in
59 let status = Requests.Response.status_code response in
60 if status < 200 || status >= 300 then
61 failwith (Printf.sprintf "HTTP %d" status);
62 read_body response
63
64let post_json_result session url json_value =
65 try
66 let response = post_json session url json_value in
67 check_2xx response
68 with exn ->
69 Error (0, Printexc.to_string exn)
70
71(** {1 URL Helpers} *)
72
73let ( / ) base path =
74 (* Handle trailing slash in base and leading slash in path *)
75 let base = if String.ends_with ~suffix:"/" base then String.sub base 0 (String.length base - 1) else base in
76 let path = if String.starts_with ~prefix:"/" path then String.sub path 1 (String.length path - 1) else path in
77 base ^ "/" ^ path
78
79let make_url = ( / )
80
81(** {1 Let Syntax for Composition} *)
82
83module Syntax = struct
84 let ( let* ) x f = Result.bind x f
85 let ( let+ ) x f = Result.map f x
86 let ( and* ) a b = match a, b with
87 | Ok a, Ok b -> Ok (a, b)
88 | Error e, _ | _, Error e -> Error e
89 let ( and+ ) = ( and* )
90end
91
92(** {1 Convenience Combinators} *)
93
94let or_fail = function
95 | Ok x -> x
96 | Error (`Http (code, msg)) ->
97 failwith (Printf.sprintf "HTTP %d: %s" code msg)
98 | Error (`Json_error msg) ->
99 failwith (Printf.sprintf "JSON error: %s" msg)
100
101let or_fail_with prefix = function
102 | Ok x -> x
103 | Error (`Http (code, msg)) ->
104 failwith (Printf.sprintf "%s: HTTP %d: %s" prefix code msg)
105 | Error (`Json_error msg) ->
106 failwith (Printf.sprintf "%s: JSON error: %s" prefix msg)