Revert infix-form list formatting to pre-0.17.0 (#1717)

The formatting of infix-form lists looks like it used to pre- #1567

Author: gpetiot

CHANGES.md

@@ -51,6 +51,8 @@
   + Depend on `odoc-parser` instead of `odoc` (#1683, #1713, @kit-ty-kate, @jonludlam, @julow)
     The parser from odoc has been split from the main odoc package and put into its own package, `odoc-parser`.
 
+  + Revert infix-form list formatting to pre-0.17.0 (#1717, @gpetiot)
+
 #### New features
 
   + Implement OCaml 4.13 features

lib/Fmt_ast.ml

@@ -2004,9 +2004,8 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
   | Pexp_construct (lid, None) ->
       Params.parens_if parens c.conf (fmt_longident_loc c lid $ fmt_atrs)
   | Pexp_construct
-      ( {txt= Lident "::"; loc}
-      , Some {pexp_desc= Pexp_tuple [x; y]; pexp_attributes= []; pexp_loc; _}
-      ) -> (
+      ( {txt= Lident "::"; loc= _}
+      , Some {pexp_desc= Pexp_tuple [_; _]; pexp_attributes= []; _} ) -> (
     match Sugar.list_exp c.cmts exp with
     | Some (loc_xes, nil_loc) ->
         let p = Params.get_list_expr c.conf in
@@ -2025,14 +2024,13 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
                  $ Cmts.fmt_after c ~pro:(fmt "@ ") ~epi:noop nil_loc )
              $ fmt_atrs ) )
     | None ->
-        Params.parens_if parens c.conf
-        @@ Cmts.fmt c pexp_loc
+        let loc_args = Sugar.infix_cons c.cmts xexp in
+        Cmts.fmt c pexp_loc
         @@ hvbox indent_wrap
-             ( fmt_expression c (sub_exp ~ctx x)
-             $ fmt "@ "
-             $ hovbox 0
-                 ( Cmts.fmt c ~pro:noop loc (fmt "::@ ")
-                 $ fmt_expression c (sub_exp ~ctx y) )
+             ( fmt_infix_op_args c ~parens xexp
+                 (List.map loc_args ~f:(fun (loc, arg) ->
+                      let fmt_op = opt loc (fmt_longident_loc c) in
+                      (false, noop, noop, (fmt_op, [(Nolabel, arg)])) ) )
              $ fmt_atrs ) )
   | Pexp_construct (({txt= Lident "::"; loc= _} as lid), Some arg) ->
       let opn, cls =

lib/Sugar.ml

@@ -204,6 +204,36 @@ let list_exp cmts exp =
   in
   list_exp_ exp []
 
+let infix_cons cmts xexp =
+  let rec infix_cons_ ?cons_opt ({ast= exp; _} as xexp) acc =
+    let ctx = Exp exp in
+    let {pexp_desc; pexp_loc= l1; _} = exp in
+    match pexp_desc with
+    | Pexp_construct
+        ( ({txt= Lident "::"; _} as cons)
+        , Some
+            { pexp_desc= Pexp_tuple [hd; tl]
+            ; pexp_loc= l3
+            ; pexp_attributes= []
+            ; _ } ) -> (
+        ( match acc with
+        | [] -> ()
+        | _ ->
+            Cmts.relocate cmts ~src:l1 ~before:hd.pexp_loc ~after:tl.pexp_loc
+        ) ;
+        Cmts.relocate cmts ~src:l3 ~before:hd.pexp_loc ~after:tl.pexp_loc ;
+        match tl.pexp_attributes with
+        | [] ->
+            infix_cons_ ~cons_opt:cons (sub_exp ~ctx tl)
+              ((cons_opt, sub_exp ~ctx hd) :: acc)
+        | _ ->
+            (Some cons, sub_exp ~ctx tl)
+            :: (cons_opt, sub_exp ~ctx hd)
+            :: acc )
+    | _ -> (cons_opt, xexp) :: acc
+  in
+  List.rev @@ infix_cons_ xexp []
+
 let rec ite cmts ({ast= exp; _} as xexp) =
   let ctx = Exp exp in
   let {pexp_desc; pexp_loc; pexp_attributes; _} = exp in

lib/Sugar.mli

@@ -81,6 +81,13 @@ val list_exp :
 (** [list_exp cmts exp] returns a list of expressions if [exp] is an
     expression corresponding to a list (empty list or (::) application). *)
 
+val infix_cons :
+     Cmts.t
+  -> expression Ast.xt
+  -> (Longident.t loc option * expression Ast.xt) list
+(** [infix_cons exp] returns a list of expressions if [exp] is an expression
+    corresponding to a list ((::) application). *)
+
 val ite :
      Cmts.t
   -> expression Ast.xt

test/passing/tests/list-space_around.ml.ref

@@ -61,8 +61,30 @@ let x = function
     ] ->
       ()
 
-let _ = f ~x:(a :: b) (* comment *) ~y
+let _ = f (* A *) ~x:(a :: b) (* B *) ~y
 
-let _ = f ((* comment *) x :: y)
+let _ = f (* A *) ~x:((* B *) a :: b (* C *)) (* D *) ~y
+
+let _ = f ~x:((* A *) a (* B *) :: (* C *) b (* D *) :: (* E *) c (* F *)) ~y
+
+let _ = f ((* A *) x (* B *) :: (* C *) y (* D *) :: (* E *) z (* F *))
+
+let _ = abc :: (* def :: *) ghi :: jkl
 
 let _ = abc :: def (* :: ghi *) :: jkl
+
+let _ = (c :: l1) @ foo (l2 @ l)
+
+let _ =
+  make_single_trace create_loc message
+  :: make_single_trace create_loc create_message
+  :: List.map call_chain ~f:(fun foooooooooooooooooooooooooooo ->
+         fooooooooooooooooooooooooooooooo foooooooooooo [] )
+  :: foooooooo :: fooooooooooooooooo
+
+let _ =
+  fooooooo
+    ( mk_var i (tfo_combine (nuc_p_o3'_60_tfo n) align) n
+    :: mk_var i (tfo_combine (nuc_p_o3'_180_tfo n) align) n
+    :: mk_var i (tfo_combine (nuc_p_o3'_275_tfo n) align) n
+    :: domains )

test/passing/tests/list.ml

@@ -61,8 +61,30 @@ let x = function
     ] ->
       ()
 
-let _ = f ~x:(a :: b) (* comment *) ~y
+let _ = f (* A *) ~x:(a :: b) (* B *) ~y
 
-let _ = f ((* comment *) x :: y)
+let _ = f (* A *) ~x:((* B *) a :: b (* C *)) (* D *) ~y
+
+let _ = f ~x:((* A *) a (* B *) :: (* C *) b (* D *) :: (* E *) c (* F *)) ~y
+
+let _ = f ((* A *) x (* B *) :: (* C *) y (* D *) :: (* E *) z (* F *))
+
+let _ = abc :: (* def :: *) ghi :: jkl
 
 let _ = abc :: def (* :: ghi *) :: jkl
+
+let _ = (c :: l1) @ foo (l2 @ l)
+
+let _ =
+  make_single_trace create_loc message
+  :: make_single_trace create_loc create_message
+  :: List.map call_chain ~f:(fun foooooooooooooooooooooooooooo ->
+         fooooooooooooooooooooooooooooooo foooooooooooo [] )
+  :: foooooooo :: fooooooooooooooooo
+
+let _ =
+  fooooooo
+    ( mk_var i (tfo_combine (nuc_p_o3'_60_tfo n) align) n
+    :: mk_var i (tfo_combine (nuc_p_o3'_180_tfo n) align) n
+    :: mk_var i (tfo_combine (nuc_p_o3'_275_tfo n) align) n
+    :: domains )