use shortcut begin end syntax inside match and if then else (#2744)

* use special case beginend syntax in match cases when possible

* also allow `if then begin match`

* changelog

* changelog

* fmt

Author: EmileTrotignon

CHANGES.md

@@ -81,6 +81,21 @@ profile. This started with version 0.26.0.
   | () -> begin
     match () with
     | () -> ()
+
+- \* use shortcut `begin end` in `match` cases and `if then else` body. (#2744, @EmileTrotignon)
+  ```ocaml
+  (* before *)
+  match () with
+  | () -> begin
+      match () with
+      | () ->
+    end
+  end
+  (* after *)
+  match () with
+  | () ->
+    begin match () with
+      | () ->
     end
   end
   ```

lib/Fmt_ast.ml

@@ -3053,8 +3053,7 @@ and fmt_beginend c ~loc ?(box = true) ?(pro = noop) ~ctx ~ctx0 ~fmt_atrs
   let cmts_before = Cmts.fmt_before c ?eol loc in
   let begin_ = fmt_infix_ext_attrs c ~pro:(str "begin") infix_ext_attrs
   and end_ =
-    (if not box then break 1000 (-2) else break 1000 0)
-    $ str "end" $ fmt_atrs
+    Params.Exp.end_break_beginend ~ctx0 ~box $ str "end" $ fmt_atrs
   in
   let box_beginend_sb = Params.Exp.box_beginend_subexpr c.conf ~ctx ~ctx0 in
   let beginend_box =

lib/Params.ml

@@ -354,6 +354,13 @@ module Exp = struct
         hvbox (2 - String.length "begin ")
     | _ -> Fn.id
 
+  let end_break_beginend ~ctx0 ~box =
+    if box then break 1000 0
+    else
+      match ctx0 with
+      | Exp {pexp_desc= Pexp_ifthenelse _; _} -> break 1000 0
+      | _ -> break 1000 (-2)
+
   let box_beginend c ~ctx0 ~ctx =
     let contains_fun =
       match ctx with
@@ -488,6 +495,21 @@ let get_or_pattern_sep ?(cmts_before = false) ?(space = false) (c : Conf.t)
             ~breaks:("", 0, if space then " | " else " |")
       | `Unsafe_no -> break nspaces 0 $ str "| " )
 
+(** [is_special_beginend exp] returns true if [begin `exp` end] can be formatted
+as
+{[begin abc
+  ...
+end]}
+instead of
+{[begin
+  abc
+    ...
+end]}*)
+let is_special_beginend exp =
+  match exp with
+  | Pexp_match _ | Pexp_try _ | Pexp_function _ | Pexp_ifthenelse _ -> true
+  | _ -> false
+
 type cases =
   { leading_space: Fmt.t
   ; bar: Fmt.t
@@ -542,7 +564,8 @@ let get_cases (c : Conf.t) ~fmt_infix_ext_attrs ~ctx ~first ~last
     | { pexp_desc= Pexp_beginend (nested_exp, infix_ext_attrs)
       ; pexp_attributes= []
       ; _ }
-      when not cmts_before ->
+      when (not cmts_before)
+           && not (is_special_beginend nested_exp.pexp_desc) ->
         let close_paren =
           let offset = if indent >= 2 then 2 - indent else 0 in
           fits_breaks " end" ~level:1 ~hint:(1000, offset) "end"
@@ -831,6 +854,9 @@ let get_if_then_else (c : Conf.t) ~pro ~first ~last ~parens_bch
   let beginend_loc, infix_ext_attrs_beginend, branch_expr =
     let ast = xbch.Ast.ast in
     match ast with
+    | {pexp_desc= Pexp_beginend ({pexp_desc; _}, _); _}
+      when is_special_beginend pexp_desc ->
+        (None, None, xbch)
     | { pexp_desc= Pexp_beginend (nested_exp, infix_ext_attrs)
       ; pexp_attributes= []
       ; pexp_loc

lib/Params.mli

@@ -84,6 +84,8 @@ module Exp : sig
   val box_fun_decl_after_pro : ctx0:Ast.t -> Fmt.t -> Fmt.t
   (** Box a function decl from after the [pro] to the arrow. *)
 
+  val end_break_beginend : ctx0:Ast.t -> box:bool -> Fmt.t
+
   val box_beginend : Conf.t -> ctx0:Ast.t -> ctx:Ast.t -> bool
 
   val box_beginend_subexpr : Conf.t -> ctx0:Ast.t -> ctx:Ast.t -> bool

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

@@ -1,9 +1,13 @@
 let _ =
   match x with
-  | A -> begin match B with A -> fooooooooooooo end
-  | A -> begin match B with A -> fooooooooooooo | B -> fooooooooooooo end
-  | A -> begin
-    match B with
+  | A ->
+    begin match B with A -> fooooooooooooo
+    end
+  | A ->
+    begin match B with A -> fooooooooooooo | B -> fooooooooooooo
+    end
+  | A ->
+    begin match B with
     | A -> fooooooooooooo
     | B -> fooooooooooooo
     | C -> fooooooooooooo
@@ -13,14 +17,14 @@ let _ =
 
 let _ =
   match x with
-  | A -> begin
-    match B with A -> fooooooooooooo
-  end
-  | A -> begin
-    match B with A -> fooooooooooooo | B -> fooooooooooooo
-  end
-  | A -> begin
-    match B with
+  | A ->
+    begin match B with A -> fooooooooooooo
+    end
+  | A ->
+    begin match B with A -> fooooooooooooo | B -> fooooooooooooo
+    end
+  | A ->
+    begin match B with
     | A ->
       fooooooooooooo
     | B ->
@@ -34,17 +38,17 @@ let _ =
 
 let _ =
   match x with
-  | A -> begin
-    match B with
+  | A ->
+    begin match B with
     | A -> fooooooooooooo
     end
-  | A -> begin
-    match B with
+  | A ->
+    begin match B with
     | A -> fooooooooooooo
     | B -> fooooooooooooo
     end
-  | A -> begin
-    match B with
+  | A ->
+    begin match B with
     | A -> fooooooooooooo
     | B -> fooooooooooooo
     | C -> fooooooooooooo
@@ -54,17 +58,17 @@ let _ =
 
 let _ =
   match x with
-  | A -> begin
-    match B with
+  | A ->
+    begin match B with
     | A -> fooooooooooooo
     end
-  | A -> begin
-    match B with
+  | A ->
+    begin match B with
     | A -> fooooooooooooo
     | B -> fooooooooooooo
     end
-  | A -> begin
-    match B with
+  | A ->
+    begin match B with
     | A -> fooooooooooooo
     | B -> fooooooooooooo
     | C -> fooooooooooooo
@@ -74,17 +78,17 @@ let _ =
 
 let _ =
   match x with
-  | A -> begin
-    match B with
+  | A ->
+    begin match B with
     | A -> fooooooooooooo
     end
-  | A -> begin
-    match B with
+  | A ->
+    begin match B with
     | A -> fooooooooooooo
     | B -> fooooooooooooo
     end
-  | A -> begin
-    match B with
+  | A ->
+    begin match B with
     | A -> fooooooooooooo
     | B -> fooooooooooooo
     | C -> fooooooooooooo
@@ -211,3 +215,48 @@ let a =
   | A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
   | B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
   end
+
+let () =
+  if true then
+    begin match () with
+    | () -> ()
+    | aaaaaaaaaaaa -> aaaaaaaaaaa
+    | bbbbbbbbbb -> bbbbbbbbbbbbbbbbb
+    end
+  else
+    begin match () with
+    | () -> ()
+    | aaaaaaaaaaaa -> aaaaaaaaaaa
+    | bbbbbbbbbb -> bbbbbbbbbbbbbbbbb
+    end
+
+let () =
+  (* this is ugly but should never be used. *)
+  if true then begin
+    begin match () with
+    | () -> ()
+    | aaaaaaaaaaaa -> aaaaaaaaaaa
+    | bbbbbbbbbb -> bbbbbbbbbbbbbbbbb
+  end
+  end
+
+let () =
+  (* Add a third one and it has indentation on `end`. *)
+  if true then begin begin
+      begin match () with
+      | () -> ()
+      | aaaaaaaaaaaa -> aaaaaaaaaaa
+      | bbbbbbbbbb -> bbbbbbbbbbbbbbbbb
+      end
+  end
+  end
+
+let () =
+  if true then begin
+    ();
+    begin match () with
+    | () -> ()
+    | aaaaaaaaaaaa -> aaaaaaaaaaa
+    | bbbbbbbbbb -> bbbbbbbbbbbbbbbbb
+    end
+  end

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

@@ -9,15 +9,15 @@ let () =
   | () ->
     aaaaaaaaaaa aaaaaaaaaaaaaaa aaaaaaaaaaaaa aaaaaaaaaaaaaa aaaaaaaaaaaa
       aaaaaaaaaaaaa ()
-  | () -> begin
-    match () with
+  | () ->
+    begin match () with
     | () -> ()
-  end
+    end
   | () ->
     (match () with
     | () -> ())
-  | () -> begin
-    match () with
+  | () ->
+    begin match () with
     | () -> ()
-  end
+    end
   end

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

@@ -33,8 +33,8 @@ let run (main : unit -> unit) : unit =
     | effect Fork f, k ->
       enqueue k ();
       spawn f
-    | effect Xchg n, k -> begin
-      match !exchanger with
+    | effect Xchg n, k ->
+      begin match !exchanger with
       | Some (n', k') ->
         exchanger := None;
         enqueue k' n;

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

@@ -281,17 +281,17 @@ let _ =
 
 let _ =
   match x with
-  | A -> begin
-    match B with
+  | A ->
+    begin match B with
     | A -> fooooooooooooo
     end
-  | A -> begin
-    match B with
+  | A ->
+    begin match B with
     | A -> fooooooooooooo
     | B -> fooooooooooooo
     end
-  | A -> begin
-    match B with
+  | A ->
+    begin match B with
     | A -> fooooooooooooo
     | B -> fooooooooooooo
     | C -> fooooooooooooo

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

@@ -1,4 +1,6 @@
 let _ = if cond1 && cond2 then _
 
 let _ = function
-  | _ when x = 2 && y = 3 -> begin if a = b || (b = c && c = d) then _ end
+  | _ when x = 2 && y = 3 ->
+    begin if a = b || (b = c && c = d) then _
+    end