Don't align breaking module arguments (#2505)

* Don't align module argument types

This alignment is not diff-friendly and is elsewhere recognized as a
bug.

     module Make
         (TT : TableFormat.TABLES)
         (IT : InspectionTableFormat.TABLES with type 'a lr1state = int)
    -    (ET : EngineTypes.TABLE
    -            with type terminal = int
    -             and type nonterminal = int
    -             and type semantic_value = Obj.t)
    +    (ET :
    +      EngineTypes.TABLE
    +        with type terminal = int
    +         and type nonterminal = int
    +         and type semantic_value = Obj.t)
         (E : sig
           type 'a env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env
         end) =

Author: Julow

CHANGES.md

@@ -16,6 +16,7 @@ profile. This started with version 0.26.0.
 - \* Janestreet profile: do not break `fun _ -> function` (#2460, @tdelvecchio-jsc)
 - \* Reduce the indentation of (polytype) type constraints (#2437, @gpetiot)
 - \* Consistent indentation of polymorphic variant arguments (#2427, @Julow)
+- \* Don't align breaking module arguments (#2505, @Julow)
 
 ### Fixed
 

lib/Fmt_ast.ml

@@ -3820,16 +3820,20 @@ and fmt_module c ctx ?rec_ ?epi ?(can_sparse = false) keyword ?(eqty = "=")
         ; psp= fmt_if (Option.is_none blk.pro) "@;<1 2>" $ blk.psp } )
   in
   let blk_b = Option.value_map xbody ~default:empty ~f:(fmt_module_expr c) in
+  let args_p = Params.Mod.get_args c.conf xargs in
   let fmt_name_and_mt ~pro ~loc name mt =
     let xmt = sub_mty ~ctx mt in
     let blk = fmt_module_type c ?rec_ xmt in
+    let align_opn, align_cls =
+      if args_p.align then (open_hvbox 0, close_box) else (noop, noop)
+    in
     let pro =
-      pro $ Cmts.fmt_before c loc $ str "(" $ fmt_str_loc_opt c name
-      $ str " : "
-    and epi = str ")" $ Cmts.fmt_after c loc in
+      pro $ Cmts.fmt_before c loc $ str "(" $ align_opn
+      $ fmt_str_loc_opt c name $ str " :"
+      $ fmt_or_k (Option.is_some blk.pro) (str " ") (break 1 2)
+    and epi = str ")" $ Cmts.fmt_after c loc $ align_cls in
     compose_module' ~box:false ~pro ~epi blk
   in
-  let args_p = Params.Mod.get_args c.conf xargs in
   (* Carry the [epi] to be placed in the next argument's box. *)
   let fmt_arg ~pro {loc; txt} =
     let pro = pro $ args_p.arg_psp in

lib/Params.ml

@@ -123,7 +123,7 @@ module Mod = struct
       else List.for_all ~f:arg_is_sig args
     in
     let arg_psp = if dock then str " " else break 1 psp_indent in
-    let align = ocp c in
+    let align = (not dock) && ocp c in
     {dock; arg_psp; indent; align}
 
   let break_constraint c ~rhs =

test/passing/tests/functor.ml

@@ -71,10 +71,11 @@ module type KV_MAKER = functor (G : Irmin_git.G) (C : Irmin.Contents.S) ->
 module Make
     (TT : TableFormat.TABLES)
     (IT : InspectionTableFormat.TABLES with type 'a lr1state = int)
-    (ET : EngineTypes.TABLE
-            with type terminal = int
-             and type nonterminal = int
-             and type semantic_value = Obj.t)
+    (ET :
+      EngineTypes.TABLE
+        with type terminal = int
+         and type nonterminal = int
+         and type semantic_value = Obj.t)
     (E : sig
       type 'a env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env
     end) =

test/passing/tests/js_source.ml.err

@@ -3,3 +3,4 @@ Warning: tests/js_source.ml:9537 exceeds the margin
 Warning: tests/js_source.ml:9640 exceeds the margin
 Warning: tests/js_source.ml:9699 exceeds the margin
 Warning: tests/js_source.ml:9781 exceeds the margin
+Warning: tests/js_source.ml:10290 exceeds the margin

test/passing/tests/js_source.ml.ocp

@@ -10287,10 +10287,10 @@ type t =
 
 module Test_gen
     (For_tests : For_tests_gen)
-    (Tested : S_gen
-     with type 'a src := 'a For_tests.Src.t
-     with type 'a dst := 'a For_tests.Dst.t)
-    (Tested : S_gen
+    (Tested :
+       S_gen with type 'a src := 'a For_tests.Src.t with type 'a dst := 'a For_tests.Dst.t)
+    (Tested :
+       S_gen
      with type 'a src := 'a For_tests.Src.t
      with type 'a dst := 'a For_tests.Dst.t
       and type 'a dst := 'a For_tests.Dst.t

test/passing/tests/js_source.ml.ref

@@ -10287,14 +10287,14 @@ type t =
 
 module Test_gen
     (For_tests : For_tests_gen)
-    (Tested : S_gen
-              with type 'a src := 'a For_tests.Src.t
-              with type 'a dst := 'a For_tests.Dst.t)
-    (Tested : S_gen
-              with type 'a src := 'a For_tests.Src.t
-              with type 'a dst := 'a For_tests.Dst.t
-               and type 'a dst := 'a For_tests.Dst.t
-               and type 'a dst := 'a For_tests.Dst.t) =
+    (Tested :
+       S_gen with type 'a src := 'a For_tests.Src.t with type 'a dst := 'a For_tests.Dst.t)
+    (Tested :
+       S_gen
+       with type 'a src := 'a For_tests.Src.t
+       with type 'a dst := 'a For_tests.Dst.t
+        and type 'a dst := 'a For_tests.Dst.t
+        and type 'a dst := 'a For_tests.Dst.t) =
 struct
   open Tested
   open For_tests