Preserve the 'break-colon = before' behavior

ocaml-ppx · Sep 18, 2023 · c89d270 · c89d270
1 parent 6230e01
commit c89d270
Show file tree

Hide file tree

Showing 6 changed files with 65 additions and 40 deletions.
diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
@@ -4293,10 +4293,19 @@ and fmt_value_binding c ~rec_flag ?ext ?in_ ?epi
       | `After -> char ' ' $ str x $ fmt "@ "
     in
     match lb_typ with
-    | `Polynewtype (pvars, xtyp) ->
-        ( fmt_sep ":"
-          $ hvbox 0 (str "type " $ list pvars " " (fmt_str_loc c) $ str ".")
-        , fmt "@ " $ fmt_core_type c xtyp )
+    | `Polynewtype (pvars, xtyp) -> (
+      match c.conf.fmt_opts.break_colon.v with
+      | `Before ->
+          ( noop
+          , fmt_sep ":"
+            $ hvbox 0
+                ( str "type "
+                $ list pvars " " (fmt_str_loc c)
+                $ fmt ".@ " $ fmt_core_type c xtyp ) )
+      | `After ->
+          ( fmt_sep ":"
+            $ hvbox 0 (str "type " $ list pvars " " (fmt_str_loc c) $ str ".")
+          , fmt "@ " $ fmt_core_type c xtyp ) )
     | `Coerce (xtyp1, xtyp2) ->
         ( noop
         , opt xtyp1 (fun xtyp1 -> fmt_sep ":" $ fmt_core_type c xtyp1)

diff --git a/test/passing/tests/break_colon-before.ml.ref b/test/passing/tests/break_colon-before.ml.ref
@@ -77,8 +77,8 @@ let ssmap
     -> unit =
   ()
 
-let long_function_name : type a.
-    a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit =
+let long_function_name
+    : type a. a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit =
  fun () -> ()
 
 let array_fold_transf (f : numbering -> 'a -> numbering * 'b) n (a : 'a array)

diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
@@ -1,5 +1,5 @@
 Warning: tests/js_source.ml:155 exceeds the margin
-Warning: tests/js_source.ml:9514 exceeds the margin
-Warning: tests/js_source.ml:9617 exceeds the margin
-Warning: tests/js_source.ml:9676 exceeds the margin
-Warning: tests/js_source.ml:9758 exceeds the margin
+Warning: tests/js_source.ml:9522 exceeds the margin
+Warning: tests/js_source.ml:9625 exceeds the margin
+Warning: tests/js_source.ml:9684 exceeds the margin
+Warning: tests/js_source.ml:9766 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
@@ -1156,8 +1156,9 @@ let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option
 ;;
 
 (* Auxiliary function to get the type of a case from its selector *)
-let rec get_case : type a b e.
-  (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
+let rec get_case
+  : type a b e.
+    (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
   =
   fun sel cases ->
   match cases with
@@ -1265,8 +1266,9 @@ let ty_abc =
     | `B s -> "B", Some (Tdyn (String, s))
     | `C -> "C", None
   (* Define inj in advance to be able to write the type annotation easily *)
-  and inj : type c.
-    (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
+  and inj
+    : type c.
+      (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
     = function
       | Thd, v -> `A v
       | Ttl Thd, v -> `B v
@@ -1610,8 +1612,13 @@ let rec plus_func : type a b m n. (a, b, m) plus -> (a, b, n) plus -> (m, n) equ
     Eq
 ;;
 
-let rec plus_assoc : type a b c ab bc m n.
-  (a, b, ab) plus -> (ab, c, m) plus -> (b, c, bc) plus -> (a, bc, n) plus -> (m, n) equal
+let rec plus_assoc
+  : type a b c ab bc m n.
+    (a, b, ab) plus
+    -> (ab, c, m) plus
+    -> (b, c, bc) plus
+    -> (a, bc, n) plus
+    -> (m, n) equal
   =
   fun p1 p2 p3 p4 ->
   match p1, p4 with
@@ -1713,8 +1720,8 @@ let rec elem : type h. int -> h avl -> bool =
   | Node (_, l, y, r) -> x = y || if x < y then elem x l else elem x r
 ;;
 
-let rec rotr : type n.
-  n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
+let rec rotr
+  : type n. n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL y tR ->
   match tL with
@@ -1728,8 +1735,8 @@ let rec rotr : type n.
     Inl (Node (Same, Node (Same, a, x, b), z, Node (Less, c, y, tR)))
 ;;
 
-let rec rotl : type n.
-  n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
+let rec rotl
+  : type n. n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL u tR ->
   match tR with
@@ -2227,8 +2234,8 @@ let rec subst : type m1 r t s. (m1, r, t) lam -> (r, s) sub -> (s, t) lam' =
 type closed = rnil
 type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
 
-let rec rule : type a b.
-  (pval, closed, (a, b) tarr) lam -> (pval, closed, a) lam -> b rlam
+let rec rule
+  : type a b. (pval, closed, (a, b) tarr) lam -> (pval, closed, a) lam -> b rlam
   =
   fun v1 v2 ->
   match v1, v2 with
@@ -8596,8 +8603,9 @@ type v =
   | F
   | G
 
-let f : type a b c d e f g.
-  a t * b t * c t * d t * e t * f t * g t * v * (a, b, c, d) u * (e, f, g, g) u -> int
+let f
+  : type a b c d e f g.
+    a t * b t * c t * d t * e t * f t * g t * v * (a, b, c, d) u * (e, f, g, g) u -> int
   = function
     | A, A, A, A, A, A, A, _, U, U -> 1
     | _, _, _, _, _, _, _, G, _, _ -> 1

diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
@@ -1156,8 +1156,9 @@ let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option
 ;;
 
 (* Auxiliary function to get the type of a case from its selector *)
-let rec get_case : type a b e.
-  (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
+let rec get_case
+  : type a b e.
+    (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
   =
   fun sel cases ->
   match cases with
@@ -1265,8 +1266,9 @@ let ty_abc =
     | `B s -> "B", Some (Tdyn (String, s))
     | `C -> "C", None
   (* Define inj in advance to be able to write the type annotation easily *)
-  and inj : type c.
-    (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
+  and inj
+    : type c.
+      (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
     = function
     | Thd, v -> `A v
     | Ttl Thd, v -> `B v
@@ -1610,8 +1612,13 @@ let rec plus_func : type a b m n. (a, b, m) plus -> (a, b, n) plus -> (m, n) equ
     Eq
 ;;
 
-let rec plus_assoc : type a b c ab bc m n.
-  (a, b, ab) plus -> (ab, c, m) plus -> (b, c, bc) plus -> (a, bc, n) plus -> (m, n) equal
+let rec plus_assoc
+  : type a b c ab bc m n.
+    (a, b, ab) plus
+    -> (ab, c, m) plus
+    -> (b, c, bc) plus
+    -> (a, bc, n) plus
+    -> (m, n) equal
   =
   fun p1 p2 p3 p4 ->
   match p1, p4 with
@@ -1713,8 +1720,8 @@ let rec elem : type h. int -> h avl -> bool =
   | Node (_, l, y, r) -> x = y || if x < y then elem x l else elem x r
 ;;
 
-let rec rotr : type n.
-  n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
+let rec rotr
+  : type n. n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL y tR ->
   match tL with
@@ -1728,8 +1735,8 @@ let rec rotr : type n.
     Inl (Node (Same, Node (Same, a, x, b), z, Node (Less, c, y, tR)))
 ;;
 
-let rec rotl : type n.
-  n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
+let rec rotl
+  : type n. n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL u tR ->
   match tR with
@@ -2227,8 +2234,8 @@ let rec subst : type m1 r t s. (m1, r, t) lam -> (r, s) sub -> (s, t) lam' =
 type closed = rnil
 type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
 
-let rec rule : type a b.
-  (pval, closed, (a, b) tarr) lam -> (pval, closed, a) lam -> b rlam
+let rec rule
+  : type a b. (pval, closed, (a, b) tarr) lam -> (pval, closed, a) lam -> b rlam
   =
   fun v1 v2 ->
   match v1, v2 with
@@ -8596,8 +8603,9 @@ type v =
   | F
   | G
 
-let f : type a b c d e f g.
-  a t * b t * c t * d t * e t * f t * g t * v * (a, b, c, d) u * (e, f, g, g) u -> int
+let f
+  : type a b c d e f g.
+    a t * b t * c t * d t * e t * f t * g t * v * (a, b, c, d) u * (e, f, g, g) u -> int
   = function
   | A, A, A, A, A, A, A, _, U, U -> 1
   | _, _, _, _, _, _, _, G, _, _ -> 1

diff --git a/test/passing/tests/ocp_indent_compat.ml b/test/passing/tests/ocp_indent_compat.ml
@@ -84,8 +84,8 @@ let ssmap
   =
   ()
 
-let long_function_name : type a.
-    a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit
+let long_function_name
+    : type a. a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit
   =
  fun () -> ()