diff --git a/core/CCError.ml b/core/CCError.ml index 9fe54a90..fe1fdd86 100644 --- a/core/CCError.ml +++ b/core/CCError.ml @@ -43,7 +43,20 @@ let return x = `Ok x let fail s = `Error s -let of_exn e = `Error (Printexc.to_string e) +let _printers = ref [] + +let register_printer p = _printers := p :: !_printers + +let of_exn e = + let buf = Buffer.create 15 in + let rec try_printers l = match l with + | [] -> Buffer.add_string buf (Printexc.to_string e) + | p :: l' -> + try p buf e + with _ -> try_printers l' + in + try_printers !_printers; + `Error (Buffer.contents buf) let map f e = match e with | `Ok x -> `Ok (f x) diff --git a/core/CCError.mli b/core/CCError.mli index 7504356f..ab850d9a 100644 --- a/core/CCError.mli +++ b/core/CCError.mli @@ -68,10 +68,15 @@ val fold : success:('a -> 'b) -> failure:(string -> 'b) -> 'a t -> 'b (** {2 Wrappers} *) val guard : (unit -> 'a) -> 'a t +(** [guard f] runs [f ()] and returns its result wrapped in [`Ok]. If + [f ()] raises some exception [e], then it fails with [`Error msg] + where [msg] is some printing of [e] (see {!register_printer}). *) val wrap1 : ('a -> 'b) -> 'a -> 'b t +(** Same as {!guard} but gives the function one argument. *) val wrap2 : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c t +(** Same as {!guard} but gives the function two arguments. *) val wrap3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> 'd t @@ -130,3 +135,21 @@ val to_seq : 'a t -> 'a sequence val pp : 'a printer -> 'a t printer val print : 'a formatter -> 'a t formatter + +(** {2 Global Exception Printers} + +One can register exception printers here, so they will be used by {!guard}, +{!wrap1}, etc. The printers should succeed (print) on exceptions they +can deal with, and re-raise the exception otherwise. For instance +if I register a printer for [Not_found], it could look like: + +{[CCError.register_printer + (fun buf exn -> match exn with + | Not_found -> Buffer.add_string buf "Not_found" + | _ -> raise exn + );; +]} +This way a printer that doesn't know how to deal with an exception will +let other printers do it. *) + +val register_printer : exn printer -> unit diff --git a/core/CCPrint.ml b/core/CCPrint.ml index b315b915..b8e8851f 100644 --- a/core/CCPrint.ml +++ b/core/CCPrint.ml @@ -24,7 +24,7 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) -(** {1 GADT Description of Printers} +(** {1 Printer Combinators} This module provides combinators to build printers for user-defined types. It doesn't try to do {b pretty}-printing (see for instance Pprint for this), diff --git a/core/CCPrint.mli b/core/CCPrint.mli index 31c8de6e..a54f3cb8 100644 --- a/core/CCPrint.mli +++ b/core/CCPrint.mli @@ -24,7 +24,7 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) -(** {1 GADT Description of Printers} +(** {1 Printer Combinators} This module provides combinators to build printers for user-defined types. It doesn't try to do {b pretty}-printing (see for instance Pprint for this),