Skip to content

Commit a572aee

Browse files
gpetiotgpetiot
authored
Extract a fmt_attribute function from fmt_attributes (#1744)
1 parent 1a94362 commit a572aee

File tree

1 file changed

+40
-47
lines changed

1 file changed

+40
-47
lines changed

‎lib/Fmt_ast.ml

Lines changed: 40 additions & 47 deletions
Original file line numberDiff line numberDiff line change
@@ -539,46 +539,40 @@ and fmt_attribute_or_extension c key (pre, pld) =
539539
$ fmt_payload c (Pld pld) pld
540540
$ fmt_if (Exposed.Right.payload pld) " " )
541541

542+
and fmt_attribute c ~key {attr_name; attr_payload; attr_loc} =
543+
hvbox 0 @@ Cmts.fmt c attr_loc
544+
@@
545+
match (attr_name, attr_payload) with
546+
| ( {txt= ("ocaml.doc" | "ocaml.text") as txt; loc= {loc_ghost= true; _}}
547+
, PStr
548+
[ { pstr_desc=
549+
Pstr_eval
550+
( { pexp_desc= Pexp_constant (Pconst_string (doc, _, None))
551+
; pexp_attributes= []
552+
; _ }
553+
, [] )
554+
; _ } ] ) ->
555+
fmt_or (String.equal txt "ocaml.text") "@ " " "
556+
$ wrap "(**" "*)" (str doc)
557+
| name, pld ->
558+
let indent =
559+
match pld with
560+
| (PStr _ | PSig _) when String.equal key "@@@" ->
561+
c.conf.stritem_extension_indent
562+
| _ -> c.conf.extension_indent
563+
in
564+
hvbox indent (fmt_attribute_or_extension c key (name, pld))
565+
542566
and fmt_attributes c ?pre ?suf ~key attrs =
543-
let pre =
544-
match pre with
545-
(* Breaking before an attribute can confuse ocp-indent that will produce
546-
a suboptimal indentation. *)
547-
| Some Space when c.conf.ocp_indent_compat -> Some Blank
548-
| Some pre -> Some pre
549-
| None -> None
550-
in
551-
let pre = Option.map pre ~f:sp in
552-
let fmt_attribute c pre = function
553-
| ( {txt= ("ocaml.doc" | "ocaml.text") as txt; loc= {loc_ghost= true; _}}
554-
, PStr
555-
[ { pstr_desc=
556-
Pstr_eval
557-
( { pexp_desc= Pexp_constant (Pconst_string (doc, _, None))
558-
; pexp_attributes= []
559-
; _ }
560-
, [] )
561-
; _ } ] ) ->
562-
fmt_or (String.equal txt "ocaml.text") "@ " " "
563-
$ wrap "(**" "*)" (str doc)
564-
| name, pld ->
565-
let indent =
566-
match pld with
567-
| (PStr _ | PSig _) when String.equal pre "@@@" ->
568-
c.conf.stritem_extension_indent
569-
| _ -> c.conf.extension_indent
570-
in
571-
hvbox indent (fmt_attribute_or_extension c pre (name, pld))
572-
in
573567
let num = List.length attrs in
574-
let fmt_attr ~first ~last {attr_name; attr_payload; attr_loc} =
575-
fmt_or_k first (open_hvbox 0) (fmt "@ ")
576-
$ hvbox 0
577-
(Cmts.fmt c attr_loc (fmt_attribute c key (attr_name, attr_payload)))
578-
$ fmt_if_k last (close_box $ fmt_opt suf)
579-
in
580568
fmt_if_k (num > 0)
581-
(fmt_opt pre $ hvbox_if (num > 1) 0 (list_fl attrs fmt_attr))
569+
( opt pre (function
570+
(* Breaking before an attribute can confuse ocp-indent that will
571+
produce a suboptimal indentation. *)
572+
| Space when c.conf.ocp_indent_compat -> sp Blank
573+
| pre -> sp pre )
574+
$ hvbox_if (num > 1) 0
575+
(hvbox 0 (list attrs "@ " (fmt_attribute c ~key)) $ opt suf str) )
582576

583577
and fmt_payload c ctx pld =
584578
protect c (Pld pld)
@@ -1574,7 +1568,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
15741568
( str "%"
15751569
$ hovbox 2
15761570
( fmt_str_loc c name $ str " fun "
1577-
$ fmt_attributes c ~suf:(str " ") call.pexp_attributes
1571+
$ fmt_attributes c ~suf:" " call.pexp_attributes
15781572
~key:"@"
15791573
$ fmt_fun_args c xargs $ fmt_opt fmt_cstr $ fmt "@ ->"
15801574
)
@@ -1608,7 +1602,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
16081602
( str "%"
16091603
$ hovbox 2
16101604
( fmt_str_loc c name $ str " fun "
1611-
$ fmt_attributes c ~suf:(str " ") retn.pexp_attributes
1605+
$ fmt_attributes c ~suf:" " retn.pexp_attributes
16121606
~key:"@"
16131607
$ fmt_fun_args c xargs $ fmt_opt fmt_cstr $ fmt "@ ->"
16141608
)
@@ -1717,8 +1711,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
17171711
( fmt_expression c (sub_exp ~ctx op)
17181712
$ fmt "@ " $ cmts_before $ fmt_if parens_r "("
17191713
$ str "fun " )
1720-
$ fmt_attributes c ~key:"@" pexp_attributes
1721-
~suf:(str " ")
1714+
$ fmt_attributes c ~key:"@" pexp_attributes ~suf:" "
17221715
$ hvbox_if
17231716
(not c.conf.wrap_fun_args)
17241717
4
@@ -1844,7 +1837,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
18441837
( hvbox 2
18451838
( fmt "(fun@ "
18461839
$ fmt_attributes c ~key:"@"
1847-
eN1.pexp_attributes ~suf:(str " ")
1840+
eN1.pexp_attributes ~suf:" "
18481841
$ fmt_fun_args c xargs $ fmt_opt fmt_cstr
18491842
)
18501843
$ fmt "@ ->" ) )
@@ -2082,7 +2075,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
20822075
( hovbox 2
20832076
( hovbox 4
20842077
( str "fun "
2085-
$ fmt_attributes c ~key:"@" pexp_attributes ~suf:(str " ")
2078+
$ fmt_attributes c ~key:"@" pexp_attributes ~suf:" "
20862079
$ hvbox_if
20872080
(not c.conf.wrap_fun_args)
20882081
0 (fmt_fun_args c xargs)
@@ -2747,7 +2740,7 @@ and fmt_class_expr c ?eol ?(box = true) ({ast= exp; _} as xexp) =
27472740
( hovbox 2
27482741
( box_fun_decl_args c 0
27492742
( str "fun "
2750-
$ fmt_attributes c ~key:"@" pcl_attributes ~suf:(str " ")
2743+
$ fmt_attributes c ~key:"@" pcl_attributes ~suf:" "
27512744
$ wrap_fun_decl_args c (fmt_fun_args c xargs)
27522745
$ fmt "@ " )
27532746
$ str "->" )
@@ -3403,8 +3396,8 @@ and fmt_extension_constructor c sep ctx ec =
34033396
let doc, atrs = doc_atrs pext_attributes in
34043397
let suf =
34053398
match pext_kind with
3406-
| Pext_decl (_, None) | Pext_rebind _ -> noop
3407-
| Pext_decl (_, Some _) -> str " "
3399+
| Pext_decl (_, None) | Pext_rebind _ -> None
3400+
| Pext_decl (_, Some _) -> Some " "
34083401
in
34093402
Cmts.fmt c pext_loc
34103403
@@ hvbox 4
@@ -3418,7 +3411,7 @@ and fmt_extension_constructor c sep ctx ec =
34183411
| Pext_decl (args, res) ->
34193412
fmt_constructor_arguments_result c ctx args res
34203413
| Pext_rebind lid -> str " = " $ fmt_longident_loc c lid )
3421-
$ fmt_attributes c ~pre:(Break (1, 0)) ~key:"@" atrs ~suf
3414+
$ fmt_attributes c ~pre:(Break (1, 0)) ~key:"@" atrs ?suf
34223415
$ fmt_docstring_padded c doc )
34233416

34243417
and fmt_functor_arg c {loc; txt= arg} =

0 commit comments

Comments
 (0)