Internal: replace pre_break and if_newline by cbreak (#1090)

CHANGES.md

@@ -15,6 +15,7 @@
 
 #### Internal
 
+  + Replace pre_break and if_newline by cbreak (#1090) (Guillaume Petiot)
   + Use opt and fmt_opt to simplify formatting (#1150) (Guillaume Petiot)
   + Replace inplace formatting by dune staging for make fmt (#1151) (Guillaume Petiot)
   + Refactor code that interprets CLI options (#1127) (Jules Aguillon)

lib/Fmt.ml

@@ -43,6 +43,8 @@ let pp_color_k color_code k fs =
 
 (** Break hints and format strings --------------------------------------*)
 
+let cbreak ~fits ~breaks fs = Format.pp_print_custom_break fs ~fits ~breaks
+
 let break n o fs = Format.pp_print_break fs n o
 
 let noop (_ : Format.formatter) = ()
@@ -108,11 +110,6 @@ let break_unless_newline n o fs = Format.pp_print_or_newline fs n o "" ""
 
 let or_newline fits breaks fs = Format.pp_print_or_newline fs 1 0 fits breaks
 
-(** Conditional on immediately preceding a line break -------------------*)
-
-let pre_break n s o fs =
-  Format.pp_print_custom_break fs ~fits:("", n, "") ~breaks:(s, o, "")
-
 (** Conditional on breaking of enclosing box ----------------------------*)
 
 let fits_breaks ?(force_fit_if = false) ?(force_break_if = false)

lib/Fmt.mli

@@ -42,6 +42,14 @@ val protect : t -> on_error:(exn -> unit) -> t
 val break : int -> int -> t
 (** Format a break hint. *)
 
+val cbreak : fits:string * int * string -> breaks:string * int * string -> t
+(** Format a custom break.
+
+    - [fits = (a, b, c)] formats a string [a], [b] spaces and a string [c] if
+      the line does not break.
+    - [breaks = (d, e, f)] formats a string [d], [e] spaces and a string [f]
+      if the line breaks. *)
+
 val noop : t
 (** Format nothing. *)
 
@@ -106,11 +114,6 @@ val or_newline : string -> string -> t
 (** [or_newline fits breaks] prints [fits] if the line has not just been
     broken, and otherwise prints [breaks]. *)
 
-(** Conditional on immediately preceding a line break -------------------*)
-
-val pre_break : int -> string -> int -> t
-(** Format a pre break hint. *)
-
 (** Conditional on breaking of enclosing box ----------------------------*)
 
 val fits_breaks :

lib/Fmt_ast.ml

@@ -285,7 +285,8 @@ let fmt_constant c ~loc ?epi const =
           let fmt_word ~prev:_ curr ~next =
             match next with
             | Some "" -> str curr $ str " "
-            | Some _ -> str curr $ pre_break 1 " \\" 0
+            | Some _ ->
+                str curr $ cbreak ~fits:("", 1, "") ~breaks:(" \\", 0, "")
             | _ -> str curr
           in
           hovbox_if (List.length words > 1) 0 (list_pn words fmt_word $ epi)
@@ -300,8 +301,10 @@ let fmt_constant c ~loc ?epi const =
             if String.is_empty next then fmt_if_k print_ln (str "\\n")
             else if Char.equal next.[0] ' ' then
               fmt_if_k print_ln (str "\\n")
-              $ pre_break 0 "\\" (-1) $ if_newline "\\"
-            else fmt_if_k print_ln (str "\\n") $ pre_break 0 "\\" 0
+              $ cbreak ~fits:("", 0, "") ~breaks:("\\", -1, "\\")
+            else
+              fmt_if_k print_ln (str "\\n")
+              $ cbreak ~fits:("", 0, "") ~breaks:("\\", 0, "")
           in
           let epi = match next with Some _ -> noop | None -> epi in
           fmt_words ~epi mode curr $ opt next fmt_next

lib/Fmt_odoc.ml

@@ -56,8 +56,6 @@ let str_normalized ?(escape = escape_all) s =
   |> List.filter ~f:(Fn.non String.is_empty)
   |> fun s -> list s "@ " (fun s -> escape s |> str)
 
-let fmt_if_not_empty lst fmt = fmt_if (not (List.is_empty lst)) fmt
-
 let ign_loc ~f with_loc = f with_loc.Location_.value
 
 let fmt_verbatim_block s =
@@ -120,50 +118,57 @@ let list_block_elem elems f =
       in
       f elem $ break)
 
-(* Format each element with [fmt_elem] *)
-let fmt_styled style fmt_elem elems =
-  let s =
-    match style with
-    | `Bold -> "b"
-    | `Italic -> "i"
-    | `Emphasis -> "e"
-    | `Superscript -> "^"
-    | `Subscript -> "_"
-  in
-  wrap "{" "}"
-    (str_normalized s $ fmt_if_not_empty elems "@ " $ list elems "" fmt_elem)
-
-let rec fmt_inline_element : inline_element -> Fmt.t = function
-  | `Space _ -> fmt "@ "
-  | `Word w ->
-      (* Escape lines starting with '+' or '-' *)
-      let escape =
-        fmt_if_k
-          (String.length w > 0 && Char.(w.[0] = '+' || w.[0] = '-'))
-          (if_newline "\\")
-      in
-      escape $ str_normalized w
-  | `Code_span s ->
-      let s = escape_brackets s in
-      hovbox 0 (wrap "[" "]" (str_normalized ~escape:escape_brackets s))
-  | `Raw_markup (lang, s) ->
-      let lang =
-        match lang with Some l -> str_normalized l $ str ":" | None -> noop
-      in
-      wrap "{%%" "%%}" (lang $ str s)
-  | `Styled (style, elems) ->
-      fmt_styled style (ign_loc ~f:fmt_inline_element) elems
-  | `Reference (_kind, ref, txt) ->
-      let ref = fmt "{!" $ fmt_reference ref $ fmt "}" in
-      if List.is_empty txt then ref
-      else wrap "{" "}" (ref $ fmt "@ " $ fmt_inline_elements txt)
-  | `Link (url, txt) -> (
-      let url = wrap "{:" "}" (str_normalized url) in
-      match txt with
-      | [] -> url
-      | txt -> wrap "{" "}" (url $ fmt "@ " $ fmt_inline_elements txt) )
+let space_elt : inline_element with_location =
+  Location_.(at (span []) (`Space ""))
 
-and fmt_inline_elements txt = list txt "" (ign_loc ~f:fmt_inline_element)
+let rec fmt_inline_elements elements =
+  let wrap_elements opn cls ~always_wrap hd = function
+    | [] -> wrap_if always_wrap opn cls hd
+    | tl -> wrap opn cls (hd $ fmt_inline_elements (space_elt :: tl))
+  in
+  let rec aux = function
+    | [] -> noop
+    | `Space _ :: `Word w :: t ->
+        (* Escape lines starting with '+' or '-' *)
+        let escape =
+          if String.length w > 0 && Char.(w.[0] = '+' || w.[0] = '-') then
+            "\\"
+          else ""
+        in
+        cbreak ~fits:("", 1, "") ~breaks:("", 0, escape)
+        $ str_normalized w $ aux t
+    | `Space _ :: t -> fmt "@ " $ aux t
+    | `Word w :: t -> str_normalized w $ aux t
+    | `Code_span s :: t ->
+        let s = escape_brackets s in
+        hovbox 0 (wrap "[" "]" (str_normalized ~escape:escape_brackets s))
+        $ aux t
+    | `Raw_markup (lang, s) :: t ->
+        let lang =
+          match lang with
+          | Some l -> str_normalized l $ str ":"
+          | None -> noop
+        in
+        wrap "{%%" "%%}" (lang $ str s) $ aux t
+    | `Styled (style, elems) :: t ->
+        let s =
+          match style with
+          | `Bold -> "b"
+          | `Italic -> "i"
+          | `Emphasis -> "e"
+          | `Superscript -> "^"
+          | `Subscript -> "_"
+        in
+        wrap_elements "{" "}" ~always_wrap:true (str_normalized s) elems
+        $ aux t
+    | `Reference (_kind, rf, txt) :: t ->
+        let rf = wrap "{!" "}" (fmt_reference rf) in
+        wrap_elements "{" "}" ~always_wrap:false rf txt $ aux t
+    | `Link (url, txt) :: t ->
+        let url = wrap "{:" "}" (str_normalized url) in
+        wrap_elements "{" "}" ~always_wrap:false url txt $ aux t
+  in
+  aux (List.map elements ~f:(ign_loc ~f:Fn.id))
 
 and fmt_nestable_block_element c = function
   | `Paragraph elems -> fmt_inline_elements elems
@@ -242,8 +247,10 @@ let fmt_block_element c = function
         | Some lbl -> str ":" $ str_normalized lbl
         | None -> fmt ""
       in
-      hovbox 0
-        (wrap "{" "}" (str lvl $ lbl $ fmt "@ " $ fmt_inline_elements elems))
+      let elems =
+        if List.is_empty elems then elems else space_elt :: elems
+      in
+      hovbox 0 (wrap "{" "}" (str lvl $ lbl $ fmt_inline_elements elems))
   | #nestable_block_element as elm ->
       hovbox 0 (fmt_nestable_block_element c elm)
 

test/passing/doc_comments-after.ml.ref

@@ -256,11 +256,11 @@ exception A of int
 
 module A = struct
   module B = struct
-    (** It does not try to saturate (2) A = B + C /\ B = D + E => A = C + D
-        \+ E Nor combine more than 2 equations (3) A = B + C /\ B = D + E /\
+    (** It does not try to saturate (1a) A = B + C /\ B = D + E => A = C + D
+        \+ E Nor combine more than 2 equations (1b) A = B + C /\ B = D + E /\
         F = C + D + E => A = F
 
-        xxxxxxxxxxxxxxxxxxxxxxxxxxx (2) A = B + C /\ B = D + E => A = C + D
+        xxxxxxxxxxxxxxxxxxxxxxxxxxxx (2) A = B + C /\ B = D + E => A = C + D
         \- E *)
     let a b = ()
   end

test/passing/doc_comments-before.ml.ref

@@ -256,11 +256,11 @@ exception A of int
 
 module A = struct
   module B = struct
-    (** It does not try to saturate (2) A = B + C /\ B = D + E => A = C + D
-        \+ E Nor combine more than 2 equations (3) A = B + C /\ B = D + E /\
+    (** It does not try to saturate (1a) A = B + C /\ B = D + E => A = C + D
+        \+ E Nor combine more than 2 equations (1b) A = B + C /\ B = D + E /\
         F = C + D + E => A = F
 
-        xxxxxxxxxxxxxxxxxxxxxxxxxxx (2) A = B + C /\ B = D + E => A = C + D
+        xxxxxxxxxxxxxxxxxxxxxxxxxxxx (2) A = B + C /\ B = D + E => A = C + D
         \- E *)
     let a b = ()
   end

test/passing/doc_comments.ml

@@ -257,11 +257,11 @@ exception A of int
 module A = struct
   module B = struct
     (** It does not try to saturate
-        (2) A = B + C  /\  B = D + E  =>  A = C + D + E
+        (1a) A = B + C  /\  B = D + E  =>  A = C + D + E
         Nor combine more than 2 equations
-        (3) A = B + C  /\  B = D + E  /\  F = C + D + E  =>  A = F
+        (1b) A = B + C  /\  B = D + E  /\  F = C + D + E  =>  A = F
 
-        xxxxxxxxxxxxxxxxxxxxxxxxxxx
+        xxxxxxxxxxxxxxxxxxxxxxxxxxxx
         (2) A = B + C  /\  B = D + E  =>  A = C + D - E
     *)
     let a b = ()

test/passing/doc_comments.ml.ref

@@ -256,11 +256,11 @@ exception A of int
 
 module A = struct
   module B = struct
-    (** It does not try to saturate (2) A = B + C /\ B = D + E => A = C + D
-        \+ E Nor combine more than 2 equations (3) A = B + C /\ B = D + E /\
+    (** It does not try to saturate (1a) A = B + C /\ B = D + E => A = C + D
+        \+ E Nor combine more than 2 equations (1b) A = B + C /\ B = D + E /\
         F = C + D + E => A = F
 
-        xxxxxxxxxxxxxxxxxxxxxxxxxxx (2) A = B + C /\ B = D + E => A = C + D
+        xxxxxxxxxxxxxxxxxxxxxxxxxxxx (2) A = B + C /\ B = D + E => A = C + D
         \- E *)
     let a b = ()
   end

test/passing/doc_comments.mli

@@ -438,3 +438,7 @@ let fooooooooooooooooo =
 
 (** {e foooooooo oooooooooo ooooooooo ooooooooo} {{!some ref} fooooooooooooo
     oooooooo oooooooooo} {b fooooooooooooo oooooooooooo oooooo ooooooo} *)
+
+(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooo {b eee + eee eee} *)
+
+(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooooooo {b + eee + eee eee} *)

test/passing/doc_comments.mli.ref

@@ -403,3 +403,9 @@ end
 
 (** {e foooooooo oooooooooo ooooooooo ooooooooo} {{!some ref} fooooooooooooo
     oooooooo oooooooooo} {b fooooooooooooo oooooooooooo oooooo ooooooo} *)
+
+(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooo {b eee
+    \+ eee eee} *)
+
+(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooooooo {b
+    \+ eee + eee eee} *)