Fix indentation after if .. then (* cmt *) begin (#2785)

This reduce the indentation of the `begin` keyword in this case:

     let () =
       if true then (* a *)
         begin
         ()
       end
       else ()

and fixes an instability issue when the comment was big enough.

Author: Julow

lib/Fmt_ast.ml

@@ -2564,8 +2564,15 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
                              Some (Cmts.fmt_after c keyword_loc)
                            else None
                          in
+                         let cmts_before_opt loc =
+                           if Cmts.has_before c.cmts loc then
+                             Some
+                               (Cmts.fmt_before ~pro:noop ~epi:noop ~eol:noop
+                                  c loc )
+                           else None
+                         in
                          let p =
-                           Params.get_if_then_else c.conf
+                           Params.get_if_then_else c.conf ~cmts_before_opt
                              ~pro:(fmt_if first pro_inner) ~first ~last
                              ~parens_bch ~parens_prev_bch:!parens_prev_bch
                              ~xcond ~xbch ~expr_loc:pexp_loc

lib/Params.ml

@@ -847,8 +847,8 @@ type if_then_else =
   ; break_end_branch: Fmt.t
   ; space_between_branches: Fmt.t }
 
-let get_if_then_else (c : Conf.t) ~pro ~first ~last ~parens_bch
-    ~parens_prev_bch ~xcond ~xbch ~expr_loc ~fmt_infix_ext_attrs
+let get_if_then_else (c : Conf.t) ~cmts_before_opt ~pro ~first ~last
+    ~parens_bch ~parens_prev_bch ~xcond ~xbch ~expr_loc ~fmt_infix_ext_attrs
     ~infix_ext_attrs ~fmt_cond ~cmts_before_kw ~cmts_after_kw =
   let imd = c.fmt_opts.indicate_multiline_delimiters.v in
   let beginend_loc, infix_ext_attrs_beginend, branch_expr =
@@ -889,10 +889,10 @@ let get_if_then_else (c : Conf.t) ~pro ~first ~last ~parens_bch
       | `Closing_on_separate_line ->
           wrap (brk (0, opn_hint_indent)) (brk ch_sl)
   in
-  let cond () =
+  let cond ?(box = hvbox 2) () =
     match xcond with
     | Some xcnd ->
-        hvbox 2
+        box
           ( hvbox 0
               ( hvbox 2
                   ( pro
@@ -902,12 +902,21 @@ let get_if_then_else (c : Conf.t) ~pro ~first ~last ~parens_bch
               $ space_break $ cmts_before_kw $ str "then" )
           $ opt cmts_after_kw Fn.id )
     | None ->
-        cmts_before_kw $ hvbox 2 (pro $ str "else" $ opt cmts_after_kw Fn.id)
+        cmts_before_kw $ box (pro $ str "else" $ opt cmts_after_kw Fn.id)
   in
-  let branch_pro ?(indent = 2) () =
-    if Option.is_some cmts_after_kw then break 1000 indent
-    else if has_beginend || parens_bch then str " "
-    else break 1 indent
+  let has_cmts_after_kw = Option.is_some cmts_after_kw in
+  let branch_pro ?(begin_end_offset = 2) ?(indent = 2)
+      ?(break_before_cmts = break 1000 indent) () =
+    match beginend_loc with
+    | Some loc -> (
+      match cmts_before_opt loc with
+      | Some cmts -> break_before_cmts $ cmts $ break 1000 ~-begin_end_offset
+      | None ->
+          if has_cmts_after_kw then break 1000 ~-begin_end_offset
+          else str " " )
+    | None when has_cmts_after_kw -> break 1000 indent
+    | None when parens_bch -> str " "
+    | None -> break 1 indent
   in
   match c.fmt_opts.if_then_else.v with
   | `Compact ->
@@ -931,7 +940,7 @@ let get_if_then_else (c : Conf.t) ~pro ~first ~last ~parens_bch
       { box_branch= Fn.id
       ; cond= cond ()
       ; box_keyword_and_expr= Fn.id
-      ; branch_pro= branch_pro ()
+      ; branch_pro= branch_pro ~begin_end_offset:0 ()
       ; wrap_parens= wrap_parens ~wrap_breaks:(wrap (break 1000 2) noop)
       ; beginend_loc
       ; box_expr= Some has_beginend
@@ -950,7 +959,7 @@ let get_if_then_else (c : Conf.t) ~pro ~first ~last ~parens_bch
             | _ -> 0 )
       ; cond= cond ()
       ; box_keyword_and_expr= Fn.id
-      ; branch_pro= branch_pro ()
+      ; branch_pro= branch_pro ~begin_end_offset:0 ()
       ; wrap_parens=
           wrap_parens
             ~wrap_breaks:
@@ -975,7 +984,7 @@ let get_if_then_else (c : Conf.t) ~pro ~first ~last ~parens_bch
       { box_branch= Fn.id
       ; cond= cond ()
       ; box_keyword_and_expr= Fn.id
-      ; branch_pro= branch_pro ()
+      ; branch_pro= branch_pro ~begin_end_offset:0 ()
       ; wrap_parens=
           wrap_parens
             ~wrap_breaks:
@@ -1010,7 +1019,7 @@ let get_if_then_else (c : Conf.t) ~pro ~first ~last ~parens_bch
       { box_branch= Fn.id
       ; cond
       ; box_keyword_and_expr= (fun k -> hovbox 2 (keyword $ k))
-      ; branch_pro= branch_pro ~indent:0 ()
+      ; branch_pro= branch_pro ~break_before_cmts:(str " ") ~indent:0 ()
       ; wrap_parens=
           wrap_parens
             ~wrap_breaks:

lib/Params.mli

@@ -220,6 +220,7 @@ type if_then_else =
 
 val get_if_then_else :
      Conf.t
+  -> cmts_before_opt:(Location.t -> Fmt.t option)
   -> pro:Fmt.t
   -> first:bool
   -> last:bool
@@ -234,6 +235,7 @@ val get_if_then_else :
   -> cmts_before_kw:Fmt.t
   -> cmts_after_kw:Fmt.t option
   -> if_then_else
+(** [cmts_before_opt] return the comment before the given location with no breaks around it. *)
 
 val match_indent : ?default:int -> Conf.t -> parens:bool -> ctx:Ast.t -> int
 (** [match_indent c ~ctx ~default] returns the indentation used for the

test/passing/refs.ahrefs/comment_breaking.ml.ref

@@ -6,3 +6,20 @@ let () =
   (* this comment should not change breaking of the following line *)
   foo aaaaaaaaaa bbbbbbbbbb cccccccccc |> (ignore : t -> _);
   bar dddddddddd eeeeeeeeee ffffffffff |> (ignore : t -> _)
+
+type pp_token =
+  | Pp_if_newline
+    (* to do something only if this very
+                                  line has been broken *)
+  | Pp_open_tag of stag (* opening a tag name *)
+  | Pp_close_tag (* closing the most recently open tag *)
+
+let format_pp_token state size = function
+  | Pp_begin (off, ty) ->
+    let insertion_point = state.pp_margin - state.pp_space_left in
+    if insertion_point > state.pp_max_indent then
+      (* can not open a box right there. *)
+    begin
+      pp_force_break_line state
+    end;
+    Stack.push { box_type; width } state.pp_format_stack

test/passing/refs.ahrefs/ite-compact.ml.ref

@@ -178,7 +178,7 @@ let _ = if x then 42 (* dummy *) else if y then z else w
 
 let () =
   if true then (* a *)
-    begin
+  begin
     ()
   end
   else ()

test/passing/refs.ahrefs/ite-compact_closing.ml.ref

@@ -195,7 +195,7 @@ let _ = if x then 42 (* dummy *) else if y then z else w
 
 let () =
   if true then (* a *)
-    begin
+  begin
     ()
   end
   else ()

test/passing/refs.ahrefs/ite-fit_or_vertical.ml.ref

@@ -213,7 +213,7 @@ let _ = if x then 42 (* dummy *) else if y then z else w
 
 let () =
   if true then (* a *)
-    begin
+  begin
     ()
   end
   else

test/passing/refs.ahrefs/ite-fit_or_vertical_closing.ml.ref

@@ -223,7 +223,7 @@ let _ = if x then 42 (* dummy *) else if y then z else w
 
 let () =
   if true then (* a *)
-    begin
+  begin
     ()
   end else
         ()

test/passing/refs.ahrefs/ite-fit_or_vertical_no_indicate.ml.ref

@@ -213,7 +213,7 @@ let _ = if x then 42 (* dummy *) else if y then z else w
 
 let () =
   if true then (* a *)
-    begin
+  begin
     ()
   end
   else

test/passing/refs.ahrefs/ite-kr.ml.ref

@@ -252,7 +252,7 @@ let _ =
 
 let () =
   if true then (* a *)
-    begin
+  begin
     ()
   end else
     ()