simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2026-01-21 16:56:39 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

remove poly-variant based errors, use result everywhere

Browse source
This commit is contained in:
Simon Cruanes 2016-11-03 18:33:34 +01:00
parent 7628e654f7
commit 5288713b76
9 changed files with 20 additions and 512 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
README.adoc
View file

@ -101,9 +101,10 @@ sequence:: `'a sequence = (unit -> 'a) -> unit` is also an iterator type.
It is easier to define on data structures than `gen`, but it a bit less
powerful. The opam library https://github.com/c-cube/sequence[sequence]
can be used to consume and produce values of this type.
error:: `'a or_error = [`Error of string | `Ok of 'a]` is a error type
that is used in other libraries, too. The reference module in containers
is `CCError`.
error:: (DEPRECATED) `'a or_error = [`Error of string | `Ok of 'a]` is a error type
that is used in other libraries, too. It is now deprecated and
replaced with `('a, string) Result.result`, supported in
`CCResult`.
klist:: `'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]` is a lazy list
without memoization, used as a persistent iterator. The reference
module is `CCKList` (in `containers.iter`).
@ -135,7 +136,7 @@ Documentation http://cedeela.fr/~simon/software/containers[here].
- `CCOrd` (combinators for total orderings)
- `CCRandom` (combinators for random generators)
- `CCHash` (hashing combinators)
- `CCError` (monadic error handling, very useful)
- `CCResult` (monadic error handling, very useful)
- `CCIO`, basic utilities for IO (channels, files)
- `CCInt64,` utils for `int64`
- `CCChar`, utils for `char`
@ -221,7 +222,7 @@ The library has moved to https://github.com/c-cube/containers-misc .
== Documentation
In general, see http://c-cube.github.io/ocaml-containers/ or
In general, see http://c-cube.github.io/ocaml-containers/ or
http://cedeela.fr/~simon/software/containers
by version:

4
_oasis
View file

@ -38,7 +38,7 @@ Flag "bench"
Library "containers"
Path: src/core
Modules: CCVector, CCError, CCHeap, CCList, CCOpt, CCPair,
Modules: CCVector, CCHeap, CCList, CCOpt, CCPair,
CCFun, CCHash, CCInt, CCBool, CCFloat, CCArray, CCRef, CCSet,
CCOrd, CCRandom, CCString, CCHashtbl, CCMap, CCFormat, CCIO,
CCInt64, CCChar, CCResult, Containers
@ -48,7 +48,7 @@ Library "containers"
Library "containers_unix"
Path: src/unix
Modules: CCUnix
BuildDepends: bytes, unix
BuildDepends: bytes, result, unix
FindlibParent: containers
FindlibName: unix

1
doc/intro.txt
View file

@ -28,7 +28,6 @@ by ocamlfind).
CCArray
CCBool
CCChar
CCError
CCFloat
CCFun
CCFormat

273
src/core/CCError.ml
View file

@ -1,273 +0,0 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Error Monad} *)
type 'a sequence = ('a -> unit) -> unit
type 'a equal = 'a -> 'a -> bool
type 'a ord = 'a -> 'a -> int
type 'a printer = Buffer.t -> 'a -> unit
type 'a formatter = Format.formatter -> 'a -> unit
(** {2 Basics} *)
type (+'good, +'bad) t =
[ `Ok of 'good
| `Error of 'bad
]
let return x = `Ok x
let fail s = `Error s
(* TODO: optional argument for printing stacktrace? *)
let fail_printf format =
let buf = Buffer.create 16 in
Printf.kbprintf
(fun buf -> fail (Buffer.contents buf))
buf format
(* TODO: easy ways to print backtrace/stack *)
let _printers = ref []
let register_printer p = _printers := p :: !_printers
(* FIXME: just use {!Printexc.register_printer} instead? *)
let of_exn e =
let buf = Buffer.create 32 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 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_char buf '\n';
Buffer.add_string buf (Printexc.get_backtrace ());
`Error (Buffer.contents buf)
let map f e = match e with
| `Ok x -> `Ok (f x)
| `Error s -> `Error s
let map_err f e = match e with
| `Ok _ as res -> res
| `Error y -> `Error (f y)
let map2 f g e = match e with
| `Ok x -> `Ok (f x)
| `Error s -> `Error (g s)
let iter f e = match e with
| `Ok x -> f x
| `Error _ -> ()
let get_exn = function
| `Ok x -> x
| `Error _ -> raise (Invalid_argument "CCError.get_exn")
let catch e ~ok ~err = match e with
| `Ok x -> ok x
| `Error y -> err y
let flat_map f e = match e with
| `Ok x -> f x
| `Error s -> `Error s
let (>|=) e f = map f e
let (>>=) e f = flat_map f e
let equal ?(err=Pervasives.(=)) eq a b = match a, b with
| `Ok x, `Ok y -> eq x y
| `Error s, `Error s' -> err s s'
| _ -> false
let compare ?(err=Pervasives.compare) cmp a b = match a, b with
| `Ok x, `Ok y -> cmp x y
| `Ok _, _ -> 1
| _, `Ok _ -> -1
| `Error s, `Error s' -> err s s'
let fold ~success ~failure x = match x with
| `Ok x -> success x
| `Error s -> failure s
(** {2 Wrappers} *)
let guard f =
try `Ok (f ())
with e -> `Error e
let guard_str f =
try `Ok (f())
with e -> of_exn e
let guard_str_trace f =
try `Ok (f())
with e -> of_exn_trace e
let wrap1 f x =
try return (f x)
with e -> `Error e
let wrap2 f x y =
try return (f x y)
with e -> `Error e
let wrap3 f x y z =
try return (f x y z)
with e -> `Error e
(** {2 Applicative} *)
let pure = return
let (<*>) f x = match f with
| `Error s -> fail s
| `Ok f -> map f x
let join t = match t with
| `Ok (`Ok o) -> `Ok o
| `Ok (`Error e) -> `Error e
| (`Error _) as e -> e
let both x y =
match x,y with
| `Ok o, `Ok o' -> `Ok (o, o')
| `Ok _, `Error e -> `Error e
| `Error e, _ -> `Error e
(** {2 Collections} *)
let map_l f l =
let rec map acc l = match l with
| [] -> `Ok (List.rev acc)
| x::l' ->
match f x with
| `Error s -> `Error s
| `Ok y -> map (y::acc) l'
in map [] l
exception LocalExit
let fold_seq f acc seq =
let err = ref None in
try
let acc = ref acc in
seq
(fun x -> match f !acc x with
| `Error s -> err := Some s; raise LocalExit
| `Ok y -> acc := y
);
`Ok !acc
with LocalExit ->
match !err with None -> assert false | Some s -> `Error s
let fold_l f acc l = fold_seq f acc (fun k -> List.iter k l)
(** {2 Misc} *)
let choose l =
let rec _find = function
| [] -> raise Not_found
| ((`Ok _) as res) :: _ -> res
| (`Error _) :: l' -> _find l'
in
try _find l
with Not_found ->
let l' = List.map (function `Error s -> s | `Ok _ -> assert false) l in
`Error l'
let retry n f =
let rec retry n acc = match n with
| 0 -> fail (List.rev acc)
| _ ->
match f () with
| `Ok _ as res -> res
| `Error e -> retry (n-1) (e::acc)
in retry n []
(** {2 Infix} *)
module Infix = struct
let (>>=) = (>>=)
let (>|=) = (>|=)
let (<*>) = (<*>)
end
(** {2 Monadic Operations} *)
module type MONAD = sig
type 'a t
val return : 'a -> 'a t
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
end
module Traverse(M : MONAD) = struct
let (>>=) = M.(>>=)
let map_m f e = match e with
| `Error s -> M.return (`Error s)
| `Ok x -> f x >>= fun y -> M.return (`Ok y)
let sequence_m m = map_m (fun x->x) m
let fold_m f acc e = match e with
| `Error _ -> M.return acc
| `Ok x -> f acc x >>= fun y -> M.return y
let retry_m n f =
let rec retry n acc = match n with
| 0 -> M.return (fail (List.rev acc))
| _ ->
f () >>= function
| `Ok x -> M.return (`Ok x)
| `Error e -> retry (n-1) (e::acc)
in retry n []
end
(** {2 Conversions} *)
let to_opt = function
| `Ok x -> Some x
| `Error _ -> None
let of_opt = function
| None -> `Error "of_opt"
| Some x -> `Ok x
let to_seq e k = match e with
| `Ok x -> k x
| `Error _ -> ()
(** {2 IO} *)
let pp pp_x buf e = match e with
| `Ok x -> Printf.bprintf buf "ok(%a)" pp_x x
| `Error s -> Printf.bprintf buf "error(%s)" s
let pp' pp_x pp_e buf e = match e with
| `Ok x -> Printf.bprintf buf "ok(%a)" pp_x x
| `Error s -> Printf.bprintf buf "error(%a)" pp_e s
let print pp_x fmt e = match e with
| `Ok x -> Format.fprintf fmt "@[ok(@,%a)@]" pp_x x
| `Error s -> Format.fprintf fmt "@[error(@,%s)@]" s
let print' pp_x pp_e fmt e = match e with
| `Ok x -> Format.fprintf fmt "@[ok(@,%a)@]" pp_x x
| `Error s -> Format.fprintf fmt "@[error(@,%a)@]" pp_e s

221
src/core/CCError.mli
View file

@ -1,221 +0,0 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Error Monad}
The variant is polymorphic in the error type
@since 0.5 *)
type 'a sequence = ('a -> unit) -> unit
type 'a equal = 'a -> 'a -> bool
type 'a ord = 'a -> 'a -> int
type 'a printer = Buffer.t -> 'a -> unit
type 'a formatter = Format.formatter -> 'a -> unit
(** {2 Basics} *)
type (+'good, +'bad) t =
[ `Ok of 'good
| `Error of 'bad
]
val return : 'a -> ('a,'err) t
(** Successfully return a value *)
val fail : 'err -> ('a,'err) t
(** Fail with an error *)
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.
Remember to call [Printexc.record_backtrace true] and compile with the
debug flag for this to work.
@since 0.14 *)
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]
@since 0.3.3 *)
val map : ('a -> 'b) -> ('a, 'err) t -> ('b, 'err) t
(** Map on success *)
val map_err : ('err1 -> 'err2) -> ('a, 'err1) t -> ('a, 'err2) t
(** Map on error.
@since 0.5 *)
val map2 : ('a -> 'b) -> ('err1 -> 'err2) -> ('a, 'err1) t -> ('b, 'err2) t
(** Same as {!map}, but also with a function that can transform
the error message in case of failure *)
val iter : ('a -> unit) -> ('a, _) t -> unit
(** Apply the function only in case of `Ok *)
val get_exn : ('a, _) t -> 'a
(** Extract the value [x] from [`Ok x], fails otherwise.
You should be careful with this function, and favor other combinators
whenever possible.
@raise Invalid_argument if the value is an error. *)
val catch : ('a, 'err) t -> ok:('a -> 'b) -> err:('err -> 'b) -> 'b
(** [catch e ~ok ~err] calls either [ok] or [err] depending on
the value of [e].
This is useful for code that does not want to depend on the exact
definition of [('a, 'b) t] used, for instance once OCaml gets a
standard [Result.t] type.
@since 0.12 *)
val flat_map : ('a -> ('b, 'err) t) -> ('a, 'err) t -> ('b, 'err) t
val (>|=) : ('a, 'err) t -> ('a -> 'b) -> ('b, 'err) t
val (>>=) : ('a, 'err) t -> ('a -> ('b, 'err) t) -> ('b, 'err) t
val equal : ?err:'err equal -> 'a equal -> ('a, 'err) t equal
val compare : ?err:'err ord -> 'a ord -> ('a, 'err) t ord
val fold : success:('a -> 'b) -> failure:('err -> 'b) -> ('a, 'err) t -> 'b
(** [fold ~success ~failure e] opens [e] and, if [e = `Ok x], returns
[success x], otherwise [e = `Error s] and it returns [failure s]. *)
(** {2 Wrappers}
The functions {!guard}, {!wrap1}, {!wrap2} and {!wrap3} now return
exceptions in case of failure,
@since 0.5 *)
val guard : (unit -> 'a) -> ('a, exn) t
(** [guard f] runs [f ()] and returns its result wrapped in [`Ok]. If
[f ()] raises some exception [e], then it fails with [`Error e] *)
val guard_str : (unit -> 'a) -> ('a, string) t
(** Same as {!guard} but uses {!of_exn} to print the exception.
See {!register_printer} *)
val guard_str_trace : (unit -> 'a) -> ('a, string) t
(** Same as {!guard_str} but uses {!of_exn_trace} instead of {!of_exn} so
that the stack trace is printed.
@since 0.14 *)
val wrap1 : ('a -> 'b) -> 'a -> ('b, exn) t
(** Same as {!guard} but gives the function one argument. *)
val wrap2 : ('a -> 'b -> 'c) -> 'a -> 'b -> ('c, exn) t
(** Same as {!guard} but gives the function two arguments. *)
val wrap3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> ('d, exn) t
(** Same as {!guard} but gives the function three arguments. *)
(** {2 Applicative} *)
val pure : 'a -> ('a, 'err) t
(** Synonym of {!return} *)
val (<*>) : ('a -> 'b, 'err) t -> ('a, 'err) t -> ('b, 'err) t
(** [a <*> b] evaluates [a] and [b], and, in case of success, returns
[`Ok (a b)]. Otherwise, it fails, and the error of [a] is chosen
over the error of [b] if both fail. *)
val join : (('a, 'err) t, 'err) t -> ('a, 'err) t
(** [join t], in case of success, returns [`Ok o] from [`Ok (`Ok o)]. Otherwise,
it fails with [`Error e] where [e] is the unwrapped error of [t].
@since 0.15 *)
val both : ('a, 'err) t -> ('b, 'err) t -> (('a * 'b), 'err) t
(** [both a b], in case of success, returns [`Ok (o, o')] with the ok values
of [a] and [b]. Otherwise, it fails, and the error of [a] is chosen over the
error of [b] if both fail.
@since 0.15 *)
(** {2 Infix}
@since 0.12 *)
module Infix : sig
val (>|=) : ('a, 'err) t -> ('a -> 'b) -> ('b, 'err) t
val (>>=) : ('a, 'err) t -> ('a -> ('b, 'err) t) -> ('b, 'err) t
val (<*>) : ('a -> 'b, 'err) t -> ('a, 'err) t -> ('b, 'err) t
end
(** {2 Collections} *)
val map_l : ('a -> ('b, 'err) t) -> 'a list -> ('b list, 'err) t
val fold_l : ('b -> 'a -> ('b, 'err) t) -> 'b -> 'a list -> ('b, 'err) t
val fold_seq : ('b -> 'a -> ('b, 'err) t) -> 'b -> 'a sequence -> ('b, 'err) t
(** {2 Misc} *)
val choose : ('a, 'err) t list -> ('a, 'err list) t
(** [choose l] selects a member of [l] that is a [`Ok _] value,
or returns [`Error l] otherwise, where [l] is the list of errors. *)
val retry : int -> (unit -> ('a, 'err) t) -> ('a, 'err list) t
(** [retry n f] calls [f] at most [n] times, returning the first result
of [f ()] that doesn't fail. If [f] fails [n] times, [retry n f] fails
with the list of successive errors. *)
(** {2 Monadic Operations} *)
module type MONAD = sig
type 'a t
val return : 'a -> 'a t
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
end
module Traverse(M : MONAD) : sig
val sequence_m : ('a M.t, 'err) t -> ('a, 'err) t M.t
val fold_m : ('b -> 'a -> 'b M.t) -> 'b -> ('a, 'err) t -> 'b M.t
val map_m : ('a -> 'b M.t) -> ('a, 'err) t -> ('b, 'err) t M.t
val retry_m : int -> (unit -> ('a, 'err) t M.t) -> ('a, 'err list) t M.t
end
(** {2 Conversions} *)
val to_opt : ('a, _) t -> 'a option
val of_opt : 'a option -> ('a, string) t
val to_seq : ('a, _) t -> 'a sequence
(** {2 IO} *)
val pp : 'a printer -> ('a, string) t printer
val pp': 'a printer -> 'e printer -> ('a, 'e) t printer
(** Printer that is generic on the error type
@since 0.19 *)
val print : 'a formatter -> ('a, string) t formatter
val print' : 'a formatter -> 'e formatter -> ('a, 'e) t formatter
(** Printer that is generic on the error type
@since 0.19 *)
(** {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
(* TODO: deprecate, should use {!Printexc} *)

15
src/core/CCIO.ml
View file

@ -3,6 +3,7 @@
(** {1 IO Utils} *)
type 'a or_error = ('a, string) Result.result
type 'a gen = unit -> 'a option
let gen_singleton x =
@ -236,7 +237,6 @@ let tee funs g () = match g() with
*)
module File = struct
type 'a or_error = [`Ok of 'a | `Error of string]
type t = string
let to_string f = f
@ -253,25 +253,28 @@ module File = struct
let remove_exn f = Sys.remove f
let remove f =
try `Ok (Sys.remove f)
try Result.Ok (Sys.remove f)
with exn ->
`Error (Printexc.to_string exn)
Result.Error (Printexc.to_string exn)
let read_exn f = with_in f (read_all_ ~op:Ret_string ~size:4096)
let read f = try `Ok (read_exn f) with e -> `Error (Printexc.to_string e)
let read f =
try Result.Ok (read_exn f) with e -> Result.Error (Printexc.to_string e)
let append_exn f x =
with_out ~flags:[Open_append; Open_creat; Open_text] f
(fun oc -> output_string oc x; flush oc)
let append f x = try `Ok (append_exn f x) with e -> `Error (Printexc.to_string e)
let append f x =
try Result.Ok (append_exn f x) with e -> Result.Error (Printexc.to_string e)
let write_exn f x =
with_out f
(fun oc -> output_string oc x; flush oc)
let write f x = try `Ok (write_exn f x) with e -> `Error (Printexc.to_string e)
let write f x =
try Result.Ok (write_exn f x) with e -> Result.Error (Printexc.to_string e)
let remove_noerr f = try Sys.remove f with _ -> ()

3
src/core/CCIO.mli
View file

@ -36,7 +36,7 @@ Examples:
*)
type 'a or_error = ('a, string) Result.result
type 'a gen = unit -> 'a option (** See {!Gen} in the gen library *)
(** {2 Input} *)
@ -127,7 +127,6 @@ See {!File.walk} if you also need to list directories:
*)
module File : sig
type 'a or_error = [`Ok of 'a | `Error of string]
type t = string
(** A file should be represented by its absolute path, but currently
this is not enforced. *)

2
src/unix/CCUnix.ml
View file

@ -3,7 +3,7 @@
(** {1 High-level Functions on top of Unix} *)
type 'a or_error = [`Ok of 'a | `Error of string]
type 'a or_error = ('a, string) Result.result
type 'a gen = unit -> 'a option
(** {2 Calling Commands} *)

2
src/unix/CCUnix.mli
View file

@ -8,7 +8,7 @@ Some useful functions built on top of Unix.
{b status: unstable}
@since 0.10 *)
type 'a or_error = [`Ok of 'a | `Error of string]
type 'a or_error = ('a, string) Result.result
type 'a gen = unit -> 'a option
(** {2 Calling Commands} *)