registered printers for CCError.guard,wrap1,etc.

This commit is contained in:
Simon Cruanes 2014-07-08 00:35:48 +02:00
parent 3acffa8659
commit 01c9573ae6
4 changed files with 39 additions and 3 deletions

View file

@ -43,7 +43,20 @@ let return x = `Ok x
let fail s = `Error s 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 let map f e = match e with
| `Ok x -> `Ok (f x) | `Ok x -> `Ok (f x)

View file

@ -68,10 +68,15 @@ val fold : success:('a -> 'b) -> failure:(string -> 'b) -> 'a t -> 'b
(** {2 Wrappers} *) (** {2 Wrappers} *)
val guard : (unit -> 'a) -> 'a t 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 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 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 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 pp : 'a printer -> 'a t printer
val print : 'a formatter -> 'a t formatter 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

View file

@ -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. 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. 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), It doesn't try to do {b pretty}-printing (see for instance Pprint for this),

View file

@ -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. 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. 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), It doesn't try to do {b pretty}-printing (see for instance Pprint for this),