From 096948e71286cbfa6fdca40127ea3c4097b3013f Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 2 Oct 2015 19:39:25 +0200
Subject: [PATCH] add `CCError.of_exn_trace`

---
 src/core/CCError.ml  | 16 +++++++++++++++-
 src/core/CCError.mli |  7 +++++++
 2 files changed, 22 insertions(+), 1 deletion(-)

diff --git a/src/core/CCError.ml b/src/core/CCError.ml
index 47498964..c3b5a0f2 100644
--- a/src/core/CCError.ml
+++ b/src/core/CCError.ml
@@ -59,7 +59,7 @@ let register_printer p = _printers := p :: !_printers
 (* FIXME: just use {!Printexc.register_printer} instead? *)
 
 let of_exn e =
-  let buf = Buffer.create 15 in
+  let buf = Buffer.create 32 in
   let rec try_printers l = match l with
     | [] -> Buffer.add_string buf (Printexc.to_string e)
     | p :: l' ->
@@ -69,6 +69,20 @@ let of_exn e =
   try_printers !_printers;
   `Error (Buffer.contents buf)
 
+let of_exn_trace e =
+  let buf = Buffer.create 128 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;
+  Buffer.add_string buf "\nstack trace:\n";
+  Buffer.add_string buf
+    (Printexc.raw_backtrace_to_string (Printexc.get_raw_backtrace ()));
+  `Error (Buffer.contents buf)
+
 let map f e = match e with
   | `Ok x -> `Ok (f x)
   | `Error s -> `Error s
diff --git a/src/core/CCError.mli b/src/core/CCError.mli
index 072ecc96..5e4cda3c 100644
--- a/src/core/CCError.mli
+++ b/src/core/CCError.mli
@@ -50,6 +50,11 @@ val fail : 'err -> ('a,'err) t
 val of_exn : exn -> ('a, string) t
 (** [of_exn e] uses {!Printexc} to print the exception as a string *)
 
+val of_exn_trace : exn -> ('a, string) t
+(** [of_exn_trace e] is similar to [of_exn e], but it adds the stacktrace
+    to the error message
+    @since NEXT_RELEASE *)
+
 val fail_printf : ('a, Buffer.t, unit, ('a,string) t) format4 -> 'a
 (** [fail_printf format] uses [format] to obtain an error message
     and then returns [`Error msg]
@@ -205,3 +210,5 @@ 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
+
+(* TODO: deprecate, should use {!Printexc} *)