Handle the ~exn argument

Author: Julow

bin/lwt_log_to_logs/main.ml

@@ -155,18 +155,32 @@ let rewrite_apply_lwt_log ~state (unit, ident) args =
   in
   let logf ~ident ~mk_log logs_name =
     take_lblopt "section" @@ fun section ->
-    ignore_lblarg ~cmt:" Use [Printexc.to_string]." "exn"
-    @@ ignore_lblarg "location" @@ ignore_lblarg "logger" @@ take
+    take_lblopt "exn" @@ fun exn ->
+    ignore_lblarg "location" @@ ignore_lblarg "logger" @@ take
     @@ fun fmt_arg ->
     take_all @@ fun args ->
-    let args = (Nolabel, fmt_arg) :: args in
-    let args =
+    let fmt_arg, args =
       (* Log calls that don't end in [_f] use a ["%s"] format string to avoid
          any typing and escaping issues. *)
-      if String.ends_with ~suffix:"_f" ident || format_safe fmt_arg then args
-      else (Nolabel, Exp.constant (Const.string "%s")) :: args
+      if String.ends_with ~suffix:"_f" ident || format_safe fmt_arg then
+        (fmt_arg, args)
+      else (mk_const_string "%s", (Nolabel, fmt_arg) :: args)
     in
-    Some (mk_log section logs_name args)
+    let fmt_arg, args =
+      (* Print the [exn] argument. *)
+      match exn with
+      | Some (exn, lbl) ->
+          if lbl = `Opt then
+            add_comment state
+              "Last argument is a [exception option] while [exception] is \
+               expected.";
+          ( Exp.infix (mk_loc "^^") fmt_arg (mk_const_string "@\n%s"),
+            args
+            @ [ (Nolabel, mk_apply_simple [ "Printexc"; "to_string" ] [ exn ]) ]
+          )
+      | None -> (fmt_arg, args)
+    in
+    Some (mk_log section logs_name ((Nolabel, fmt_arg) :: args))
   in
   let log_unit ~ident n = logf ~ident ~mk_log n in
   let log_lwt ~ident n =

lib/ocamlformat_utils/ast_utils.ml

@@ -48,12 +48,16 @@ let mk_none_ident = mk_longident [ "None" ]
 let mk_exp_some x = Exp.construct mk_some_ident (Some x)
 let mk_exp_none = Exp.construct mk_none_ident None
 let mk_typ_constr ?(params = []) lid = Typ.constr (mk_longident lid) params
-let mk_const_int i = Exp.constant (Const.integer i)
 let mk_lbl s = Labelled (mk_loc s)
 let mk_lblopt s = Optional (mk_loc s)
 let mk_pat_some arg = mk_constr_pat ~arg [ "Some" ]
 let mk_pat_none = mk_constr_pat [ "None" ]
 
+(* Exp *)
+
+let mk_const_string s = Exp.constant (Const.string s)
+let mk_const_int i = Exp.constant (Const.integer i)
+
 (* Construct [let var = lhs in (rhs var)]. *)
 let mk_let_var ident lhs rhs =
   let pat = Pat.var (mk_loc ident) in

test/lwt_log_to_logs/migrate.t/run.t

@@ -107,10 +107,7 @@
   
   (* Other arguments *)
   let () =
-    Logs.info (fun fmt ->
-        fmt
-          (* TODO: lwt-log-to-logs: Labelled argument ~exn was dropped. Use [Printexc.to_string]. *)
-          "exn")
+    Logs.info (fun fmt -> fmt ("exn" ^^ "@\n%s") (Printexc.to_string Not_found))
 
   let () =
     Logs.info (fun fmt ->
@@ -127,9 +124,10 @@
   (* Other arguments as opt labels *)
   let () =
     Logs.info (fun fmt ->
-        fmt
-          (* TODO: lwt-log-to-logs: Labelled argument ?exn was dropped. Use [Printexc.to_string]. *)
-          "exn")
+        fmt ("exn" ^^ "@\n%s")
+          (Printexc.to_string
+             (* TODO: lwt-log-to-logs: Last argument is a [exception option] while [exception] is expected. *)
+             (Some Not_found)))
 
   let () =
     Logs.info (fun fmt ->
@@ -147,27 +145,30 @@
   [@@@warning "-5"]
 
   let _
+      (* TODO: lwt-log-to-logs: Last argument is a [exception option] while [exception] is expected. *)
       (* TODO: lwt-log-to-logs: Labelled argument ?logger was dropped. *)
-      (* TODO: lwt-log-to-logs: Labelled argument ?location was dropped. *)
-      (* TODO: lwt-log-to-logs: Labelled argument ?exn was dropped. Use [Printexc.to_string]. *)
-      =
+      (* TODO: lwt-log-to-logs: Labelled argument ?location was dropped. *) =
    fun ?section:x1 ?exn:x2 ?location:x3 ?logger:x4 x5 ->
-    Logs.info ?src:x1 (fun fmt -> fmt "%s" x5)
+    Logs.info ?src:x1 (fun fmt ->
+        fmt ("%s" ^^ "@\n%s") x5 (Printexc.to_string x2))
 
   let _ =
    fun ?exn:x1 ?location:x2 ?logger:x3 x4 ->
     Logs.info
       ~src:
+        (* TODO: lwt-log-to-logs: Last argument is a [exception option] while [exception] is expected. *)
         (* TODO: lwt-log-to-logs: Labelled argument ?logger was dropped. *)
         (* TODO: lwt-log-to-logs: Labelled argument ?location was dropped. *)
-        (* TODO: lwt-log-to-logs: Labelled argument ?exn was dropped. Use [Printexc.to_string]. *)
-        section (fun fmt -> fmt "%s" x4)
+        section (fun fmt -> fmt ("%s" ^^ "@\n%s") x4 (Printexc.to_string x1))
 
-  let _
-      (* TODO: lwt-log-to-logs: Labelled argument ~exn was dropped. Use [Printexc.to_string]. *)
-      (* TODO: lwt-log-to-logs: Labelled argument ?logger was dropped. *)
-      (* TODO: lwt-log-to-logs: Labelled argument ?location was dropped. *) =
-   fun ?location:x1 ?logger:x2 x3 -> Logs.info (fun fmt -> fmt "%s" x3)
+  let _ =
+   fun ?location:x1 ?logger:x2 x3 ->
+    Logs.info (fun fmt ->
+        fmt ("%s" ^^ "@\n%s") x3
+          (Printexc.to_string
+             (* TODO: lwt-log-to-logs: Labelled argument ?logger was dropped. *)
+             (* TODO: lwt-log-to-logs: Labelled argument ?location was dropped. *)
+             Not_found))
 
   let _
       (* TODO: lwt-log-to-logs: Labelled argument ~location was dropped. *)