WIP rewrite of fmt_function from scratch.

Author: EmileTrotignon

bench/bench.ml

@@ -36,13 +36,12 @@ let tests =
     (fun {name; input_name; kind; source; conf; action} ->
       Test.make
         ~name:(Format.sprintf "%s (%s)" name input_name)
-        ( Staged.stage
-        @@ fun () ->
-        match action with
-        | `Format ->
-            ignore
-              (Translation_unit.parse_and_format kind ~input_name ~source
-                 conf ) ) )
+        ( Staged.stage @@ fun () ->
+          match action with
+          | `Format ->
+              ignore
+                (Translation_unit.parse_and_format kind ~input_name ~source
+                   conf ) ) )
     inputs
 
 let benchmark () =
@@ -102,11 +101,13 @@ let json_of_ols_results ?name (results : Bechamel.Analyze.OLS.t results) :
              |> Seq.map (fun (metric_name, ols) ->
                     (metric_name, json_of_ols ols) )
              |> List.of_seq
-             |> fun bindings -> `Assoc bindings
+               |> fun bindings
+             -> `Assoc bindings
            in
            `Assoc [("name", `String test_name); ("metrics", metrics)] )
     |> List.of_seq
-    |> fun items -> `List items
+      |> fun items
+    -> `List items
   in
   let bindings = [("results", results)] in
   let bindings =

lib-rpc-server/ocamlformat_rpc.ml

@@ -95,10 +95,10 @@ let run_format conf x =
 
 let run_format_with_args {Rpc.path; config} conf x =
   let open Result in
-  Option.value_map path ~default:(Ok conf) ~f:run_path
-  >>= fun conf ->
+  Option.value_map path ~default:(Ok conf) ~f:run_path >>= fun conf ->
   Option.value_map config ~default:(Ok conf) ~f:(fun c -> run_config conf c)
-  >>= fun conf -> run_format conf x
+    >>= fun conf
+  -> run_format conf x
 
 let handle_format_error e output = output stdout (`Error e)
 

lib-rpc/ocamlformat_rpc_lib.ml

@@ -33,8 +33,8 @@ module Make (IO : IO) = struct
 
       let query command t =
         let open IO in
-        Protocol.V1.output t.output command
-        >>= fun () -> Protocol.V1.read_input t.input
+        Protocol.V1.output t.output command >>= fun () ->
+        Protocol.V1.read_input t.input
 
       let halt t =
         let open IO in
@@ -45,8 +45,7 @@ module Make (IO : IO) = struct
 
       let config c t =
         let open IO in
-        query (`Config c) t
-        >>= function
+        query (`Config c) t >>= function
         | `Config _ -> return (Ok ())
         | `Error msg -> return (Error (`Msg msg))
         | _ ->
@@ -55,8 +54,7 @@ module Make (IO : IO) = struct
 
       let format x t =
         let open IO in
-        query (`Format x) t
-        >>= function
+        query (`Format x) t >>= function
         | `Format x -> return (Ok x)
         | `Error msg -> return (Error (`Msg msg))
         | _ -> return (Error (`Msg "failing to format input: unknown error"))
@@ -73,8 +71,8 @@ module Make (IO : IO) = struct
 
       let query command t =
         let open IO in
-        Protocol.V2.output t.output command
-        >>= fun () -> Protocol.V2.read_input t.input
+        Protocol.V2.output t.output command >>= fun () ->
+        Protocol.V2.read_input t.input
 
       let halt t =
         let open IO in
@@ -85,8 +83,7 @@ module Make (IO : IO) = struct
 
       let format ~format_args x t =
         let open IO in
-        query (`Format (x, format_args)) t
-        >>= function
+        query (`Format (x, format_args)) t >>= function
         | `Format (x, _args) -> return (Ok x)
         | `Error msg -> return (Error (`Msg msg))
         | _ -> return (Error (`Msg "failing to format input: unknown error"))
@@ -106,10 +103,8 @@ module Make (IO : IO) = struct
     let rec aux = function
       | [] -> return (Error (`Msg "Version negociation failed"))
       | latest :: others -> (
-          Protocol.Init.output oc (`Version latest)
-          >>= fun () ->
-          Protocol.Init.read_input ic
-          >>= function
+          Protocol.Init.output oc (`Version latest) >>= fun () ->
+          Protocol.Init.read_input ic >>= function
           | `Version v when v = latest -> return (get_client ~pid ic oc v)
           | `Version v -> (
             match others with

lib-rpc/protocol.ml

@@ -39,8 +39,7 @@ module Make (IO : IO.S) = struct
 
     let read_input ic =
       let open IO in
-      read ic
-      >>= function
+      read ic >>= function
       | None -> return `Halt
       | Some (Atom "Halt") -> return `Halt
       | Some (List [Atom "Version"; Atom v]) -> return (`Version v)
@@ -66,8 +65,7 @@ module Make (IO : IO.S) = struct
     let read_input ic =
       let open Csexp in
       let open IO in
-      read ic
-      >>= function
+      read ic >>= function
       | None -> return `Halt
       | Some (List [Atom "Format"; Atom x]) -> return (`Format x)
       | Some (List [Atom "Config"; List l]) ->
@@ -113,8 +111,7 @@ module Make (IO : IO.S) = struct
             | List [Atom name; Atom value] -> Some (name, value) | _ -> None )
           csexpl
       in
-      read ic
-      >>= function
+      read ic >>= function
       | None -> return `Halt
       | Some (List (Atom "Format" :: Atom x :: l)) ->
           let extract args csexp =

lib/Chunk.ml

@@ -39,10 +39,8 @@ let is_attr (type a) (fg : a list item) (x : a) =
 
 let is_state_attr fg ~state x =
   let open Option.Monad_infix in
-  is_attr fg x
-  >>= fun (attr, loc) ->
-  Conf.parse_state_attr attr
-  >>= fun new_state ->
+  is_attr fg x >>= fun (attr, loc) ->
+  Conf.parse_state_attr attr >>= fun new_state ->
   match (state, new_state) with
   | `Enable, `Disable -> Some (`Disable, loc)
   | `Disable, `Enable -> Some (`Enable, loc)
@@ -54,8 +52,7 @@ let last_loc (type a) (fg : a list item) (l : a list) =
   | Structure -> List.last l >>| fun x -> x.pstr_loc
   | Signature -> List.last l >>| fun x -> x.psig_loc
   | Use_file -> (
-      List.last l
-      >>= function
+      List.last l >>= function
       | Ptop_def x -> List.last x >>| fun x -> x.pstr_loc
       | Ptop_dir x -> Some x.pdir_loc )
 

lib/Conf.ml

@@ -81,6 +81,7 @@ let conventional_profile from =
   ; indicate_nested_or_patterns= elt `Unsafe_no
   ; infix_precedence= elt `Indent
   ; leading_nested_match_parens= elt false
+  ; legacy_function_decl= elt true
   ; let_and= elt `Compact
   ; let_binding_indent= elt 2
   ; let_binding_deindent_fun= elt true
@@ -150,6 +151,7 @@ let ocamlformat_profile from =
   ; indicate_nested_or_patterns= elt `Space
   ; infix_precedence= elt `Indent
   ; leading_nested_match_parens= elt false
+  ; legacy_function_decl= elt true
   ; let_and= elt `Compact
   ; let_binding_indent= elt 2
   ; let_binding_deindent_fun= elt true
@@ -218,6 +220,7 @@ let janestreet_profile from =
   ; indicate_nested_or_patterns= elt `Unsafe_no
   ; infix_precedence= elt `Parens
   ; leading_nested_match_parens= elt true
+  ; legacy_function_decl= elt true
   ; let_and= elt `Sparse
   ; let_binding_indent= elt 2
   ; let_binding_deindent_fun= elt false
@@ -922,6 +925,14 @@ module Formatting = struct
         update conf ~f:(fun f -> {f with leading_nested_match_parens= elt}) )
       (fun conf -> conf.fmt_opts.leading_nested_match_parens)
 
+  let legacy_function_decl =
+    let doc = "Use legacy formatting for function declarations." in
+    let names = ["legacy-function-decl"] in
+    Decl.flag ~names ~default ~doc ~kind ~allow_inline:true
+      (fun conf elt ->
+        update conf ~f:(fun f -> {f with legacy_function_decl= elt}) )
+      (fun conf -> conf.fmt_opts.legacy_function_decl)
+
   let let_and =
     let doc = "Style of let_and." in
     let names = ["let-and"] in
@@ -1334,6 +1345,7 @@ module Formatting = struct
       ; elt indicate_nested_or_patterns
       ; elt infix_precedence
       ; elt leading_nested_match_parens
+      ; elt legacy_function_decl
       ; elt let_and
       ; elt let_binding_indent
       ; elt let_binding_deindent_fun

lib/Conf_t.ml

@@ -89,6 +89,7 @@ type fmt_opts =
   ; indicate_nested_or_patterns: [`Space | `Unsafe_no] elt
   ; infix_precedence: [`Indent | `Parens] elt
   ; leading_nested_match_parens: bool elt
+  ; legacy_function_decl: bool elt
   ; let_and: [`Compact | `Sparse] elt
   ; let_binding_indent: int elt
   ; let_binding_deindent_fun: bool elt

lib/Conf_t.mli

@@ -86,6 +86,7 @@ type fmt_opts =
   ; indicate_nested_or_patterns: [`Space | `Unsafe_no] elt
   ; infix_precedence: [`Indent | `Parens] elt
   ; leading_nested_match_parens: bool elt
+  ; legacy_function_decl: bool elt
   ; let_and: [`Compact | `Sparse] elt
   ; let_binding_indent: int elt
   ; let_binding_deindent_fun: bool elt