Internal: Make Fmt.t abstract (#1109)

CHANGES.md

@@ -1,5 +1,6 @@
 ### (master)
 
+  + Internal: Make Fmt.t abstract (#1109) (Jules Aguillon)
   + Improve: give a hint when warning 50 is raised (#1111) (Guillaume Petiot)
   + Internal: Future-proof Fmt API in case Fmt.t goes abstract (#1106) (Etienne Millon)
   + Fix the default value documentation for max-indent (#1105) (Guillaume Petiot)

src/Cmts.ml

@@ -108,8 +108,7 @@ end = struct
                    (not (List.is_empty children))
                    "@,{" " }" (dump_ tree children) )))
     in
-    if Conf.debug then set_margin 100000000 $ dump_ tree tree.roots
-    else Fn.const ()
+    fmt_if_k Conf.debug (set_margin 100000000 $ dump_ tree tree.roots)
 end
 
 module Loc_tree = struct
@@ -408,8 +407,9 @@ let init map_ast source asts comments_n_docstrings =
           if not (Location.compare loc Location.none = 0) then
             Hashtbl.set t.remaining ~key:loc ~data:()) ;
     if Conf.debug then (
+      let dump fs lt = Fmt.eval fs (Loc_tree.dump lt) in
       Format.eprintf "\nLoc_tree:\n%!" ;
-      Format.eprintf "@\n%a@\n@\n%!" (Fn.flip Loc_tree.dump) loc_tree ) ;
+      Format.eprintf "@\n%a@\n@\n%!" dump loc_tree ) ;
     let locs = Loc_tree.roots loc_tree in
     let cmts = CmtSet.of_list comments in
     match locs with
@@ -447,7 +447,7 @@ let preserve fmt_x x =
   let fs = Format.formatter_of_buffer buf in
   let save = !remove in
   remove := false ;
-  fmt_x x fs ;
+  Fmt.eval fs (fmt_x x) ;
   Format.pp_print_flush fs () ;
   remove := save ;
   Buffer.contents buf
@@ -555,7 +555,7 @@ let fmt_cmts t (conf : Conf.t) ~fmt_code ?pro ?epi ?(eol = Fmt.fmt "@\n")
       in
       list_pn groups (fun ~prev group ~next ->
           fmt_or_k (Option.is_none prev)
-            (Option.call ~f:pro $ open_vbox 0)
+            (fmt_opt pro $ open_vbox 0)
             (fmt "@ ")
           $ ( match group with
             | [] -> impossible "previous match"
@@ -566,9 +566,7 @@ let fmt_cmts t (conf : Conf.t) ~fmt_code ?pro ?epi ?(eol = Fmt.fmt "@\n")
                 $ maybe_newline ~next (List.last_exn group) )
           $ fmt_if_k (Option.is_none next)
               ( close_box
-              $ fmt_or_k eol_cmt
-                  (fmt_or_k adj_cmt adj eol)
-                  (Option.call ~f:epi) ))
+              $ fmt_or_k eol_cmt (fmt_or_k adj_cmt adj eol) (fmt_opt epi) ))
 
 let fmt_before t conf ~fmt_code ?pro ?(epi = Fmt.break_unless_newline 1 0)
     ?eol ?adj =

src/Fmt.ml

@@ -25,6 +25,14 @@ let set_margin n fs = Format.pp_set_geometry fs ~max_indent:n ~margin:(n + 1)
 
 let set_max_indent n fs = Format.pp_set_max_newline_offset fs n
 
+let eval fs t = t fs
+
+let protect t ~on_error fs =
+  try t fs
+  with exn ->
+    Format.pp_print_flush fs () ;
+    on_error exn
+
 (** Debug of formatting -------------------------------------------------*)
 
 let pp_color_k color_code k fs =
@@ -88,6 +96,8 @@ let fmt_or_k cnd t_k f_k fs = if cnd then t_k fs else f_k fs
 
 let fmt_or cnd t f fs = fmt_or_k cnd (fmt t) (fmt f) fs
 
+let fmt_opt opt fs = match opt with Some k -> k fs | None -> ()
+
 (** Conditional on immediately following a line break -------------------*)
 
 let if_newline s fs = Format.pp_print_string_if_newline fs s

src/Fmt.mli

@@ -16,8 +16,8 @@ module Format = Format_
 type s = (unit, Format.formatter, unit) format
 (** Format strings that accept no arguments. *)
 
-type t = Format.formatter -> unit
-(** Format thunks, which accept a formatter buffer and write to it. *)
+type t
+(** Format thunks. *)
 
 val ( $ ) : t -> t -> t
 (** Format concatenation: [a $ b] formats [a], then [b]. *)
@@ -31,6 +31,12 @@ val set_margin : int -> t
 val set_max_indent : int -> t
 (** Set the maximum indentation. *)
 
+val eval : Format.formatter -> t -> unit
+(** [eval fs t] runs format thunk [t] outputting to [fs] *)
+
+val protect : t -> on_error:(exn -> unit) -> t
+(** Catch exceptions raised while formatting. *)
+
 (** Break hints and format strings --------------------------------------*)
 
 val break : int -> int -> t
@@ -84,6 +90,10 @@ val fmt_or : bool -> s -> s -> t
 val fmt_or_k : bool -> t -> t -> t
 (** Conditionally select between two format thunks. *)
 
+val fmt_opt : t option -> t
+(** Optionally format. [fmt_opt (Some t)] is [t] and [fmt_opt None] is
+    [noop]. *)
+
 (** Conditional on immediately following a line break -------------------*)
 
 val if_newline : string -> t