├── .gitignore ├── CHANGES.md ├── LICENSE ├── README.md ├── dune ├── dune-project ├── error_trace.ml ├── error_trace.mli └── error_trace.opam /.gitignore: -------------------------------------------------------------------------------- 1 | .merlin 2 | _build 3 | _opam 4 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## unreleased 2 | 3 | Initial release. 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Ahrefs 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | This is an attempt at creating an error library that allows easily to "stack" errors layer by layer by providing composable error types based on first class modules. The second goal is to be able to distinguish between "public" error values and "private" internal only errors. 2 | 3 | The idea is that each components having a consistent set of errors creates an `Error` that defines printers and a way to convert to public error. The framework then furnishes helpers to convert a trace of errors to public trace, and to display nice error messages (not yet implemented :p) 4 | 5 | the intention is to use it like this: 6 | ```ocaml 7 | module Error = StringError(struct let component = "my_request") 8 | 9 | let handle_request foo = 10 | match build_es_query foo with 11 | | Error e -> Lwt.return_error (caused_by ~cause:e (with_context StringContext foo (pure "cannot build es query"))) 12 | | Ok query -> 13 | match%lwt do_es_query query with 14 | | Ok ret -> Lwt.return_ok ret 15 | | Error e -> Lwt.return_error (caused_by ~cause:e (with_context StringContext foo (pure "failed to execute es query"))) 16 | ``` 17 | 18 | In the end the display would show : 19 | ``` 20 | failed to execute es query with caused by : 21 | request timeouted after 10s 22 | ``` 23 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name error_trace) 3 | (libraries containers devkit)) 4 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.0) 2 | -------------------------------------------------------------------------------- /error_trace.ml: -------------------------------------------------------------------------------- 1 | open Devkit 2 | open Containers 3 | 4 | module type SimpleError = sig 5 | (** The name of the error class *) 6 | val component : string 7 | 8 | type error 9 | 10 | (** Catches exn and transform it to this error type *) 11 | val of_exn : exn -> error 12 | 13 | (** Display errors in human readable form *) 14 | val show : Format.formatter -> error -> unit 15 | end 16 | 17 | module type Error = sig 18 | include SimpleError 19 | 20 | module Public : SimpleError 21 | 22 | val to_public_error : error -> Public.error option 23 | end 24 | 25 | module PublicError (E : SimpleError) = struct 26 | include E 27 | module Public = E 28 | 29 | let to_public_error e = Some e 30 | end 31 | 32 | module PrivateError (E : SimpleError) = struct 33 | include E 34 | module Public = E 35 | 36 | let to_public_error _e = None 37 | end 38 | 39 | module StringError (C : sig 40 | val component : string 41 | end) = 42 | struct 43 | include C 44 | 45 | type error = string 46 | 47 | let of_exn = Exn.to_string 48 | 49 | let show = Format.string 50 | end 51 | 52 | module type Context = sig 53 | type context 54 | 55 | (** Display context in human readable form *) 56 | val show : Format.formatter -> context -> unit 57 | 58 | (** Display the context in a way that is suitable for public use *) 59 | val show_public : Format.formatter -> context -> unit 60 | end 61 | 62 | module type ErrorWithContext = sig 63 | include Error 64 | 65 | module Context : Context 66 | end 67 | 68 | type error_context = 69 | | Context : { 70 | context : 'context; 71 | context_kind : (module Context with type context = 'context); 72 | } 73 | -> error_context 74 | 75 | type ('error, 'public) t = { 76 | error : 'error; 77 | kind : (module Error with type error = 'error and type Public.error = 'public); 78 | context : error_context option; 79 | cause : any_error option; 80 | } 81 | 82 | and any_error = AnyError : ('error, 'public) t -> any_error 83 | 84 | (** {3 Core error api } *) 85 | 86 | let pure (type e public) (module E : Error with type error = e and type Public.error = public) e = 87 | { error = e; kind = (module E); cause = None; context = None } 88 | 89 | let as_error e = e.error 90 | 91 | let of_exn (type e public) (module E : Error with type error = e and type Public.error = public) exn = 92 | pure (module E) (E.of_exn exn) 93 | 94 | let context (type ctx) (module Ctx : Context with type context = ctx) context e = 95 | { e with context = Some (Context { context; context_kind = (module Ctx) }) } 96 | 97 | let caused_by ~cause e = { e with cause = Some (AnyError cause) } 98 | 99 | (** {3 high level api } *) 100 | 101 | let with_context (type ctx) (module Ctx : Context with type context = ctx) c r = 102 | Result.map_err (context (module Ctx) c) r 103 | 104 | let error (type e public) (module E : Error with type error = e and type Public.error = public) ?cause e = 105 | pure (module E) e |> Option.map_or ~default:id (fun cause -> caused_by ~cause) cause 106 | 107 | let with_error (type e public) (module E : Error with type error = e and type Public.error = public) ?cause r = 108 | Result.map_err (error (module E) ?cause) r 109 | 110 | let guard_result (type e public) (module E : Error with type error = e and type Public.error = public) ?cause f = 111 | Result.guard (fun () -> f () |> Result.map_err (error (module E) ?cause)) 112 | |> Result.map_err (error (module E) ?cause $ E.of_exn) 113 | |> Result.join 114 | 115 | let guard_exn (type e public) (module E : Error with type error = e and type Public.error = public) ?cause f = 116 | Result.guard f |> Result.map_err (error (module E) ?cause $ E.of_exn) 117 | 118 | let bubble_error e r = Result.map_err (fun cause -> caused_by ~cause e) r 119 | 120 | let rec cause_to_public = function 121 | | AnyError cause -> 122 | let module Cause = (val cause.kind) in 123 | ( match to_public_error cause with 124 | | None -> None 125 | | Some cause -> Some (AnyError cause) 126 | ) 127 | 128 | and to_public_error : type e public. (e, public) t -> (public, public) t option = 129 | fun e -> 130 | let module E = (val e.kind : Error with type error = e and type Public.error = public) in 131 | let error = E.to_public_error e.error in 132 | match error with 133 | | None -> None 134 | | Some error -> 135 | match e.cause with 136 | | None -> Some { error; cause = None; context = e.context; kind = (module PublicError (E.Public)) } 137 | | Some cause -> 138 | let cause = cause_to_public cause in 139 | Some { error; cause; context = e.context; kind = (module PublicError (E.Public)) } 140 | 141 | let backtrace e = 142 | let rec to_list acc = function 143 | | Some cause -> to_list (cause :: acc) e.cause 144 | | None -> acc 145 | in 146 | to_list [] e.cause 147 | 148 | type ('a, 'b) error = ('a, 'b) t 149 | 150 | include struct 151 | open Format 152 | 153 | let show_error (type e public) out (e : (e, public) error) = 154 | let module E = (val e.kind : Error with type error = e and type Public.error = public) in 155 | E.show out (as_error e) 156 | 157 | let show_any_error out = function 158 | | AnyError e -> show_error out e 159 | 160 | let show_compact out e = 161 | pp_open_hbox out (); 162 | hbox show_error out e; 163 | fprintf out "@ caused by:@ "; 164 | hbox (list ~sep:(const string "@ ↣ ") show_any_error) out (List.rev (backtrace e)); 165 | pp_close_box out () 166 | 167 | let show_verbose out e = 168 | pp_open_box out 0; 169 | hbox show_error out e; 170 | fprintf out "@,caused by:@,"; 171 | vbox ~i:2 (list ~sep:(const string "@,↳ ") show_any_error) out (List.rev (backtrace e)); 172 | pp_close_box out () 173 | 174 | let to_string_verbose e = to_string show_verbose e 175 | 176 | let to_string e = to_string show_compact e 177 | end 178 | 179 | module Make (E : Error) = struct 180 | let pure e = pure (module E) e 181 | 182 | let as_error e = as_error e 183 | 184 | let of_exn e = of_exn (module E) e 185 | 186 | let caused_by ~cause e = caused_by ~cause e 187 | 188 | let error ?cause e = error (module E) ?cause e 189 | 190 | let with_error ?cause r = with_error (module E) ?cause r 191 | 192 | let guard_result ?cause f = guard_result (module E) ?cause f 193 | 194 | let guard_exn ?cause f = guard_exn (module E) ?cause f 195 | end 196 | 197 | module MakeContext (E : ErrorWithContext) = struct 198 | include Make (E) 199 | 200 | let context ctx e = context (module E.Context) ctx e 201 | 202 | let with_context c r = with_context (module E.Context) c r 203 | end 204 | -------------------------------------------------------------------------------- /error_trace.mli: -------------------------------------------------------------------------------- 1 | (** {2 Functors types to construct error value implementations } *) 2 | module type SimpleError = sig 3 | (** The name of the error class *) 4 | val component : string 5 | 6 | type error 7 | 8 | (** Catches exn and transform it to this error type *) 9 | val of_exn : exn -> error 10 | 11 | (** Display errors in human readable form *) 12 | val show : Format.formatter -> error -> unit 13 | end 14 | 15 | module type Error = sig 16 | include SimpleError 17 | 18 | module Public : SimpleError 19 | 20 | (** Convert private error to a suitble reprensation to be sent to external world *) 21 | val to_public_error : error -> Public.error option 22 | end 23 | 24 | (** An error type that is public *) 25 | module PublicError (E : SimpleError) : Error with type error = E.error and type Public.error = E.error 26 | 27 | (** An error type that should not be exposed to public and would be removed *) 28 | module PrivateError (E : SimpleError) : Error with type error = E.error and type Public.error = E.error 29 | 30 | (** Errors representated as human readable strings *) 31 | module StringError (C : sig 32 | val component : string 33 | end) : SimpleError with type error = string 34 | 35 | (** Context specific value to add to error messages, like actual request url, or database address *) 36 | module type Context = sig 37 | type context 38 | 39 | (** Display context in human readable form *) 40 | val show : Format.formatter -> context -> unit 41 | 42 | (** Display the context in a way that is suitable for public use *) 43 | val show_public : Format.formatter -> context -> unit 44 | end 45 | 46 | (** {2 Main error types } *) 47 | module type ErrorWithContext = sig 48 | include Error 49 | 50 | module Context : Context 51 | end 52 | 53 | (** Error values *) 54 | type ('error, 'public) t 55 | 56 | type any_error = AnyError : ('error, 'public) t -> any_error 57 | 58 | (** {2 Generic api to construct errors } *) 59 | 60 | (** {3 Core error api } *) 61 | 62 | (** Wraps an error value into an error *) 63 | val pure : (module Error with type error = 'error and type Public.error = 'public) -> 'error -> ('error, 'public) t 64 | 65 | (** Unwraps the error value contained in the error *) 66 | val as_error : ('error, _) t -> 'error 67 | 68 | (** Constructs an error from an exception *) 69 | val of_exn : (module Error with type error = 'error and type Public.error = 'public) -> exn -> ('error, 'public) t 70 | 71 | (** Adds a context value to an error *) 72 | val context : (module Context with type context = 'ctx) -> 'ctx -> ('error, 'public) t -> ('error, 'public) t 73 | 74 | (** Adds and wraps an error as cause of the error *) 75 | val caused_by : cause:(_, _) t -> ('error, 'public) t -> ('error, 'public) t 76 | 77 | (** {3 high level api } *) 78 | 79 | (** Wraps an error value into an error and an optional cause *) 80 | val error 81 | : (module Error with type error = 'error and type Public.error = 'public) -> 82 | ?cause:(_, _) t -> 83 | 'error -> 84 | ('error, 'public) t 85 | 86 | (** Wraps an error value into an error and an optional cause from a result value 87 | [with_error (module E) ?cause r] is [Result.map_err (error (module E) ?cause) r] *) 88 | val with_error 89 | : (module Error with type error = 'error and type Public.error = 'public) -> 90 | ?cause:(_, _) t -> 91 | ('ok, 'error) result -> 92 | ('ok, ('error, 'public) t) result 93 | 94 | (** Adds a context value to a result when the result is an error. 95 | [with_context (module C) ctx r] is [Result.map_err (context (module C) ctx)] *) 96 | val with_context 97 | : (module Context with type context = 'ctx) -> 98 | 'ctx -> 99 | ('ok, ('error, 'public) t) result -> 100 | ('ok, ('error, 'public) t) result 101 | 102 | (** [guard_result (module E) ?cause f] runs f and catches exceptions. 103 | Exn is converted to an error using [E.of_exn] and return [result] of [f] is converted to an error trace result *) 104 | val guard_result 105 | : (module Error with type error = 'error and type Public.error = 'public) -> 106 | ?cause:(_, _) t -> 107 | (unit -> ('ok, 'error) result) -> 108 | ('ok, ('error, 'public) t) result 109 | 110 | (** [guard_exn (module E) ?cause f] runs f and catches exceptions. 111 | Exn is converted to an error using [E.of_exn] *) 112 | val guard_exn 113 | : (module Error with type error = 'error and type Public.error = 'public) -> 114 | ?cause:(_, _) t -> 115 | (unit -> 'ok) -> 116 | ('ok, ('error, 'public) t) result 117 | 118 | (** [bubble_error e r] wraps error case of [r] as cause of error [e] in case [r] is an [Error] *) 119 | val bubble_error : ('error, 'public) t -> ('ok, (_, _) t) result -> ('ok, ('error, 'public) t) result 120 | 121 | (** {2 Transformations on error traces *) 122 | 123 | (** Constructs the backtraces of all causes *) 124 | val backtrace : (_, _) t -> any_error list 125 | 126 | (** Recursively cleans error trace from any sensitive data and simplify it to public type *) 127 | val to_public_error : ('e, 'public) t -> ('public, 'public) t option 128 | 129 | (** {2 Display error messages } *) 130 | 131 | (** Displays error as single line *) 132 | val show_compact : Format.formatter -> (_, _) t -> unit 133 | 134 | (** Displays error as multi line *) 135 | val show_verbose : Format.formatter -> (_, _) t -> unit 136 | 137 | (** display human readable string of error *) 138 | val to_string : (_, _) t -> string 139 | 140 | (** display verbose human readable string of error *) 141 | val to_string_verbose : (_, _) t -> string 142 | 143 | (** {2 Instanciated api for convenience } *) 144 | 145 | module Make (E : Error) : sig 146 | val pure : E.error -> (E.error, E.Public.error) t 147 | 148 | val as_error : ('a, 'b) t -> 'a 149 | 150 | val of_exn : exn -> (E.error, E.Public.error) t 151 | 152 | val caused_by : cause:('a, 'b) t -> (E.error, E.Public.error) t -> (E.error, E.Public.error) t 153 | 154 | val error : ?cause:('a, 'b) t -> E.error -> (E.error, E.Public.error) t 155 | 156 | val with_error : ?cause:('a, 'b) t -> ('ok, E.error) result -> ('ok, (E.error, E.Public.error) t) result 157 | 158 | val guard_result : ?cause:(_, _) t -> (unit -> ('ok, E.error) result) -> ('ok, (E.error, E.Public.error) t) result 159 | 160 | val guard_exn : ?cause:(_, _) t -> (unit -> 'ok) -> ('ok, (E.error, E.Public.error) t) result 161 | end 162 | 163 | module MakeContext (E : ErrorWithContext) : sig 164 | val pure : E.error -> (E.error, E.Public.error) t 165 | 166 | val as_error : ('a, 'b) t -> 'a 167 | 168 | val of_exn : exn -> (E.error, E.Public.error) t 169 | 170 | val caused_by : cause:('a, 'b) t -> (E.error, E.Public.error) t -> (E.error, E.Public.error) t 171 | 172 | val error : ?cause:('a, 'b) t -> E.error -> (E.error, E.Public.error) t 173 | 174 | val with_error : ?cause:('a, 'b) t -> ('ok, E.error) result -> ('ok, (E.error, E.Public.error) t) result 175 | 176 | val guard_result : ?cause:(_, _) t -> (unit -> ('ok, E.error) result) -> ('ok, (E.error, E.Public.error) t) result 177 | 178 | val guard_exn : ?cause:(_, _) t -> (unit -> 'ok) -> ('ok, (E.error, E.Public.error) t) result 179 | 180 | val context : E.Context.context -> (E.error, E.Public.error) t -> (E.error, E.Public.error) t 181 | 182 | val with_context 183 | : E.Context.context -> 184 | ('ok, (E.error, E.Public.error) t) result -> 185 | ('ok, (E.error, E.Public.error) t) result 186 | end 187 | -------------------------------------------------------------------------------- /error_trace.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "joris.giovannangeli@ahrefs.com" 3 | authors: "Ahrefs " 4 | license: "MIT" 5 | homepage: "https://github.com/ahrefs/error_trace" 6 | dev-repo: "git+https://github.com/ahrefs/error_trace.git" 7 | bug-reports: "https://github.com/ahrefs/error_trace/issues" 8 | synopsis: "Generic error framework" 9 | build: [ 10 | ["dune" "subst"] {pinned} 11 | ["dune" "build" "-p" name "-j" jobs "@install" "@runtest"{with-test} "@doc"{with-doc}] 12 | ] 13 | depends: [ 14 | "ocaml" {>= "4.05.0"} 15 | "dune" {>= "2.0"} 16 | "containers" 17 | "devkit" 18 | "odoc" {with-doc} 19 | ] 20 | --------------------------------------------------------------------------------