Skip to content

Commit 80f029d

Browse files
committed
err case for several value bindings
1 parent a4304c9 commit 80f029d

File tree

1 file changed

+22
-19
lines changed

1 file changed

+22
-19
lines changed

src/ppx/ppx_deriving_err_case.ml

Lines changed: 22 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -179,25 +179,28 @@ let transform =
179179
object
180180
inherit Ast_traverse.map
181181
method! structure_item it = match it.pstr_desc with
182-
| Pstr_extension (({txt="err_case"; _}, PStr [{pstr_desc=Pstr_value (_, [ vb ]); pstr_loc=loc; _}]), _) ->
183-
let typ, e, pat = match vb.pvb_expr.pexp_desc, vb.pvb_pat.ppat_desc with
184-
| Pexp_constraint (e, typ), (Ppat_constraint ({ppat_desc=p; _}, _) | p) ->
185-
remove_poly typ, e, { vb.pvb_pat with ppat_desc=p }
186-
| _, Ppat_constraint (p, typ) ->
187-
remove_poly typ, vb.pvb_expr, p
188-
| _ -> Location.raise_errorf ~loc "no error type given to derive the error case" in
189-
let code, debug, def = match e.pexp_desc with
190-
| Pexp_constant Pconst_integer (s, _) -> int_of_string s, false, true
191-
| Pexp_record (l, None) -> get_err_case_options ~loc:e.pexp_loc l
192-
| _ -> Location.raise_errorf ~loc:e.pexp_loc "code not found" in
193-
let typ = match typ.ptyp_desc with
194-
| Ptyp_constr ({txt; _}, [])
195-
| Ptyp_constr ({txt=(Ldot (Ldot (Lident "EzAPI", "Err"), "case") | Ldot (Lident "Err", "case")) ; _}, [
196-
{ ptyp_desc = Ptyp_constr ({txt; _}, []); _ }
197-
]) -> Longident.name txt
198-
| _ -> Location.raise_errorf ~loc:typ.ptyp_loc "couldn't find type to derive error case" in
199-
let expr = type_ext_err_case ~loc ~typ ~def code in
200-
let it = pstr_value ~loc Nonrecursive [ value_binding ~loc ~pat ~expr ] in
182+
| Pstr_extension (({txt="err_case"; _}, PStr [{pstr_desc=Pstr_value (_, l); pstr_loc=loc; _}]), _) ->
183+
let l, debug = List.fold_left (fun (acc, acc_debug) vb ->
184+
let typ, e, pat = match vb.pvb_expr.pexp_desc, vb.pvb_pat.ppat_desc with
185+
| Pexp_constraint (e, typ), (Ppat_constraint ({ppat_desc=p; _}, _) | p) ->
186+
remove_poly typ, e, { vb.pvb_pat with ppat_desc=p }
187+
| _, Ppat_constraint (p, typ) ->
188+
remove_poly typ, vb.pvb_expr, p
189+
| _ -> Location.raise_errorf ~loc "no error type given to derive the error case" in
190+
let code, debug, def = match e.pexp_desc with
191+
| Pexp_constant Pconst_integer (s, _) -> int_of_string s, false, true
192+
| Pexp_record (l, None) -> get_err_case_options ~loc:e.pexp_loc l
193+
| _ -> Location.raise_errorf ~loc:e.pexp_loc "code not found" in
194+
let typ = match typ.ptyp_desc with
195+
| Ptyp_constr ({txt; _}, [])
196+
| Ptyp_constr ({txt=(Ldot (Ldot (Lident "EzAPI", "Err"), "case") | Ldot (Lident "Err", "case")) ; _}, [
197+
{ ptyp_desc = Ptyp_constr ({txt; _}, []); _ }
198+
]) -> Longident.name txt
199+
| _ -> Location.raise_errorf ~loc:typ.ptyp_loc "couldn't find type to derive error case" in
200+
let expr = type_ext_err_case ~loc ~typ ~def code in
201+
acc @ [ value_binding ~loc ~pat ~expr ], acc_debug || debug
202+
) ([], false) l in
203+
let it = pstr_value ~loc Nonrecursive l in
201204
if debug then Format.printf "%a@." Pprintast.structure_item it;
202205
it
203206
| _ -> it

0 commit comments

Comments
 (0)