Source file Params.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
(**************************************************************************)
(*                                                                        *)
(*                              OCamlFormat                               *)
(*                                                                        *)
(*            Copyright (c) Facebook, Inc. and its affiliates.            *)
(*                                                                        *)
(*      This source code is licensed under the MIT license found in       *)
(*      the LICENSE file in the root directory of this source tree.       *)
(*                                                                        *)
(**************************************************************************)

module Location = Migrate_ast.Location
open Extended_ast
open Asttypes
open Fmt
open Ast

let ocp c = c.Conf.fmt_opts.ocp_indent_compat.v

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
  else if not parens then k
  else
    match c.fmt_opts.indicate_multiline_delimiters.v with
    | `Space ->
        Fmt.fits_breaks "(" "(" $ k $ Fmt.fits_breaks ")" ~hint:(1, 0) ")"
    | `Closing_on_separate_line ->
        Fmt.fits_breaks "(" "(" $ k $ Fmt.fits_breaks ")" ~hint:(1000, 0) ")"
    | `No -> wrap "(" ")" k

let parens c ?disambiguate k = parens_if true c ?disambiguate k

module Exp = struct
  module Infix_op_arg = struct
    let wrap (c : Conf.t) ?(parens_nested = false) ~parens k =
      if parens || parens_nested then
        let opn, hint, cls =
          if parens || Poly.(c.fmt_opts.infix_precedence.v = `Parens) then
            match c.fmt_opts.indicate_multiline_delimiters.v with
            | `Space -> ("( ", Some (1, 0), ")")
            | `No -> ("(", Some (0, 0), ")")
            | `Closing_on_separate_line -> ("(", Some (1000, 0), ")")
          else ("", None, "")
        in
        wrap_if_k (parens || parens_nested) (Fmt.fits_breaks "(" opn)
          (Fmt.fits_breaks ")" ?hint cls)
          k
      else k

    let dock (c : Conf.t) xarg =
      if not c.fmt_opts.ocp_indent_compat.v then false
      else
        match xarg.ast.pexp_desc with
        | Pexp_apply (_, args) -> (
          (* Rhs is an apply and it ends with a [fun]. *)
          match List.last_exn args with
          | _, {pexp_desc= Pexp_fun _ | Pexp_newtype _ | Pexp_function _; _}
            ->
              true
          | _ -> false )
        | Pexp_match _ | Pexp_try _ -> true
        | _ -> false
  end

  let wrap (c : Conf.t) ?(disambiguate = false) ?(fits_breaks = true)
      ?(offset_closing_paren = 0) ~parens k =
    if disambiguate && c.fmt_opts.disambiguate_non_breaking_match.v then
      wrap_if_fits_or parens "(" ")" k
    else if not parens then k
    else if fits_breaks then wrap_fits_breaks ~space:false c "(" ")" k
    else
      match c.fmt_opts.indicate_multiline_delimiters.v with
      | `Space ->
          Fmt.fits_breaks "(" "(" $ k $ Fmt.fits_breaks ")" ~hint:(1, 0) ")"
      | `Closing_on_separate_line ->
          Fmt.fits_breaks "(" "(" $ k
          $ Fmt.fits_breaks ")" ~hint:(1000, offset_closing_paren) ")"
      | `No -> wrap "(" ")" k
end

module Mod = struct
  type args = {dock: bool; arg_psp: Fmt.t; indent: int; align: bool}

  let arg_is_sig arg =
    match arg.txt with
    | Named
        ( _
        , { pmty_desc=
              Pmty_signature _ | Pmty_typeof {pmod_desc= Pmod_structure _; _}
          ; _ } ) ->
        true
    | _ -> false

  let get_args (c : Conf.t) args =
    let indent, psp_indent = if ocp c then (2, 2) else (0, 4) in
    let dock =
      (* ocp-indent-compat: Dock only one argument to avoid alignment of
         subsequent arguments. *)
      if ocp c then match args with [arg] -> arg_is_sig arg | _ -> false
      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
    {dock; arg_psp; indent; align}
end

let get_or_pattern_sep ?(cmts_before = false) ?(space = false) (c : Conf.t)
    ~ctx =
  let nspaces = if cmts_before then 1000 else 1 in
  match ctx with
  | Ast.Exp {pexp_desc= Pexp_function _ | Pexp_match _ | Pexp_try _; _} -> (
    match c.fmt_opts.break_cases.v with
    | `Nested -> break nspaces 0 $ str "| "
    | _ -> (
        let nspaces =
          match c.fmt_opts.break_cases.v with
          | `All | `Vertical -> 1000
          | _ -> nspaces
        in
        match c.fmt_opts.indicate_nested_or_patterns.v with
        | `Space ->
            cbreak ~fits:("", nspaces, "| ")
              ~breaks:("", 0, if space then " | " else " |")
        | `Unsafe_no -> break nspaces 0 $ str "| " ) )
  | _ -> break nspaces 0 $ str "| "

type cases =
  { leading_space: Fmt.t
  ; bar: Fmt.t
  ; box_all: Fmt.t -> Fmt.t
  ; box_pattern_arrow: Fmt.t -> Fmt.t
  ; break_before_arrow: Fmt.t
  ; break_after_arrow: Fmt.t
  ; open_paren_branch: Fmt.t
  ; break_after_opening_paren: Fmt.t
  ; expr_parens: bool option
  ; close_paren_branch: Fmt.t }

let get_cases (c : Conf.t) ~ctx ~first ~last ~xbch:({ast; _} as xast) =
  let indent =
    match (c.fmt_opts.cases_matching_exp_indent.v, (ctx, ast.pexp_desc)) with
    | ( `Compact
      , ( Exp {pexp_desc= Pexp_function _ | Pexp_match _ | Pexp_try _; _}
        , (Pexp_match _ | Pexp_try _ | Pexp_beginend _) ) ) ->
        2
    | _, _ -> c.fmt_opts.cases_exp_indent.v
  in
  let align_nested_match =
    match (ast.pexp_desc, c.fmt_opts.nested_match.v) with
    | (Pexp_match _ | Pexp_try _), `Align -> last
    | _ -> false
  in
  let body_has_parens =
    match ast.pexp_desc with
    | Pexp_tuple _ when Poly.(c.fmt_opts.parens_tuple.v = `Always) ->
        (* [fmt_expression] doesn't respect [~parens] for tuples when this
           option is set to [always]. *)
        true
    | _ -> Ast.Exp.is_symbol ast
  in
  let parens_branch, expr_parens =
    if align_nested_match then (false, Some false)
    else if c.fmt_opts.leading_nested_match_parens.v then (false, None)
    else (parenze_exp xast && not body_has_parens, Some false)
  in
  let indent = if align_nested_match then 0 else indent in
  let beginend =
    match ast with {pexp_desc= Pexp_beginend _; _} -> true | _ -> false
  in
  let open_paren_branch =
    if beginend then fmt "@;<1 0>begin" else fmt_if parens_branch " ("
  in
  let close_paren_branch =
    if beginend then
      let offset =
        match c.fmt_opts.break_cases.v with `Nested -> 0 | _ -> -2
      in
      fits_breaks " end" ~level:1 ~hint:(1000, offset) "end"
    else
      fmt_if_k parens_branch
        ( match c.fmt_opts.indicate_multiline_delimiters.v with
        | `Space -> fmt "@ )"
        | `No -> fmt "@,)"
        | `Closing_on_separate_line -> fmt "@;<1000 -2>)" )
  in
  match c.fmt_opts.break_cases.v with
  | `Fit ->
      { leading_space= fmt_if (not first) "@ "
      ; bar= fmt_or_k first (if_newline "| ") (str "| ")
      ; box_all= hvbox indent
      ; box_pattern_arrow= hovbox 2
      ; break_before_arrow= fmt "@;<1 0>"
      ; break_after_arrow= noop
      ; open_paren_branch
      ; break_after_opening_paren= fmt "@ "
      ; expr_parens
      ; close_paren_branch }
  | `Nested ->
      { leading_space= fmt_if (not first) "@ "
      ; bar= fmt_or_k first (if_newline "| ") (str "| ")
      ; box_all= Fn.id
      ; box_pattern_arrow= hovbox 0
      ; break_before_arrow= fmt "@;<1 2>"
      ; break_after_arrow= fmt_if (not parens_branch) "@;<0 3>"
      ; open_paren_branch
      ; break_after_opening_paren= fmt_or (indent > 2) "@;<1 4>" "@;<1 2>"
      ; expr_parens
      ; close_paren_branch }
  | `Fit_or_vertical ->
      { leading_space= break_unless_newline 1000 0
      ; bar= str "| "
      ; box_all= hovbox indent
      ; box_pattern_arrow= hovbox 0
      ; break_before_arrow= fmt "@;<1 2>"
      ; break_after_arrow= fmt_if (not parens_branch) "@;<0 3>"
      ; open_paren_branch
      ; break_after_opening_paren= fmt "@ "
      ; expr_parens
      ; close_paren_branch }
  | `Toplevel | `All ->
      { leading_space= break_unless_newline 1000 0
      ; bar= str "| "
      ; box_all= hvbox indent
      ; box_pattern_arrow= hovbox 0
      ; break_before_arrow= fmt "@;<1 2>"
      ; break_after_arrow= fmt_if (not parens_branch) "@;<0 3>"
      ; open_paren_branch
      ; break_after_opening_paren= fmt "@ "
      ; expr_parens
      ; close_paren_branch }
  | `Vertical ->
      { leading_space= break_unless_newline 1000 0
      ; bar= str "| "
      ; box_all= hvbox indent
      ; box_pattern_arrow= hovbox 0
      ; break_before_arrow= fmt "@;<1 2>"
      ; break_after_arrow= fmt_if (not parens_branch) "@;<0 3>"
      ; open_paren_branch
      ; break_after_opening_paren= break 1000 0
      ; expr_parens
      ; close_paren_branch }

let wrap_collec c ~space_around opn cls =
  if space_around then wrap_k (str opn $ char ' ') (break 1 0 $ str cls)
  else wrap_fits_breaks c opn cls

let wrap_record (c : Conf.t) =
  wrap_collec c ~space_around:c.fmt_opts.space_around_records.v "{" "}"

let wrap_tuple (c : Conf.t) ~parens ~no_parens_if_break =
  if parens then wrap_fits_breaks c "(" ")"
  else if no_parens_if_break then Fn.id
  else wrap_k (fits_breaks "" "( ") (fits_breaks "" ~hint:(1, 0) ")")

type record_type =
  { docked_before: Fmt.t
  ; break_before: Fmt.t
  ; box_record: Fmt.t -> Fmt.t
  ; box_spaced: bool
  ; sep_before: Fmt.t
  ; sep_after: Fmt.t
  ; break_after: Fmt.t
  ; docked_after: Fmt.t }

let get_record_type (c : Conf.t) =
  let sparse_type_decl = Poly.(c.fmt_opts.type_decl.v = `Sparse) in
  let space = if c.fmt_opts.space_around_records.v then 1 else 0 in
  let dock = c.fmt_opts.dock_collection_brackets.v in
  let break_before, sep_before, sep_after =
    match c.fmt_opts.break_separators.v with
    | `Before ->
        ( fmt_or_k dock (break space 2) (fmt "@ ")
        , fmt_or sparse_type_decl "@;<1000 0>; " "@,; "
        , noop )
    | `After ->
        ( fmt_or_k dock (break space 0) (fmt "@ ")
        , noop
        , fmt_or_k dock
            (fmt_or sparse_type_decl "@;<1000 0>" "@ ")
            (fmt_or sparse_type_decl "@;<1000 2>" "@;<1 2>") )
  in
  { docked_before= fmt_if dock " {"
  ; break_before
  ; box_record= (fun k -> if dock then k else hvbox 0 (wrap_record c k))
  ; box_spaced= c.fmt_opts.space_around_records.v
  ; sep_before
  ; sep_after
  ; break_after= fmt_if_k dock (break space (-2))
  ; docked_after= fmt_if dock "}" }

type elements_collection =
  { box: Fmt.t -> Fmt.t
  ; sep_before: Fmt.t
  ; sep_after_non_final: Fmt.t
  ; sep_after_final: Fmt.t }

type elements_collection_record_expr = {break_after_with: Fmt.t}

type elements_collection_record_pat = {wildcard: Fmt.t}

let get_record_expr (c : Conf.t) =
  let space = if c.fmt_opts.space_around_records.v then 1 else 0 in
  let dock = c.fmt_opts.dock_collection_brackets.v in
  let box k =
    if dock then hvbox 0 (wrap "{" "}" (break space 2 $ k $ break space 0))
    else hvbox 0 (wrap_record c k)
  in
  ( ( match c.fmt_opts.break_separators.v with
    | `Before ->
        { box
        ; sep_before= fmt "@,; "
        ; sep_after_non_final= noop
        ; sep_after_final= noop }
    | `After ->
        { box
        ; sep_before= noop
        ; sep_after_non_final= fmt ";@;<1 2>"
        ; sep_after_final= fmt_if_k dock (fits_breaks ~level:0 "" ";") } )
  , {break_after_with= break 1 2} )

let box_collec (c : Conf.t) =
  match c.fmt_opts.break_collection_expressions.v with
  | `Wrap -> hovbox
  | `Fit_or_vertical -> hvbox

let collection_expr (c : Conf.t) ~space_around opn cls =
  let space = if space_around then 1 else 0 in
  let dock = c.fmt_opts.dock_collection_brackets.v in
  let offset = if dock then -2 else String.length opn - 1 in
  match c.fmt_opts.break_separators.v with
  | `Before ->
      { box=
          (fun k ->
            if dock then
              hvbox 0
                (wrap_k (str opn) (str cls)
                   ( break space (String.length opn + 1)
                   $ box_collec c 0 k $ break space 0 ) )
            else box_collec c 0 (wrap_collec c ~space_around opn cls k) )
      ; sep_before= break 0 offset $ str "; "
      ; sep_after_non_final= noop
      ; sep_after_final= noop }
  | `After ->
      { box=
          (fun k ->
            if dock then
              hvbox 0
                (wrap_k (str opn) (str cls)
                   (break space 2 $ box_collec c 0 k $ break space 0) )
            else box_collec c 0 (wrap_collec c ~space_around opn cls k) )
      ; sep_before= noop
      ; sep_after_non_final=
          fmt_or_k dock (fmt ";@;<1 0>")
            (char ';' $ break 1 (String.length opn + 1))
      ; sep_after_final= fmt_if_k dock (fits_breaks ~level:1 "" ";") }

let get_list_expr (c : Conf.t) =
  collection_expr c ~space_around:c.fmt_opts.space_around_lists.v "[" "]"

let get_array_expr (c : Conf.t) =
  collection_expr c ~space_around:c.fmt_opts.space_around_arrays.v "[|" "|]"

let box_pattern_docked (c : Conf.t) ~ctx ~space_around opn cls k =
  let space = if space_around then 1 else 0 in
  let indent_opn, indent_cls =
    match (ctx, c.fmt_opts.break_separators.v) with
    | Ast.Exp {pexp_desc= Pexp_match _ | Pexp_try _; _}, `Before ->
        (String.length opn - 3, 1 - String.length opn)
    | Ast.Exp {pexp_desc= Pexp_match _ | Pexp_try _; _}, `After -> (-3, 1)
    | Ast.Exp {pexp_desc= Pexp_let _; _}, _ -> (-4, 0)
    | _ -> (0, 0)
  in
  hvbox indent_opn
    (wrap_k (str opn) (str cls) (break space 2 $ k $ break space indent_cls))

let get_record_pat (c : Conf.t) ~ctx =
  let params, _ = get_record_expr c in
  let box =
    if c.fmt_opts.dock_collection_brackets.v then
      box_pattern_docked c ~ctx
        ~space_around:c.fmt_opts.space_around_records.v "{" "}"
    else params.box
  in
  ( {params with box}
  , {wildcard= params.sep_before $ str "_" $ params.sep_after_final} )

let collection_pat (c : Conf.t) ~ctx ~space_around opn cls =
  let params = collection_expr c ~space_around opn cls in
  let box =
    if c.fmt_opts.dock_collection_brackets.v then
      box_collec c 0 >> box_pattern_docked c ~ctx ~space_around opn cls
    else params.box
  in
  {params with box}

let get_list_pat (c : Conf.t) ~ctx =
  collection_pat c ~ctx ~space_around:c.fmt_opts.space_around_lists.v "[" "]"

let get_array_pat (c : Conf.t) ~ctx =
  collection_pat c ~ctx ~space_around:c.fmt_opts.space_around_arrays.v "[|"
    "|]"

type if_then_else =
  { box_branch: Fmt.t -> Fmt.t
  ; cond: Fmt.t
  ; box_keyword_and_expr: Fmt.t -> Fmt.t
  ; branch_pro: Fmt.t
  ; wrap_parens: Fmt.t -> Fmt.t
  ; box_expr: bool option
  ; expr_pro: Fmt.t option
  ; expr_eol: Fmt.t option
  ; break_end_branch: Fmt.t
  ; space_between_branches: Fmt.t }

let get_if_then_else (c : Conf.t) ~first ~last ~parens_bch ~parens_prev_bch
    ~xcond ~xbch ~expr_loc ~fmt_extension_suffix ~fmt_attributes ~fmt_cond =
  let imd = c.fmt_opts.indicate_multiline_delimiters.v in
  let beginend =
    match xbch.Ast.ast with
    | {pexp_desc= Pexp_beginend _; _} -> true
    | _ -> false
  in
  let wrap_parens ~wrap_breaks k =
    if beginend then wrap "begin" "end" (wrap_breaks k)
    else if parens_bch then wrap "(" ")" (wrap_breaks k)
    else k
  in
  let get_parens_breaks ~opn_hint_indent ~cls_hint:(ch_sp, ch_sl) =
    let brk hint = fits_breaks "" ~hint "" in
    let oh_other = ((if beginend then 1 else 0), opn_hint_indent) in
    if beginend then
      let _, offset = ch_sl in
      wrap_k (brk oh_other) (break 1000 offset)
    else
      match imd with
      | `Space -> wrap_k (brk (1, opn_hint_indent)) (brk ch_sp)
      | `No -> wrap_k (brk oh_other) noop
      | `Closing_on_separate_line -> wrap_k (brk oh_other) (brk ch_sl)
  in
  let cond () =
    match xcond with
    | Some xcnd ->
        hvbox 0
          ( hvbox 2
              ( fmt_if (not first) "else "
              $ str "if"
              $ fmt_if_k first (fmt_opt fmt_extension_suffix)
              $ fmt_attributes $ fmt "@ " $ fmt_cond xcnd )
          $ fmt "@ then" )
    | None -> str "else"
  in
  let branch_pro = fmt_or (beginend || parens_bch) " " "@;<1 2>" in
  match c.fmt_opts.if_then_else.v with
  | `Compact ->
      { box_branch= hovbox 2
      ; cond= cond ()
      ; box_keyword_and_expr= Fn.id
      ; branch_pro= fmt_or (beginend || parens_bch) " " "@ "
      ; wrap_parens=
          wrap_parens
            ~wrap_breaks:
              (get_parens_breaks ~opn_hint_indent:0
                 ~cls_hint:((1, 0), (1000, -2)) )
      ; box_expr= Some false
      ; expr_pro= None
      ; expr_eol= None
      ; break_end_branch= noop
      ; space_between_branches= fmt "@ " }
  | `K_R ->
      { box_branch= Fn.id
      ; cond= cond ()
      ; box_keyword_and_expr= Fn.id
      ; branch_pro
      ; wrap_parens= wrap_parens ~wrap_breaks:(wrap_k (break 1000 2) noop)
      ; box_expr= Some false
      ; expr_pro= None
      ; expr_eol= Some (fmt "@;<1 2>")
      ; break_end_branch=
          fmt_if_k (parens_bch || beginend || not last) (break 1000 0)
      ; space_between_branches= fmt_if (beginend || parens_bch) " " }
  | `Fit_or_vertical ->
      { box_branch=
          hovbox
            ( match imd with
            | `Closing_on_separate_line when parens_prev_bch -> -2
            | _ -> 0 )
      ; cond= cond ()
      ; box_keyword_and_expr= Fn.id
      ; branch_pro
      ; wrap_parens=
          wrap_parens
            ~wrap_breaks:
              (get_parens_breaks ~opn_hint_indent:2
                 ~cls_hint:((1, 0), (1000, 0)) )
      ; box_expr= Some false
      ; expr_pro=
          Some
            (fmt_if_k
               (not (Location.is_single_line expr_loc c.fmt_opts.margin.v))
               (break_unless_newline 1000 2) )
      ; expr_eol= Some (fmt "@;<1 2>")
      ; break_end_branch= noop
      ; space_between_branches=
          fmt
            ( match imd with
            | `Closing_on_separate_line when beginend || parens_bch -> " "
            | _ -> "@ " ) }
  | `Vertical ->
      { box_branch= Fn.id
      ; cond= cond ()
      ; box_keyword_and_expr= Fn.id
      ; branch_pro
      ; wrap_parens=
          wrap_parens
            ~wrap_breaks:
              (get_parens_breaks ~opn_hint_indent:2
                 ~cls_hint:((1, 0), (1000, 0)) )
      ; box_expr= None
      ; expr_pro= Some (break_unless_newline 1000 2)
      ; expr_eol= None
      ; break_end_branch= noop
      ; space_between_branches=
          fmt
            ( match imd with
            | `Closing_on_separate_line when parens_bch -> " "
            | _ -> "@ " ) }
  | `Keyword_first ->
      { box_branch= Fn.id
      ; cond=
          opt xcond (fun xcnd ->
              hvbox 2
                ( fmt_or_k first
                    (str "if" $ fmt_opt fmt_extension_suffix)
                    (str "else if")
                $ fmt_attributes
                $ fmt_or (Option.is_some fmt_extension_suffix) "@ " " "
                $ fmt_cond xcnd )
              $ fmt "@ " )
      ; box_keyword_and_expr=
          (fun k -> hvbox 2 (fmt_or (Option.is_some xcond) "then" "else" $ k))
      ; branch_pro= fmt_or (beginend || parens_bch) " " "@ "
      ; wrap_parens=
          wrap_parens
            ~wrap_breaks:
              (get_parens_breaks ~opn_hint_indent:0
                 ~cls_hint:((1, 0), (1000, -2)) )
      ; box_expr= Some false
      ; expr_pro= None
      ; expr_eol= None
      ; break_end_branch= noop
      ; space_between_branches= fmt "@ " }

let match_indent ?(default = 0) (c : Conf.t) ~parens ~(ctx : Ast.t) =
  match (c.fmt_opts.match_indent_nested.v, ctx) with
  | `Always, _ | _, (Top | Sig _ | Str _) -> c.fmt_opts.match_indent.v
  | _, Exp {pexp_desc= Pexp_infix _; _}
    when c.fmt_opts.ocp_indent_compat.v && parens ->
      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 -> "@,, "
  | `After -> ",@;<1 2>"

module Align = struct
  (** 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

  let general (c : Conf.t) t =
    hvbox_if (not c.fmt_opts.align_symbol_open_paren.v) 0 t

  let infix_op = general

  let match_ (c : Conf.t) ~xexp:{ast; ctx} t =
    (* Matches on the RHS of an infix are docked in ocp-indent-compat. *)
    let docked =
      match ctx with
      | Exp {pexp_desc= Pexp_infix (_, _, rhs); _} when phys_equal rhs ast ->
          c.fmt_opts.ocp_indent_compat.v
      | _ -> false
    in
    let align = (not c.fmt_opts.align_symbol_open_paren.v) && not docked in
    hvbox_if align 0 t

  let function_ (c : Conf.t) ~parens ~(ctx0 : Ast.t) ~self t =
    let align =
      match ctx0 with
      | Exp {pexp_desc= Pexp_infix (_, _, {pexp_desc= Pexp_function _; _}); _}
        ->
          false
      | Exp {pexp_desc= Pexp_apply (_, args); _}
        when is_labelled_arg args self ->
          false
      | _ -> parens && not c.fmt_opts.align_symbol_open_paren.v
    in
    hvbox_if align 0 t
end