simplify: one less type param

src-bs/shims_let_ops_.ml

@@ -1,18 +1,18 @@
 (* Note: copied from src/gen/mkshims.ml *)
 module type I = sig
-  type ('i, 'a, 'e) t
+  type ('i, 'a) t
 
-  val ( >|= ) : ('i, 'a, 'e) t -> ('a -> 'b) -> ('i, 'b, 'e) t
+  val ( >|= ) : ('i, 'a) t -> ('a -> 'b) -> ('i, 'b) t
 
-  val monoid_product : ('i, 'a, 'e) t -> ('i, 'b, 'e) t -> ('i, 'a * 'b, 'e) t
+  val monoid_product : ('i, 'a) t -> ('i, 'b) t -> ('i, 'a * 'b) t
 
-  val ( >>= ) : ('i, 'a, 'e) t -> ('a -> ('i, 'b, 'e) t) -> ('i, 'b, 'e) t
+  val ( >>= ) : ('i, 'a) t -> ('a -> ('i, 'b) t) -> ('i, 'b) t
 end
 
 module type S = sig
-  type ('i, 'a, 'e) t_let
+  type ('i, 'a) t_let
 end
 
 module Make (X : I) = struct
-  type ('i, 'a, 'e) t_let = ('i, 'a, 'e) X.t
+  type ('i, 'a) t_let = ('i, 'a) X.t
 end

src/decode.ml

@@ -13,8 +13,7 @@ module type Decodeable = Sig.Decodeable
 module Make (Decodeable : Decodeable) :
   Sig.S
     with type value = Decodeable.value
-     and type 'a decoder =
-          (Decodeable.value, 'a, Decodeable.value Error.t) Decoder.t = struct
+     and type 'a decoder = (Decodeable.value, 'a) Decoder.t = struct
   type value = Decodeable.value
 
   let pp = Decodeable.pp
@@ -65,7 +64,7 @@ module Make (Decodeable : Decodeable) :
            Error.tag (Printf.sprintf "While reading %s" file) (Error.make msg) )
 
 
-  type 'a decoder = (value, 'a, value Error.t) Decoder.t
+  type 'a decoder = (value, 'a) Decoder.t
 
   let succeed x = Decoder.pure x
 
@@ -112,10 +111,9 @@ module Make (Decodeable : Decodeable) :
              |> Decoder.map_err (fun e ->
                     Error.tag_group (Printf.sprintf "%S decoder" name) [ e ] ) )
     in
-    Decoder.one_of
-      decoders
-      ~combine_errors:
-        (Error.tag_group "I tried the following decoders but they all failed")
+    Decoder.one_of decoders
+    |> Decoder.map_err
+         (Error.tag "I tried the following decoders but they all failed")
 
 
   let pick decoders =
@@ -126,10 +124,9 @@ module Make (Decodeable : Decodeable) :
              |> Decoder.map_err (fun e ->
                     Error.tag_group (Printf.sprintf "%S decoder" name) [ e ] ) )
     in
-    Decoder.pick
-      decoders
-      ~combine_errors:
-        (Error.tag_group "I tried the following decoders but they all failed")
+    Decoder.pick decoders
+    |> Decoder.map_err
+         (Error.tag "I tried the following decoders but they all failed")
 
 
   let decode_sub v dec = from_result (dec v)

src/decode.mli

@@ -10,6 +10,4 @@ module type Decodeable = Sig.Decodeable
 
 (** Derive decoders for a [Decodeable.value]. *)
 module Make (M : Decodeable) :
-  Sig.S
-    with type value = M.value
-     and type 'a decoder = (M.value, 'a, M.value Error.t) Decoder.t
+  Sig.S with type value = M.value and type 'a decoder = (M.value, 'a) Decoder.t

src/decoder.ml

@@ -1,24 +1,24 @@
-type ('i, 'o, 'e) t = 'i -> ('o, 'e) result
+type ('i, 'o) t = 'i -> ('o, 'i Error.t) result
 
-let pure x : ('i, 'o, 'e) t = fun _i -> Ok x
+let pure x : ('i, 'o) t = fun _i -> Ok x
 
-let fail e : ('i, 'o, 'e) t = fun _i -> Error e
+let fail e : ('i, 'o) t = fun _i -> Error e
 
 let of_result = function Ok o -> pure o | Error e -> fail e
 
-let bind (f : 'a -> ('i, 'b, 'e) t) (x : ('i, 'a, 'e) t) : ('i, 'b, 'e) t =
+let bind (f : 'a -> ('i, 'b) t) (x : ('i, 'a) t) : ('i, 'b) t =
  fun i -> match x i with Ok y -> f y i | Error e -> Error e
 
 
-let map (f : 'a -> 'b) (x : ('i, 'a, 'e) t) : ('i, 'b, 'e) t =
+let map (f : 'a -> 'b) (x : ('i, 'a) t) : ('i, 'b) t =
  fun i -> match x i with Ok y -> Ok (f y) | Error e -> Error e
 
 
-let map_err (f : 'e1 -> 'e2) (x : ('i, 'o, 'e1) t) : ('i, 'o, 'e2) t =
+let map_err (f : 'i Error.t -> 'i Error.t) (x : ('i, 'o) t) : ('i, 'o) t =
  fun i -> match x i with Ok y -> Ok y | Error e -> Error (f e)
 
 
-let apply (f : ('i, 'a -> 'b, 'e) t) (x : ('i, 'a, 'e) t) : ('i, 'b, 'e) t =
+let apply (f : ('i, 'a -> 'b) t) (x : ('i, 'a) t) : ('i, 'b) t =
  fun i ->
   match f i with
   | Ok f ->
@@ -35,7 +35,7 @@ module Infix = struct
   let[@inline] ( <*> ) f x = apply f x
 
   include Shims_let_ops_.Make (struct
-    type nonrec ('i, 'o, 'e) t = ('i, 'o, 'e) t
+    type nonrec ('i, 'o) t = ('i, 'o) t
 
     let ( >>= ) = ( >>= )
 
@@ -45,30 +45,30 @@ module Infix = struct
   end)
 end
 
-let fix (f : ('i, 'a, 'e) t -> ('i, 'a, 'e) t) : ('i, 'a, 'e) t =
+let fix (f : ('i, 'a) t -> ('i, 'a) t) : ('i, 'a) t =
   let rec p = lazy (f r)
   and r value = (Lazy.force p) value in
   r
 
 
-let value : ('i, 'i, 'e) t = fun i -> Ok i
+let value : ('i, 'i) t = fun i -> Ok i
 
-let maybe (x : ('i, 'a, 'e) t) : ('i, 'a option, 'e) t =
+let maybe (x : ('i, 'a) t) : ('i, 'a option) t =
  fun i -> match x i with Ok x -> Ok (Some x) | Error _ -> Ok None
 
 
-let one_of ~combine_errors (xs : ('i, 'o, 'e) t list) : ('i, 'o, 'e) t =
+let one_of (xs : ('i, 'o) t list) : ('i, 'o) t =
  fun i ->
   let rec aux es = function
     | x :: xs ->
       (match x i with Ok o -> Ok o | Error e -> aux (e :: es) xs)
     | [] ->
-        Error (combine_errors (List.rev es))
+        Error (Error.group (List.rev es))
   in
   aux [] xs
 
 
-let pick ~combine_errors : ('i, ('i, 'o, 'e) t, 'e) t list -> ('i, 'o, 'e) t =
+let pick : ('i, ('i, 'o) t) t list -> ('i, 'o) t =
  fun decoders input ->
   let rec go errors = function
     | decoder :: rest ->
@@ -79,10 +79,10 @@ let pick ~combine_errors : ('i, ('i, 'o, 'e) t, 'e) t list -> ('i, 'o, 'e) t =
       | Error error ->
           go (error :: errors) rest )
     | [] ->
-        Error (combine_errors errors)
+        Error (Error.group errors)
   in
   go [] decoders
 
 
-let of_to_opt (to_opt : 'i -> 'o option) fail : ('i, 'o, 'e) t =
+let of_to_opt (to_opt : 'i -> 'o option) fail : ('i, 'o) t =
  fun i -> match to_opt i with Some o -> Ok o | None -> fail i

src/decoder.mli

@@ -1,49 +1,47 @@
-(** An [('i, 'o, 'e) t] is a decoder that
+(** An [('i, 'o) t] is a decoder that
 
     - consumes a value of type ['i]
-    - producing a value of type ['o]
-    - or an error of type ['e]
+    - produces a value of type ['o] or an error of type ['i Error.t]
  *)
-type ('i, 'o, 'e) t = 'i -> ('o, 'e) result
+type ('i, 'o) t = 'i -> ('o, 'i Error.t) result
 
-val pure : 'o -> ('i, 'o, 'e) t
+val pure : 'o -> ('i, 'o) t
 (** [pure x] always succeeds with [x] *)
 
-val fail : 'e -> ('i, 'o, 'e) t
+val fail : 'i Error.t -> ('i, 'o) t
 (** [fail e] always fails with [e] *)
 
-val of_result : ('o, 'e) Decoders_util.My_result.t -> ('i, 'o, 'e) t
+val of_result : ('o, 'i Error.t) Decoders_util.My_result.t -> ('i, 'o) t
 
-val bind : ('a -> ('i, 'b, 'e) t) -> ('i, 'a, 'e) t -> ('i, 'b, 'e) t
+val bind : ('a -> ('i, 'b) t) -> ('i, 'a) t -> ('i, 'b) t
 
-val map : ('a -> 'b) -> ('i, 'a, 'e) t -> ('i, 'b, 'e) t
+val map : ('a -> 'b) -> ('i, 'a) t -> ('i, 'b) t
 
-val map_err : ('e1 -> 'e2) -> ('i, 'o, 'e1) t -> ('i, 'o, 'e2) t
+val map_err : ('i Error.t -> 'i Error.t) -> ('i, 'o) t -> ('i, 'o) t
 
-val apply : ('i, 'a -> 'b, 'e) t -> ('i, 'a, 'e) t -> ('i, 'b, 'e) t
+val apply : ('i, 'a -> 'b) t -> ('i, 'a) t -> ('i, 'b) t
 
 module Infix : sig
-  val ( >>= ) : ('i, 'a, 'e) t -> ('a -> ('i, 'b, 'e) t) -> ('i, 'b, 'e) t
+  val ( >>= ) : ('i, 'a) t -> ('a -> ('i, 'b) t) -> ('i, 'b) t
 
-  val ( >|= ) : ('i, 'a, 'e) t -> ('a -> 'b) -> ('i, 'b, 'e) t
+  val ( >|= ) : ('i, 'a) t -> ('a -> 'b) -> ('i, 'b) t
 
-  val ( <*> ) : ('i, 'a -> 'b, 'e) t -> ('i, 'a, 'e) t -> ('i, 'b, 'e) t
+  val ( <*> ) : ('i, 'a -> 'b) t -> ('i, 'a) t -> ('i, 'b) t
 
-  include Shims_let_ops_.S with type ('i, 'o, 'e) t_let = ('i, 'o, 'e) t
+  include Shims_let_ops_.S with type ('i, 'o) t_let = ('i, 'o) t
 end
 
-val fix : (('i, 'a, 'e) t -> ('i, 'a, 'e) t) -> ('i, 'a, 'e) t
+val fix : (('i, 'a) t -> ('i, 'a) t) -> ('i, 'a) t
 
-val value : ('i, 'i, 'e) t
+val value : ('i, 'i) t
 
-val maybe : ('i, 'a, 'e) t -> ('i, 'a option, 'e) t
+val maybe : ('i, 'a) t -> ('i, 'a option) t
 
 val one_of :
-  combine_errors:('e list -> 'e) -> ('i, 'o, 'e) t list -> ('i, 'o, 'e) t
+  ('i, 'o) t list -> ('i, 'o) t
 
 val pick :
-     combine_errors:('e list -> 'e)
-  -> ('i, ('i, 'o, 'e) t, 'e) t list
-  -> ('i, 'o, 'e) t
+  ('i, ('i, 'o) t) t list
+  -> ('i, 'o) t
 
-val of_to_opt : ('i -> 'o option) -> ('i -> ('o, 'e) result) -> ('i, 'o, 'e) t
+val of_to_opt : ('i -> 'o option) -> ('i -> ('o, 'i Error.t) result) -> ('i, 'o) t

src/gen/mkshims.ml

@@ -3,37 +3,37 @@
 let shims_all =
   {|
   module type I = sig
-    type ('i, 'a, 'e) t
-    val (>|=) : ('i, 'a, 'e) t -> ('a -> 'b) -> ('i, 'b, 'e) t
-    val monoid_product : ('i, 'a, 'e) t -> ('i, 'b, 'e) t -> ('i, ('a * 'b), 'e) t
-    val (>>=) : ('i, 'a, 'e) t -> ('a -> ('i, 'b, 'e) t) -> ('i, 'b, 'e) t
+    type ('i, 'a) t
+    val (>|=) : ('i, 'a) t -> ('a -> 'b) -> ('i, 'b) t
+    val monoid_product : ('i, 'a) t -> ('i, 'b) t -> ('i, ('a * 'b)) t
+    val (>>=) : ('i, 'a) t -> ('a -> ('i, 'b) t) -> ('i, 'b) t
   end
 |}
 
 
 let shims_let_op_pre_408 =
   {|
-  module type S = sig type ('i, 'o, 'e) t_let end
-   module Make(X : I) : S with type ('i, 'o, 'e) t_let = ('i, 'o, 'e) X.t =
+  module type S = sig type ('i, 'o) t_let end
+   module Make(X : I) : S with type ('i, 'o) t_let = ('i, 'o) X.t =
   struct
-    type ('i, 'o, 'e) t_let = ('i, 'o, 'e) X.t
+    type ('i, 'o) t_let = ('i, 'o) X.t
   end
 |}
 
 
 let shims_let_op_post_408 =
   {|
   module type S = sig
-    type ('i, 'o, 'e) t_let
-    val ( let+ ) : ('i, 'a, 'e) t_let -> ('a -> 'b) -> ('i, 'b, 'e) t_let
-    val ( and+ ) : ('i, 'a, 'e) t_let -> ('i, 'b, 'e) t_let -> ('i, 'a * 'b, 'e) t_let
-    val ( let* ) : ('i, 'a, 'e) t_let -> ('a -> ('i, 'b, 'e) t_let) -> ('i, 'b, 'e) t_let
-    val ( and* ) : ('i, 'a, 'e) t_let -> ('i, 'b, 'e) t_let -> ('i, 'a * 'b, 'e) t_let
+    type ('i, 'o) t_let
+    val ( let+ ) : ('i, 'a) t_let -> ('a -> 'b) -> ('i, 'b) t_let
+    val ( and+ ) : ('i, 'a) t_let -> ('i, 'b) t_let -> ('i, 'a * 'b) t_let
+    val ( let* ) : ('i, 'a) t_let -> ('a -> ('i, 'b) t_let) -> ('i, 'b) t_let
+    val ( and* ) : ('i, 'a) t_let -> ('i, 'b) t_let -> ('i, 'a * 'b) t_let
   end
 
-  module Make(X : I) : S with type ('i, 'o, 'e) t_let = ('i, 'o, 'e) X.t =
+  module Make(X : I) : S with type ('i, 'o) t_let = ('i, 'o) X.t =
   struct
-    type ('i, 'o, 'e) t_let = ('i, 'o, 'e) X.t
+    type ('i, 'o) t_let = ('i, 'o) X.t
     let (let+) = X.(>|=)
     let (and+) = X.monoid_product
     let (let*) = X.(>>=)

src/sig.ml

@@ -23,7 +23,7 @@ module type S = sig
 
       To run a decoder, pass it to {!val:decode_value}.
   *)
-  type 'a decoder = (value, 'a, error) Decoder.t
+  type 'a decoder = (value, 'a) Decoder.t
 
   (** {2 Primitives} *)