Improve compatibility with ocp-indent

CHANGES.md

@@ -21,6 +21,7 @@ Tags:
 
 - Compatible with OCaml 5.1.0 (#2412, @Julow)
   The syntax of let-bindings changed sligthly in this version.
+- Improved ocp-indent compatibility (#2428, @Julow)
 - \* Removed extra break in constructor declaration with comment (#2429, @Julow)
 - \* De-indent the `object` keyword in class types (#2425, @Julow)
 - \* Consistent formatting of arrows in class types (#2422, @Julow)

lib/Params.ml

@@ -15,8 +15,23 @@ open Asttypes
 open Fmt
 open Ast
 
+(** Shorthand for a commonly used option. *)
 let ocp c = c.Conf.fmt_opts.ocp_indent_compat.v
 
+(** Whether [exp] occurs in [args] as a labelled argument. *)
+let is_labelled_arg args exp =
+  List.exists
+    ~f:(function
+      | Nolabel, _ -> false
+      | Labelled _, x | Optional _, x -> phys_equal x exp )
+    args
+
+(** Like [is_labelled_arg] but look at an expression's context. *)
+let is_labelled_arg' xexp =
+  match xexp.Ast.ctx with
+  | Exp {pexp_desc= Pexp_apply (_, args); _} -> is_labelled_arg args xexp.ast
+  | _ -> false
+
 let parens_if parens (c : Conf.t) ?(disambiguate = false) k =
   if disambiguate && c.fmt_opts.disambiguate_non_breaking_match.v then
     wrap_if_fits_or parens "(" ")" k
@@ -77,6 +92,13 @@ module Exp = struct
           Fmt.fits_breaks "(" "(" $ k
           $ Fmt.fits_breaks ")" ~hint:(1000, offset_closing_paren) ")"
       | `No -> wrap "(" ")" k
+
+  let box_fun_decl_args c ~parens ~kw ~args ~annot =
+    let box_decl, should_box_args =
+      if ocp c then (hvbox (if parens then 1 else 2), false)
+      else (hovbox 4, not c.fmt_opts.wrap_fun_args.v)
+    in
+    box_decl (kw $ hvbox_if should_box_args 0 args $ fmt_opt annot)
 end
 
 module Mod = struct
@@ -103,6 +125,13 @@ module Mod = struct
     let arg_psp = if dock then str " " else break 1 psp_indent in
     let align = ocp c in
     {dock; arg_psp; indent; align}
+
+  let break_constraint c ~rhs =
+    if ocp c then
+      match rhs.pmty_desc with
+      | Pmty_signature _ when ocp c -> break 1 0
+      | _ -> break 1 2
+    else break 1 2
 end
 
 module Pcty = struct
@@ -582,11 +611,6 @@ let match_indent ?(default = 0) (c : Conf.t) ~parens ~(ctx : Ast.t) =
       2 (* Match is docked *)
   | _ -> default
 
-let function_indent ?(default = 0) (c : Conf.t) ~(ctx : Ast.t) =
-  match (c.fmt_opts.function_indent_nested.v, ctx) with
-  | `Always, _ | _, (Top | Sig _ | Str _) -> c.fmt_opts.function_indent.v
-  | _ -> default
-
 let comma_sep (c : Conf.t) : Fmt.s =
   match c.fmt_opts.break_separators.v with
   | `Before -> "@,, "
@@ -630,3 +654,71 @@ module Align = struct
     in
     hvbox_if align 0 t
 end
+
+module Indent = struct
+  let function_ ?(default = 0) (c : Conf.t) ~parens xexp =
+    match c.fmt_opts.function_indent_nested.v with
+    | `Always -> c.fmt_opts.function_indent.v
+    | _ when ocp c && parens && not (is_labelled_arg' xexp) -> default + 1
+    | _ -> default
+
+  let fun_ ?eol (c : Conf.t) =
+    match c.fmt_opts.function_indent_nested.v with
+    | `Always -> c.fmt_opts.function_indent.v
+    | _ ->
+        if Option.is_none eol then 2
+        else if c.fmt_opts.let_binding_deindent_fun.v then 1
+        else 0
+
+  let fun_type_annot c = if ocp c then 2 else 4
+
+  let fun_args c = if ocp c then 6 else 4
+
+  let docked_function (c : Conf.t) ~parens xexp =
+    if ocp c then if parens then 3 else 2
+    else
+      let default = if c.fmt_opts.wrap_fun_args.v then 2 else 4 in
+      function_ ~default c ~parens:false xexp
+
+  let docked_function_after_fun (c : Conf.t) ~parens ~lbl =
+    if ocp c then if parens && Poly.equal lbl Nolabel then 3 else 2 else 0
+
+  let fun_args_group (c : Conf.t) ~lbl exp =
+    if not (ocp c) then 2
+    else
+      match exp.pexp_desc with
+      | Pexp_function _ -> 2
+      | _ -> ( match lbl with Nolabel -> 3 | _ -> 2 )
+
+  let docked_fun (c : Conf.t) ~source ~loc ~lbl =
+    if not (ocp c) then 2
+    else
+      let loc, if_breaks =
+        match lbl with
+        | Nolabel -> (loc, 3)
+        | Optional x | Labelled x -> (x.loc, 2)
+      in
+      if Source.begins_line ~ignore_spaces:true source loc then if_breaks
+      else 0
+
+  let record_docstring (c : Conf.t) =
+    if ocp c then
+      match c.fmt_opts.break_separators.v with `Before -> -2 | `After -> 0
+    else 4
+
+  let constructor_docstring c = if ocp c then 0 else 4
+
+  let exp_constraint c = if ocp c then 1 else 2
+
+  let assignment_operator_bol c = if ocp c then 0 else 2
+
+  let mod_constraint c ~lhs =
+    if ocp c then match lhs.pmod_desc with Pmod_structure _ -> 0 | _ -> 2
+    else 2
+
+  let mod_unpack_annot c = if ocp c then 0 else 2
+
+  let mty_with c = if ocp c then 0 else 2
+
+  let type_constr c = if ocp c then 2 else 0
+end

lib/Params.mli

@@ -35,6 +35,16 @@ module Exp : sig
     -> parens:bool
     -> Fmt.t
     -> Fmt.t
+
+  val box_fun_decl_args :
+       Conf.t
+    -> parens:bool
+    -> kw:Fmt.t
+    -> args:Fmt.t
+    -> annot:Fmt.t option
+    -> Fmt.t
+  (** Box and assemble the parts [kw] (up to the arguments), [args] and
+      [annot]. *)
 end
 
 module Mod : sig
@@ -46,6 +56,9 @@ module Mod : sig
           (** Whether to align argument types inside their parenthesis. *) }
 
   val get_args : Conf.t -> functor_parameter loc list -> args
+
+  val break_constraint : Conf.t -> rhs:module_type -> Fmt.t
+  (** The break after [:] in a [Pmod_constraint]. *)
 end
 
 module Pcty : sig
@@ -149,12 +162,6 @@ val match_indent : ?default:int -> Conf.t -> parens:bool -> ctx:Ast.t -> int
     option, or using the [default] indentation (0 if not provided) if the
     option does not apply. *)
 
-val function_indent : ?default:int -> Conf.t -> ctx:Ast.t -> int
-(** [function_indent c ~ctx ~default] returns the indentation used for the
-    function in context [ctx], depending on the `function-indent-nested`
-    option, or using the [default] indentation (0 if not provided) if the
-    option does not apply. *)
-
 val comma_sep : Conf.t -> Fmt.s
 (** [comma_sep c] returns the format string used to separate two elements
     with a comma, depending on the `break-separators` option. *)
@@ -169,3 +176,53 @@ module Align : sig
   val function_ :
     Conf.t -> parens:bool -> ctx0:Ast.t -> self:expression -> Fmt.t -> Fmt.t
 end
+
+module Indent : sig
+  (** Indentation of various nodes. *)
+
+  (** Expressions *)
+
+  val function_ :
+    ?default:int -> Conf.t -> parens:bool -> expression Ast.xt -> int
+  (** Check the [function-indent-nested] option, or return [default] (0 if
+      not provided) if the option does not apply. *)
+
+  val fun_ : ?eol:Fmt.t -> Conf.t -> int
+  (** Handle [function-indent-nested]. *)
+
+  val fun_args : Conf.t -> int
+
+  val fun_type_annot : Conf.t -> int
+
+  val docked_fun :
+    Conf.t -> source:Source.t -> loc:Location.t -> lbl:arg_label -> int
+
+  val docked_function : Conf.t -> parens:bool -> expression Ast.xt -> int
+
+  val docked_function_after_fun :
+    Conf.t -> parens:bool -> lbl:arg_label -> int
+
+  val fun_args_group : Conf.t -> lbl:arg_label -> expression -> int
+
+  val record_docstring : Conf.t -> int
+
+  val constructor_docstring : Conf.t -> int
+
+  val exp_constraint : Conf.t -> int
+
+  val assignment_operator_bol : Conf.t -> int
+
+  (** Module expressions *)
+
+  val mod_constraint : Conf.t -> lhs:module_expr -> int
+
+  val mod_unpack_annot : Conf.t -> int
+
+  (** Module types *)
+
+  val mty_with : Conf.t -> int
+
+  (** Types *)
+
+  val type_constr : Conf.t -> int
+end