a database layer insipred by caqti and ecto
gdiazlo.tngl.sh
1type db_error =
2 | Connection_failed of string
3 | Query_failed of string
4 | Constraint_violation of { constraint_name : string; message : string }
5 | Not_found
6 | Multiple_results_found
7 | Transaction_failed of string
8 | Migration_failed of { version : int64; message : string }
9 | Validation_failed of string list
10 | Pool_exhausted
11 | Timeout
12
13type validation_error = {
14 field : string;
15 message : string;
16 validation : string;
17}
18
19type 'a db_result = ('a, db_error) result
20type 'a changeset_result = ('a, validation_error list) result
21
22let pp_db_error fmt = function
23 | Connection_failed msg -> Format.fprintf fmt "Connection failed: %s" msg
24 | Query_failed msg -> Format.fprintf fmt "Query failed: %s" msg
25 | Constraint_violation { constraint_name; message } ->
26 Format.fprintf fmt "Constraint violation (%s): %s" constraint_name message
27 | Not_found -> Format.fprintf fmt "Record not found"
28 | Multiple_results_found ->
29 Format.fprintf fmt "Expected one result, got multiple"
30 | Transaction_failed msg -> Format.fprintf fmt "Transaction failed: %s" msg
31 | Migration_failed { version; message } ->
32 Format.fprintf fmt "Migration %Ld failed: %s" version message
33 | Validation_failed msgs ->
34 Format.fprintf fmt "Validation failed: %s" (String.concat "; " msgs)
35 | Pool_exhausted -> Format.fprintf fmt "Connection pool exhausted"
36 | Timeout -> Format.fprintf fmt "Operation timed out"
37
38let pp_validation_error fmt { field; message; validation } =
39 Format.fprintf fmt "%s: %s (%s)" field message validation
40
41let show_db_error err = Format.asprintf "%a" pp_db_error err
42let show_validation_error err = Format.asprintf "%a" pp_validation_error err