Source file error.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
(** Polymorphic error types for composable error handling.

    This module provides extensible error types using polymorphic variants,
    allowing different parts of the codebase to define their own error cases
    while maintaining composability. *)

(** {1 Base Error Types} *)

type http_error = { status : int; body : string; message : string }
(** HTTP-related errors. *)

type parse_error = { context : string; message : string }
(** JSON parsing errors. *)

type network_error = { message : string }
(** Network/connection errors. *)

type rate_limit_error = { retry_after : float; route_key : string }
(** Rate limiting errors. *)

(** {1 Polymorphic Error Variants} *)

type http_errors =
  [ `Http_error of http_error
  | `Parse_error of parse_error
  | `Network_error of network_error ]
(** Core HTTP client errors. *)

type rate_limit_errors = [ `Rate_limited of rate_limit_error ]
(** Rate limiting errors. *)

type api_errors = [ http_errors | rate_limit_errors ]
(** All API errors (HTTP + rate limiting). *)

(** {1 Error Constructors} *)

let http_error ~status ~body ~message : [> `Http_error of http_error ] =
  `Http_error { status; body; message }

let parse_error ~context ~message : [> `Parse_error of parse_error ] =
  `Parse_error { context; message }

let network_error ~message : [> `Network_error of network_error ] =
  `Network_error { message }

let rate_limited ~retry_after ~route_key : [> `Rate_limited of rate_limit_error ]
    =
  `Rate_limited { retry_after; route_key }

(** {1 Error Formatting} *)

let http_error_to_string { status; message; _ } =
  Printf.sprintf "HTTP %d: %s" status message

let parse_error_to_string { context; message } =
  Printf.sprintf "Parse error in %s: %s" context message

let network_error_to_string { message } =
  Printf.sprintf "Network error: %s" message

let rate_limit_error_to_string { retry_after; route_key } =
  Printf.sprintf "Rate limited on %s, retry after %.2fs" route_key retry_after

(** Convert HTTP errors to string. *)
let http_errors_to_string : http_errors -> string = function
  | `Http_error e -> http_error_to_string e
  | `Parse_error e -> parse_error_to_string e
  | `Network_error e -> network_error_to_string e

(** Convert API errors (including rate limiting) to string. *)
let api_errors_to_string : api_errors -> string = function
  | `Http_error e -> http_error_to_string e
  | `Parse_error e -> parse_error_to_string e
  | `Network_error e -> network_error_to_string e
  | `Rate_limited e -> rate_limit_error_to_string e

(** {1 Pretty Printers} *)

let pp_http_errors fmt e = Format.fprintf fmt "%s" (http_errors_to_string e)
let pp_api_errors fmt e = Format.fprintf fmt "%s" (api_errors_to_string e)

(** {1 Error Parsing Helpers} *)

(** Parse an HTTP error response body to extract error message. *)
let parse_http_error ~status body =
  let message =
    try
      let json = Yojson.Safe.from_string body in
      match json with
      | `Assoc fields -> (
          match List.assoc_opt "error" fields with
          | Some (`String msg) -> msg
          | _ -> body)
      | _ -> body
    with _ -> body
  in
  http_error ~status ~body ~message

(** {1 Result Helpers} *)

(** Map over the error type of a result. *)
let map_error f = function Ok x -> Ok x | Error e -> Error (f e)

(** Lift an http_errors result to an api_errors result. *)
let lift_http_error : ('a, http_errors) result -> ('a, [> http_errors ]) result
    =
 fun r -> map_error (fun e -> (e :> api_errors)) r