much better error handling in CCLinq

core/CCLinq.ml

@@ -30,11 +30,16 @@ type 'a sequence = ('a -> unit) -> unit
 type 'a equal = 'a -> 'a -> bool
 type 'a ord = 'a -> 'a -> int
 type 'a hash = 'a -> int
+type 'a with_err = [`Ok of 'a | `Error of string ]
 
 (* TODO: add CCVector as a collection *)
 
 let _id x = x
 
+exception ExitWithError of string
+let _exit_with_error s = raise (ExitWithError s)
+let _error_of_exn f = try `Ok (f ()) with ExitWithError s -> `Error
+
 type 'a collection =
   | Seq : 'a sequence -> 'a collection
   | List : 'a list -> 'a collection
@@ -57,6 +62,9 @@ module PMap = struct
   let to_seq m = m.to_seq
   let fold f acc m = m.fold f acc
   let size m = m.size ()
+  let get_err m x = match m.get x with
+    | Some y -> `Ok y
+    | None -> `Error "PMap.get: lookup error"
 
   type ('a, 'b) build = {
     mutable cur : ('a, 'b) t;
@@ -266,18 +274,24 @@ module Coll = struct
              with type elt = elt and type t = 'b) in
         S.cardinal set
 
-  let choose (type elt) = function
-    | List [] -> None
-    | List (x::_) -> Some x
+  let choose_exn (type elt) c =
+    let fail () = _exit_with_error "choose: empty collection" in 
+    match c with
+    | List [] -> fail ()
+    | List (x::_) -> x
     | Seq s ->
         begin match CCSequence.take 1 s |> CCSequence.to_list with
-        | [x] -> Some x
-        | _ -> None
+        | [x] -> x
+        | _ -> fail ()
         end
     | Set (m, set) ->
         let module S = (val m : CCSequence.Set.S
              with type elt = elt and type t = 'b) in
-        try Some (S.choose set) with Not_found -> None
+        try S.choose set with Not_found -> fail ()
+
+  let choose_err c =
+    try `Ok (choose_exn c)
+    with ExitWithError s -> `Error s
 
   let take n c =
     _fmap ~lst:(CCList.take n) ~seq:(CCSequence.take n) c
@@ -409,8 +423,8 @@ end
 (** {2 Query operators} *)
 
 type (_,_) safety =
-  | Safe : ('a, 'a option) safety
-  | Unsafe : ('a, 'a) safety
+  | Explicit : ('a, 'a with_err) safety
+  | Implicit : ('a, 'a) safety
 
 type (_, _) unary =
   | PMap : ('a -> 'b) -> ('a collection, 'b collection) unary
@@ -458,6 +472,7 @@ type (_, _, _) binary =
 (* type of queries that return a 'a *)
 and 'a t =
   | Start : 'a -> 'a t
+  | Catch : 'a with_err t -> 'a t
   | Unary : ('a, 'b) unary * 'a t -> 'b t
   | Binary : ('a, 'b, 'c) binary * 'a t * 'b t -> 'c t
   | QueryMap : ('a -> 'b) * 'a t -> 'b t
@@ -494,6 +509,7 @@ let of_string s =
 let rec _optimize : type a. a t -> a t
   = fun q -> match q with
     | Start _ -> q
+    | Catch q' -> Catch (_optimize q')
     | Unary (u, q) ->
         _optimize_unary u (_optimize q)
     | Binary (b, q1, q2) ->
@@ -554,18 +570,14 @@ let _do_unary : type a b. (a,b) unary -> a -> b
           ) None
       in
       begin match acc, safety with
-      | Some x, Safe -> Some (stop x)
-      | None, Safe -> None
-      | Some x, Unsafe -> stop x
-      | None, Unsafe -> invalid_arg "reduce: empty collection"
+      | Some x, Implicit -> stop x
+      | None, Implicit -> _exit_with_error "reduce: empty collection"
+      | Some x, Explicit -> `Ok (stop x)
+      | None, Explicit -> `Error "reduce: empty collection"
       end
   | Size -> Coll.size c
-  | Choose Safe -> Coll.choose c
-  | Choose Unsafe ->
-      begin match Coll.choose c with
-        | Some x -> x
-        | None -> invalid_arg "choose: empty collection"
-      end
+  | Choose Implicit -> Coll.choose_exn c
+  | Choose Explicit -> Coll.choose_err c
   | FilterMap f -> Coll.filter_map f c
   | FlatMap f -> Coll.flat_map f c
   | Take n -> Coll.take n c
@@ -573,8 +585,8 @@ let _do_unary : type a b. (a,b) unary -> a -> b
   | Sort cmp -> Coll.sort cmp c
   | Distinct cmp -> Coll.distinct ~cmp c
   | Search obj -> Coll.search obj c
-  | Get (Safe, k) -> PMap.get c k
-  | Get (Unsafe, k) -> PMap.get_exn c k
+  | Get (Implicit, k) -> PMap.get_exn c k
+  | Get (Explicit, k) -> PMap.get_err c k
   | GroupBy (build,f) ->
       Coll.to_seq c
       |> CCSequence.map (fun x -> f x, x)
@@ -597,8 +609,13 @@ let _do_binary : type a b c. (a, b, c) binary -> a -> b -> c
   | SetOp (Diff,build) -> Coll.do_diff ~build c1 c2
 
 let rec _run : type a. opt:bool -> a t -> a
-  = fun ~opt q -> match q with
+= fun ~opt q -> match q with
   | Start c -> c
+  | Catch q' ->
+      begin match _run ~opt q' with
+        | `Ok x -> x
+        | `Error s -> _exit_with_error s
+      end
   | Unary (u, q') -> _do_unary u (_run ~opt q')
   | Binary (b, q1, q2) -> _do_binary b (_run ~opt q1) (_run ~opt q2)
   | QueryMap (f, q') -> f (_run ~opt q')
@@ -608,8 +625,23 @@ let rec _run : type a. opt:bool -> a t -> a
       let q'' = if opt then _optimize q'' else q'' in
       _run ~opt q''
 
-let run q = _run ~opt:true (_optimize q)
-let run_no_opt q = _run ~opt:false q
+(* safe execution *)
+let run q =
+  try `Ok (_run ~opt:true (_optimize q))
+  with
+  | ExitWithError s -> `Error s
+  | e -> `Error (Printexc.to_string e)
+
+let run_exn q =
+  match run q with
+  | `Ok x -> x
+  | `Error s -> failwith s
+
+let run_no_optim q =
+  try `Ok (_run ~opt:false q)
+  with
+  | ExitWithError s -> `Error s
+  | e -> `Error (Printexc.to_string e)
 
 (** {6 Basics on Collections} *)
 
@@ -617,9 +649,9 @@ let map f q = Unary (PMap f, q)
 
 let filter p q = Unary (Filter p, q)
 
-let choose q = Unary (Choose Safe, q)
+let choose q = Unary (Choose Implicit, q)
 
-let choose_exn q = Unary (Choose Unsafe, q)
+let choose_err q = Unary (Choose Explicit, q)
 
 let filter_map f q = Unary (FilterMap f, q)
 
@@ -665,10 +697,10 @@ let _make_build ?cmp ?eq ?hash () =
 
 module M = struct
   let get key q =
-    Unary (Get (Safe, key), q)
+    Unary (Get (Implicit, key), q)
 
-  let get_exn key q =
-    Unary (Get (Unsafe, key), q)
+  let get_err key q =
+    Unary (Get (Explicit, key), q)
 
   let iter q =
     Unary (GeneralMap (fun m -> Coll.of_seq m.PMap.to_seq), q)
@@ -733,10 +765,10 @@ let size q = Unary (Size, q)
 let sum q = Unary (Fold ((+), 0), q)
 
 let reduce start mix stop q =
-  Unary (Reduce (Safe, start,mix,stop), q)
+  Unary (Reduce (Implicit, start,mix,stop), q)
 
-let reduce_exn start mix stop q =
-  Unary (Reduce (Unsafe, start,mix,stop), q)
+let reduce_err start mix stop q =
+  Unary (Reduce (Explicit, start,mix,stop), q)
 
 let _avg_start x = (x,1)
 let _avg_mix x (y,n) = (x+y,n+1)
@@ -746,13 +778,13 @@ let _lift_some f x y = match y with
   | None -> Some x
   | Some y -> Some (f x y)
 
-let max q = Unary (Reduce (Safe, _id, Pervasives.max, _id), q)
-let min q = Unary (Reduce (Safe, _id, Pervasives.min, _id), q)
-let average q = Unary (Reduce (Safe, _avg_start, _avg_mix, _avg_stop), q)
+let max q = Unary (Reduce (Implicit, _id, Pervasives.max, _id), q)
+let min q = Unary (Reduce (Implicit, _id, Pervasives.min, _id), q)
+let average q = Unary (Reduce (Implicit, _avg_start, _avg_mix, _avg_stop), q)
 
-let max_exn q = Unary (Reduce (Unsafe, _id, Pervasives.max, _id), q)
-let min_exn q = Unary (Reduce (Unsafe, _id, Pervasives.min, _id), q)
-let average_exn q = Unary (Reduce (Unsafe, _avg_start, _avg_mix, _avg_stop), q)
+let max_err q = Unary (Reduce (Explicit, _id, Pervasives.max, _id), q)
+let min_err q = Unary (Reduce (Explicit, _id, Pervasives.min, _id), q)
+let average_err q = Unary (Reduce (Explicit, _avg_start, _avg_mix, _avg_stop), q)
 
 let is_empty q =
   Unary (Search (object
@@ -833,10 +865,15 @@ let map2 f q = map (fun (x,y) -> x, f y) q
 
 let flatten_opt q = filter_map _id q
 
-let opt_get_exn q =
+let opt_unwrap q =
   QueryMap ((function
     | Some x -> x
-    | None -> invalid_arg "opt_get_exn"), q)
+    | None -> _exit_with_error "opt_unwrap"), q)
+
+let catch q =
+  QueryMap ((function
+    | `Ok x -> x
+    | `Error s -> _exit_with_error s), q)
 
 (** {6 Monadic stuff} *)
 
@@ -852,10 +889,7 @@ let query_map f q = QueryMap (f, q)
 
 let lazy_ q = Unary (Lazy, q)
 
-(** {6 Output containers} *)
-
-let to_list q =
-  QueryMap (Coll.to_list, q)
+(** {6 Adapters} *)
 
 let to_array q =
   QueryMap ((fun c -> Array.of_list (Coll.to_list c)), q)
@@ -872,11 +906,13 @@ let to_queue q =
 let to_stack q =
   QueryMap ((fun c s -> CCSequence.to_stack s (Coll.to_seq c)), q)
 
-(** {6 Misc} *)
-
-let run_list q = run (q |> to_list)
-
-(** {6 Adapters} *)
+module L = struct
+  let of_list l = Start (Coll.of_list l)
+  let to_list q =
+    QueryMap (Coll.to_list, q)
+  let run q = run (to_list q)
+  let run_exn q = run_exn (to_list q)
+end
 
 module AdaptSet(S : Set.S) = struct
   let of_set set =
@@ -888,7 +924,8 @@ module AdaptSet(S : Set.S) = struct
     in
     query_map f q
 
-  let run q = run (q |> to_set)
+  let run q = run (to_set q)
+  let run_exn q = run_exn (to_set q)
 end
 
 module AdaptMap(M : Map.S) = struct
@@ -913,23 +950,57 @@ module AdaptMap(M : Map.S) = struct
     query_map f q
 
   let run q = run (q |> to_map)
+  let run_exn q = run_exn (q |> to_map)
 end
 
 module IO = struct
-  let slurp ic =
+  let _slurp with_input =
     let l = lazy (
-      let buf_size = 256 in
-      let content = Buffer.create 120
-      and buf = String.make buf_size 'a' in
-      let rec next () =
-        let num = input ic buf 0 buf_size in
-        if num = 0
-          then Buffer.contents content (* EOF *)
-          else (Buffer.add_substring content buf 0 num; next ())
-      in next ()
+      with_input
+        (fun ic ->
+          let buf_size = 256 in
+          let content = Buffer.create 120
+          and buf = String.make buf_size 'a' in
+          let rec next () =
+            let num = input ic buf 0 buf_size in
+            if num = 0
+              then Buffer.contents content (* EOF *)
+              else (Buffer.add_substring content buf 0 num; next ())
+          in next ()
+        )
     ) in
     lazy_ (return l)
 
+  let slurp ic = _slurp (fun f -> f ic)
+
+  let _with_file_in filename f =
+    try
+      let ic = open_in filename in
+      try
+        let x = f ic in
+        close_in ic;
+        x
+      with e ->
+        close_in ic;
+        _exit_with_error (Printexc.to_string e)
+    with e ->
+      _exit_with_error (Printexc.to_string e)
+
+  let _with_file_out filename f =
+    try
+      let oc = open_out filename in
+      try
+        let x = f oc in
+        close_out oc;
+        x
+      with e ->
+        close_out oc;
+        _exit_with_error (Printexc.to_string e)
+    with e ->
+      _exit_with_error (Printexc.to_string e)
+
+  let slurp_file filename = _slurp (_with_file_in filename)
+
   (* find [c] in [s], starting at offset [i] *)
   let rec _find s c i =
     if i >= String.length s then None
@@ -952,11 +1023,43 @@ module IO = struct
     let f s = lazy (_lines s 0 |> CCSequence.to_list) in
     lazy_ (query_map f q)
 
+  let _join ~sep ?(stop="") l =
+    let buf = Buffer.create 128 in
+    Coll.to_seq l
+      |> CCSequence.iteri
+        (fun i x ->
+          if i>0 then Buffer.add_string buf sep;
+          Buffer.add_string buf x);
+    Buffer.add_string buf stop;
+    Buffer.contents buf
+
+  let unlines q =
+    let f l = lazy (_join ~sep:"\n" ~stop:"\n" l) in
+    lazy_ (query_map f q)
+
+  let join sep q =
+    let f l = lazy (_join ~sep l) in
+    lazy_ (query_map f q)
+
   let out oc q =
-    run q |> output_string oc
+    run_exn q |> output_string oc
 
   let out_lines oc q =
-    run q
+    run_exn q
     |> Coll.to_seq
     |> CCSequence.iter (fun l -> output_string oc l; output_char oc '\n')
+
+  let to_file_exn filename q =
+    _with_file_out filename (fun oc -> out oc q)
+
+  let to_file filename q =
+    try `Ok (_with_file_out filename (fun oc  -> out oc q))
+    with Failure s -> `Error s
+
+  let to_file_lines_exn filename q =
+    _with_file_out filename (fun oc -> out_lines oc q)
+
+  let to_file_lines filename q =
+    try `Ok (_with_file_out filename (fun oc  -> out_lines oc q))
+    with Failure s -> `Error s
 end

core/CCLinq.mli

@@ -37,14 +37,24 @@ the order of execution.
 {[
 
 CCLinq.(
-  start_list [1;2;3]
+  of_list [1;2;3]
   |> flat_map_l (fun x -> CCList.(x -- (x+10)))
   |> sort ()
   |> count ()
-  |> M.to_list |> run
+  |> M.to_list
+  |> run_exn
 );;
 - : (int * int) list = [(13, 1); (12, 2); (11, 3); (10, 3); (9, 3);
     (8, 3); (7, 3); (6, 3); (5, 3); (4, 3); (3, 3); (2, 2); (1, 1)]
+
+
+CCLinq.(
+  IO.slurp_file "/tmp/foo"
+  |> IO.lines
+  |> sort ()
+  |> IO.to_file_lines "/tmp/bar"
+);;
+- :  `Ok ()
 ]}
 
 *)
@@ -53,6 +63,7 @@ type 'a sequence = ('a -> unit) -> unit
 type 'a equal = 'a -> 'a -> bool
 type 'a ord = 'a -> 'a -> int
 type 'a hash = 'a -> int
+type 'a with_err = [`Ok of 'a | `Error of string ]
 
 type 'a collection
 (** Abstract type of collections of objects of type 'a. Those cannot
@@ -108,14 +119,16 @@ val of_string : string -> char collection t
 
 (** {6 Execution} *)
 
-val run : 'a t -> 'a
-(** Execute the actual query *)
+val run : 'a t -> 'a with_err
+(** Execute the query, possibly returning an error if things go wrong *)
 
-val run_no_opt : 'a t -> 'a
-(** Execute the query, without optimizing it at all *)
+val run_exn : 'a t -> 'a
+(** Execute the query, ignoring errors. Can raise an exception
+    if some execution step does.
+    @raise Failure if the query fails (or returns [`Error s]) *)
 
-val run_list : 'a collection t -> 'a list
-(** Shortcut to obtain a list *)
+val run_no_optim : 'a t -> 'a with_err
+(** Run without any optimization *)
 
 (** {6 Basics on Collections} *)
 
@@ -125,12 +138,12 @@ val filter : ('a -> bool) -> 'a collection t -> 'a collection t
 
 val size : _ collection t -> int t
 
-val choose : 'a collection t -> 'a option t
-(** Choose one element (if any) in the collection *)
+val choose : 'a collection t -> 'a t
+(** Choose one element (if any) in the collection. Fails
+    if the collections is empty *)
 
-val choose_exn : 'a collection t -> 'a t
-(** Choose one element or fail.
-    @raise Invalid_argument if the collection is empty *)
+val choose_err : 'a collection t -> 'a with_err t
+(** Choose one element or fail explicitely *)
 
 val filter_map : ('a -> 'b option) -> 'a collection t -> 'b collection t
 (** Filter and map elements at once *)
@@ -164,12 +177,11 @@ val distinct : ?cmp:'a ord -> unit -> 'a collection t -> 'a collection t
 (** {6 Queries on Maps} *)
 
 module M : sig
-  val get : 'a -> ('a, 'b) PMap.t t -> 'b option t
+  val get : 'a -> ('a, 'b) PMap.t t -> 'b t
   (** Select a key from a map *)
 
-  val get_exn : 'a -> ('a, 'b) PMap.t t -> 'b t
-  (** Unsafe version of {!get}.
-      @raise Not_found if the key is not present. *)
+  val get_err : 'a -> ('a, 'b) PMap.t t -> 'b with_err t
+  (** Explicit version of {!get}, with [`Error] if the key is not present *)
 
   val iter : ('a,'b) PMap.t t -> ('a*'b) collection t
   (** View a multimap as a proper collection *)
@@ -227,16 +239,14 @@ val size : _ collection t -> int t
 (** Count how many elements the collection contains *)
 
 val reduce : ('a -> 'b) -> ('a -> 'b -> 'b) -> ('b -> 'c) ->
-             'a collection t -> 'c option t
+             'a collection t -> 'c t
 (** [reduce start mix stop q] uses [start] on the first element of [q],
     and combine the result with following elements using [mix]. The final
-    value is transformed using [stop]. This returns [None] if the collection
-    is empty *)
+    value is transformed using [stop]. *)
 
-val reduce_exn : ('a -> 'b) -> ('a -> 'b -> 'b) -> ('b -> 'c) ->
-                 'a collection t -> 'c t
-(** Same as {!reduce} but fails on empty collections.
-    @raise Invalid_argument if the collection is empty *)
+val reduce_err : ('a -> 'b) -> ('a -> 'b -> 'b) -> ('b -> 'c) ->
+                 'a collection t -> 'c with_err t
+(** Same as {!reduce} but fails explicitely on empty collections. *)
 
 val is_empty : 'a collection t -> bool t
 
@@ -244,13 +254,13 @@ val sum : int collection t -> int t
 
 val contains : ?eq:'a equal -> 'a -> 'a collection t -> bool t
 
-val average : int collection t -> int option t
-val max : int collection t -> int option t
-val min : int collection t -> int option t
+val average : int collection t -> int t
+val max : int collection t -> int t
+val min : int collection t -> int t
 
-val average_exn : int collection t -> int t
-val max_exn : int collection t -> int t
-val min_exn : int collection t -> int t
+val average_err : int collection t -> int with_err t
+val max_err : int collection t -> int with_err t
+val min_err : int collection t -> int with_err t
 
 val for_all : ('a -> bool) -> 'a collection t -> bool t
 val exists : ('a -> bool) -> 'a collection t -> bool t
@@ -312,9 +322,8 @@ val map2 : ('a -> 'b) -> ('c * 'a) collection t -> ('c * 'b) collection t
 val flatten_opt : 'a option collection t -> 'a collection t
 (** Flatten the collection by removing options *)
 
-val opt_get_exn : 'a option t -> 'a t
-(** unwrap an option type.
-    @raise Invalid_argument if the option value is [None] *)
+val opt_unwrap : 'a option t -> 'a t
+(** unwrap an option type. Fails if the option value is [None] *)
 
 (** {6 Monad}
 
@@ -335,12 +344,14 @@ val query_map : ('a -> 'b) -> 'a t -> 'b t
 
 (** {6 Misc} *)
 
+val catch : 'a with_err t -> 'a t
+(** Catch errors within the execution itself. In other words, [run (catch q)]
+    with succeed with [x] if [q] succeeds with [`Ok x], and fail if [q]
+    succeeds with [`Error s] or if [q] fails *)
+
 val lazy_ : 'a lazy_t t -> 'a t
 
-(** {6 Output Containers} *)
-
-val to_list : 'a collection t -> 'a list t
-(** Build a list of results *)
+(** {6 Adapters} *)
 
 val to_array : 'a collection t -> 'a array t
 (** Build an array of results *)
@@ -356,24 +367,38 @@ val to_queue : 'a collection t -> ('a Queue.t -> unit) t
 
 val to_stack : 'a collection t -> ('a Stack.t -> unit) t
 
-(** {6 Adapters} *)
+module L : sig
+  val of_list : 'a list -> 'a collection t
+  val to_list : 'a collection t -> 'a list t
+  val run : 'a collection t -> 'a list with_err
+  val run_exn : 'a collection t -> 'a list
+end
 
 module AdaptSet(S : Set.S) : sig
   val of_set : S.t -> S.elt collection t
   val to_set : S.elt collection t -> S.t t
-  val run : S.elt collection t -> S.t
+  val run : S.elt collection t -> S.t with_err
+  val run_exn : S.elt collection t -> S.t
 end
 
 module AdaptMap(M : Map.S) : sig
   val of_map : 'a M.t -> (M.key * 'a) collection t
   val to_pmap : 'a M.t -> (M.key, 'a) PMap.t
   val to_map : (M.key * 'a) collection t -> 'a M.t t
-  val run : (M.key * 'a) collection t -> 'a M.t
+  val run : (M.key * 'a) collection t -> 'a M.t with_err
+  val run_exn : (M.key * 'a) collection t -> 'a M.t
 end
 
 module IO : sig
   val slurp : in_channel -> string t
-  (** Slurp the whole channel in (blocking), returning the corresponding string *)
+  (** Slurp the whole channel in (blocking), returning the
+      corresponding string. The channel will be read at most once
+      during execution, and its content cached; however the channel
+      might never get read because evaluation is lazy. *)
+
+  val slurp_file : string -> string t
+  (** Read a whole file (given by name) and return its content as
+      a string *)
 
   val lines : string t -> string collection t
   (** Convert a string into a collection of lines *)
@@ -381,7 +406,20 @@ module IO : sig
   val lines' : string t -> string list t
   (** Convert a string into a list of lines *)
 
+  val join : string -> string collection t -> string t
+
+  val unlines : string collection t -> string t
+  (** Join lines together *)
+
   val out : out_channel -> string t -> unit
   val out_lines : out_channel -> string collection t -> unit
   (** Evaluate the query and print it line by line on the output *)
+
+  (** {8 Run methods} *)
+
+  val to_file : string -> string t -> unit with_err
+  val to_file_exn : string -> string t -> unit
+
+  val to_file_lines : string -> string collection t -> unit with_err
+  val to_file_lines_exn : string -> string collection t -> unit
 end