allow begin end on one line in safe cases

Author: EmileTrotignon

lib/Fmt_ast.ml

@@ -222,10 +222,10 @@ let fmt_item_list c ctx0 update_config ast fmt_item items =
   let loc = Ast.location ctx in
   maybe_disabled c loc [] (fun c -> fmt_item c ctx ~prev ~next itm)
   $ opt next (fun (i_n, c_n) ->
-      fmt_or
-        (break_between c (ctx, c.conf) (ast i_n, c_n.conf))
-        (str "\n" $ force_break)
-        (fmt_or break_struct force_break space_break) )
+        fmt_or
+          (break_between c (ctx, c.conf) (ast i_n, c_n.conf))
+          (str "\n" $ force_break)
+          (fmt_or break_struct force_break space_break) )
 
 let fmt_recmodule c ctx items fmt_item ast sub =
   let update_config c i = update_config c (Ast.attributes (ast i)) in
@@ -473,7 +473,7 @@ let fmt_docstring_around_item' ?(is_val = false) ?(force_before = false)
       let floating_doc, doc =
         doc
         |> List.map ~f:(fun (({txt; loc}, _) as doc) ->
-            (Docstring.parse ~loc txt, doc) )
+               (Docstring.parse ~loc txt, doc) )
         |> List.partition_tf ~f:(fun (_, (_, floating)) -> floating)
       in
       let placement =
@@ -860,8 +860,8 @@ and fmt_core_type c ?(box = true) ?pro ?(pro_space = true) ?constraint_ctx
   update_config_maybe_disabled c ptyp_loc ptyp_attributes
   @@ fun c ->
   ( match pro with
-    | Some pro -> fmt_constraint_sep ~pro_space c pro
-    | None -> noop )
+  | Some pro -> fmt_constraint_sep ~pro_space c pro
+  | None -> noop )
   $
   let doc, atrs = doc_atrs ptyp_attributes in
   Cmts.fmt c ptyp_loc
@@ -1131,8 +1131,8 @@ and fmt_pattern ?ext c ?pro ?parens ?(box = false)
   let parens = match parens with Some b -> b | None -> parenze_pat xpat in
   (match ctx0 with Pat {ppat_desc= Ppat_tuple _; _} -> hvbox 0 | _ -> Fn.id)
   @@ ( match ppat_desc with
-    | Ppat_or _ -> fun k -> Cmts.fmt c ppat_loc @@ k
-    | _ -> fun k -> Cmts.fmt c ppat_loc @@ (fmt_opt pro $ k) )
+     | Ppat_or _ -> fun k -> Cmts.fmt c ppat_loc @@ k
+     | _ -> fun k -> Cmts.fmt c ppat_loc @@ (fmt_opt pro $ k) )
   @@ hovbox_if box 0
   @@ fmt_pattern_attributes c xpat
   @@
@@ -1533,7 +1533,7 @@ and fmt_indexop_access c ctx ~fmt_atrs ~has_attr ~parens x =
                         (str ";" $ space_break)
                         (sub_exp ~ctx >> fmt_expression c) ) )
            $ opt pia_rhs (fun e ->
-               fmt_assign_arrow c $ fmt_expression c (sub_exp ~ctx e) ) )
+                 fmt_assign_arrow c $ fmt_expression c (sub_exp ~ctx e) ) )
        $ fmt_atrs ) )
 
 (** Format a [Pexp_function]. [wrap_intro] wraps up to after the [->] and is
@@ -2740,8 +2740,8 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
                              ( fmt_pattern c ~pro:(if_newline "| ")
                                  (sub_pat ~ctx pc_lhs)
                              $ opt pc_guard (fun g ->
-                                 space_break $ str "when "
-                                 $ fmt_expression c (sub_exp ~ctx g) )
+                                   space_break $ str "when "
+                                   $ fmt_expression c (sub_exp ~ctx g) )
                              $ space_break $ str "->"
                              $ fmt_if parens_here (str " (") ) )
                      $ break 1 2
@@ -3051,10 +3051,9 @@ and fmt_lazy c ~ctx ?(pro = noop) ~fmt_atrs ~infix_ext_attrs ~parens e =
 and fmt_beginend c ~loc ?(box = true) ?(pro = noop) ~ctx ~ctx0 ~fmt_atrs
     ~infix_ext_attrs ~indent_wrap ?eol e =
   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
+  let begin_ = fmt_infix_ext_attrs c ~pro:(str "begin") infix_ext_attrs in
+  let end_ =
+    (if not box then break 1000 (-2) else break 1 0) $ str "end" $ fmt_atrs
   in
   let box_beginend_sb = Params.Exp.box_beginend_subexpr c.conf ~ctx ~ctx0 in
   let beginend_box =
@@ -3448,8 +3447,8 @@ and fmt_case c ctx ~first ~last case =
           ( hvbox 0
               ( fmt_pattern c ~pro:p.bar ~parens:paren_lhs xlhs
               $ opt pc_guard (fun g ->
-                  break 1 2 $ str "when " $ fmt_expression c (sub_exp ~ctx g) )
-              )
+                    break 1 2 $ str "when "
+                    $ fmt_expression c (sub_exp ~ctx g) ) )
           $ p.break_before_arrow $ str "->" $ p.break_after_arrow
           $ p.open_paren_branch )
       $ p.break_after_opening_paren
@@ -3785,9 +3784,9 @@ and fmt_type_extension c ctx
            $ str " +="
            $ fmt_private_flag c ptyext_private
            $ list_fl ptyext_constructors (fun ~first ~last:_ x ->
-               let bar_fits = if first then "" else "| " in
-               cbreak ~fits:("", 1, bar_fits) ~breaks:("", 0, "| ")
-               $ fmt_ctor x ) )
+                 let bar_fits = if first then "" else "| " in
+                 cbreak ~fits:("", 1, bar_fits) ~breaks:("", 0, "| ")
+                 $ fmt_ctor x ) )
        $ fmt_item_attributes c ~pre:(Break (1, 0)) attrs_after )
 
 and fmt_type_exception ~pre c ctx
@@ -4127,46 +4126,46 @@ and fmt_class_types c ~pre ~sep cls =
 and fmt_class_exprs c cls =
   hvbox 0
   @@ list_fl cls (fun ~first ~last:_ cl ->
-      update_config_maybe_disabled_attrs c cl.pci_loc cl.pci_attributes
-      @@ fun c ->
-      let ctx = Cd cl in
-      let xargs = cl.pci_args in
-      let ext = cl.pci_attributes.attrs_extension in
-      let doc_before, doc_after, attrs_before, attrs_after =
-        let force_before = not (Cl.is_simple cl.pci_expr) in
-        fmt_docstring_around_item_attrs ~force_before c cl.pci_attributes
-      in
-      let class_expr =
-        let pro =
-          box_fun_decl_args c 2
-            ( hovbox 2
-                ( str (if first then "class" else "and")
-                $ fmt_if first (fmt_extension_suffix c ext)
-                $ fmt_attributes c ~pre:(Break (1, 0)) attrs_before
-                $ fmt_virtual_flag c cl.pci_virt
-                $ space_break
-                $ fmt_class_params c ctx cl.pci_params
-                $ fmt_str_loc c cl.pci_name )
-            $ fmt_if (not (List.is_empty xargs)) space_break
-            $ wrap_fun_decl_args c (fmt_class_fun_args c xargs) )
-        in
-        let intro =
-          match cl.pci_constraint with
-          | Some ty ->
-              fmt_class_type c
-                ~pro:(pro $ str " :" $ space_break)
-                (sub_cty ~ctx ty)
-          | None -> pro
-        in
-        hovbox 2
-          ( hovbox 2 (intro $ space_break $ str "=")
-          $ space_break
-          $ fmt_class_expr c (sub_cl ~ctx cl.pci_expr) )
-        $ fmt_item_attributes c ~pre:(Break (1, 0)) attrs_after
-      in
-      fmt_if (not first) (str "\n" $ force_break)
-      $ hovbox 0
-        @@ Cmts.fmt c cl.pci_loc (doc_before $ class_expr $ doc_after) )
+         update_config_maybe_disabled_attrs c cl.pci_loc cl.pci_attributes
+         @@ fun c ->
+         let ctx = Cd cl in
+         let xargs = cl.pci_args in
+         let ext = cl.pci_attributes.attrs_extension in
+         let doc_before, doc_after, attrs_before, attrs_after =
+           let force_before = not (Cl.is_simple cl.pci_expr) in
+           fmt_docstring_around_item_attrs ~force_before c cl.pci_attributes
+         in
+         let class_expr =
+           let pro =
+             box_fun_decl_args c 2
+               ( hovbox 2
+                   ( str (if first then "class" else "and")
+                   $ fmt_if first (fmt_extension_suffix c ext)
+                   $ fmt_attributes c ~pre:(Break (1, 0)) attrs_before
+                   $ fmt_virtual_flag c cl.pci_virt
+                   $ space_break
+                   $ fmt_class_params c ctx cl.pci_params
+                   $ fmt_str_loc c cl.pci_name )
+               $ fmt_if (not (List.is_empty xargs)) space_break
+               $ wrap_fun_decl_args c (fmt_class_fun_args c xargs) )
+           in
+           let intro =
+             match cl.pci_constraint with
+             | Some ty ->
+                 fmt_class_type c
+                   ~pro:(pro $ str " :" $ space_break)
+                   (sub_cty ~ctx ty)
+             | None -> pro
+           in
+           hovbox 2
+             ( hovbox 2 (intro $ space_break $ str "=")
+             $ space_break
+             $ fmt_class_expr c (sub_cl ~ctx cl.pci_expr) )
+           $ fmt_item_attributes c ~pre:(Break (1, 0)) attrs_after
+         in
+         fmt_if (not first) (str "\n" $ force_break)
+         $ hovbox 0
+           @@ Cmts.fmt c cl.pci_loc (doc_before $ class_expr $ doc_after) )
 
 and fmt_module c ctx ?rec_ ?epi ?(can_sparse = false) keyword ?(eqty = "=")
     name xargs xbody xmty ~attrs ~rec_flag =
@@ -4277,13 +4276,13 @@ and fmt_module c ctx ?rec_ ?epi ?(can_sparse = false) keyword ?(eqty = "=")
     $ fmt_item_attributes c ~pre:(Break (1, 0)) attrs_after
     $ doc_after
     $ opt epi (fun epi ->
-        fmt_or compact
-          (fmt_or
-             ( Option.is_some blk_b.epi
-             && not c.conf.fmt_opts.ocp_indent_compat.v )
-             (str " ") space_break )
-          (break 1 (-2))
-        $ epi ) )
+          fmt_or compact
+            (fmt_or
+               ( Option.is_some blk_b.epi
+               && not c.conf.fmt_opts.ocp_indent_compat.v )
+               (str " ") space_break )
+            (break 1 (-2))
+          $ epi ) )
 
 and fmt_module_declaration c ~rec_flag ~first {ast= pmd; _} =
   protect c (Md pmd)

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

@@ -576,11 +576,7 @@ let _ =
 
 let _ = ((module[@a] X) [@b])
 
-let _ =
-  begin[@a]
-    x
-  end
-  [@b]
+let _ = begin[@a] x end [@b]
 
 let fold input ~init ~f =
   foldi input ~init ~f:(fun (_ : int) acc x -> f acc x) [@nontail]

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

@@ -283,19 +283,10 @@ let _ = begin%ext end
 let _ = begin%ext end (* foo *)
 let _ = x y
 let _ = (* foo *) x y
-let _ =
-  begin%ext
-    x y
-  end
-let _ =
-  begin%ext
-    (* foo *) x y
-  end
+let _ = begin%ext x y end
+let _ = begin%ext (* foo *) x y end
 
-let _ =
-  begin[@landmark "parse_constant_dividends"]
-    market_data_items := ()
-  end
+let _ = begin[@landmark "parse_constant_dividends"] market_data_items := () end
 
 let () = if a then b (* asd *)
 
@@ -531,11 +522,7 @@ let main =
   | A -> aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
   | B -> bbbbbbbbbbbbbbbbbbbbbb
 
-let _ =
-  begin
-    a
-  end
-  [@a]
+let _ = begin a end [@a]
 
 let () =
   fooooo

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

@@ -316,27 +316,12 @@ let _ = begin end
 let _ = begin end (* foo *)
 let _ = begin%ext end
 let _ = begin%ext end (* foo *)
-let _ =
-  begin
-    x y
-  end
-let _ =
-  begin
-    (* foo *) x y
-  end
-let _ =
-  begin%ext
-    x y
-  end
-let _ =
-  begin%ext
-    (* foo *) x y
-  end
+let _ = begin x y end
+let _ = begin (* foo *) x y end
+let _ = begin%ext x y end
+let _ = begin%ext (* foo *) x y end
 
-let _ =
-  begin[@landmark "parse_constant_dividends"]
-    market_data_items := ()
-  end
+let _ = begin[@landmark "parse_constant_dividends"] market_data_items := () end
 
 let () =
   if a then begin
@@ -611,11 +596,7 @@ let main =
   | A -> aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
   | B -> bbbbbbbbbbbbbbbbbbbbbb
 
-let _ =
-  begin
-    a
-  end
-  [@a]
+let _ = begin a end [@a]
 
 let () =
   fooooo

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

@@ -1,34 +1,9 @@
-let _ =
-  begin%ext
-    y >>= z
-  end
-let _ =
-  [%ext
-    begin
-      y >>= z
-    end]
-let _ =
-  x
-  >>= begin%ext
-    y >>= z
-  end
-let _ =
-  x
-  >>= [%ext
-        begin
-          y >>= z
-        end]
-let _ =
-  f
-    begin%ext
-      y >>= z
-    end
-let _ =
-  f
-    [%ext
-      begin
-        y >>= z
-      end]
+let _ = begin%ext y >>= z end
+let _ = [%ext begin y >>= z end]
+let _ = x >>= begin%ext y >>= z end
+let _ = x >>= [%ext begin y >>= z end]
+let _ = f begin%ext y >>= z end
+let _ = f [%ext begin y >>= z end]
 
 let _ = (module%ext S)
 let _ = [%ext (module S)]

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

@@ -6,15 +6,9 @@ let _ = (* test *) "asd"
 
 let _ = "asd"
 
-let _ =
-  begin
-    (* te""st *) "asd"
-  end
-
-let _ =
-  begin
-    "asd"
-  end
+let _ = begin (* te""st *) "asd" end
+
+let _ = begin "asd" end
 
 let _ = 'a'
 

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

@@ -96,9 +96,7 @@ let () =
   assert%foo[@foo] true;
   lazy%foo[@foo] x;
   object%foo[@foo] end;
-  begin%foo[@foo]
-    3
-  end;
+  begin%foo[@foo] 3 end;
   new%foo[@foo] x;
 
   match%foo[@foo] () with

test/passing/refs.default/attributes.ml.ref

@@ -454,12 +454,7 @@ let _ =
   [@b]
 
 let _ = ((module[@a] X) [@b])
-
-let _ =
-  begin[@a]
-    x
-  end
-  [@b]
+let _ = begin[@a] x end [@b]
 
 let fold input ~init ~f =
   foldi input ~init ~f:(fun (_ : int) acc x -> f acc x) [@nontail]