Moves module attributes after the module keyword

CHANGES.md

@@ -47,6 +47,9 @@ profile. This started with version 0.26.0.
 - Fix `[@ocamlformat "disable"]` inside `class type` constructs. (#2525, @EmileTrotignon)
 - Fix the formatting of the `in` keyword when `[@ocamlformat disable]` is attached to a let-binding (#2242, @EmileTrotignon)
 
+### Changes
+- The location of attributes for structure items is now tracked and preserved. (#2247, @EmileTrotignon)
+
 ## 0.26.1 (2023-09-15)
 
 ### Changed

lib/Ast.ml

@@ -106,6 +106,10 @@ module Ext = struct
 end
 
 module Ext_attrs = struct
+  let has_attrs = function
+    | {attrs_extension= _; attrs_before= []; attrs_after= []} -> false
+    | _ -> true
+
   let has_doc ea =
     List.exists ~f:Attr.is_doc ea.attrs_before
     || List.exists ~f:Attr.is_doc ea.attrs_after
@@ -326,28 +330,27 @@ module Structure_item = struct
     | Pstr_attribute atr -> Attr.is_doc atr
     (* one attribute list *)
     | Pstr_eval (_, atrs)
-     |Pstr_value {pvbs_bindings= {pvb_attributes= atrs; _} :: _; _}
-     |Pstr_primitive {pval_attributes= atrs; _}
-     |Pstr_type (_, {ptype_attributes= atrs; _} :: _)
-     |Pstr_typext {ptyext_attributes= atrs; _}
      |Pstr_recmodule ({pmb_expr= {pmod_attributes= atrs; _}; _} :: _)
-     |Pstr_open {popen_attributes= atrs; _}
-     |Pstr_extension (_, atrs)
-     |Pstr_class_type ({pci_attributes= atrs; _} :: _)
-     |Pstr_class ({pci_attributes= atrs; _} :: _) ->
+     |Pstr_extension (_, atrs) ->
         List.exists ~f:Attr.is_doc atrs
-    | Pstr_exception
-        { ptyexn_attributes= atrs1
-        ; ptyexn_constructor= {pext_attributes= atrs2; _}
-        ; _ }
+    | Pstr_open {popen_attributes= ea; _}
+     |Pstr_class_type ({pci_attributes= ea; _} :: _)
+     |Pstr_class ({pci_attributes= ea; _} :: _)
+     |Pstr_modtype {pmtd_ext_attrs= ea; _}
+     |Pstr_type (_, {ptype_attributes= ea; _} :: _)
+     |Pstr_value {pvbs_bindings= {pvb_attributes= ea; _} :: _; _}
+     |Pstr_primitive {pval_attributes= ea; _}
+     |Pstr_typext {ptyext_attributes= ea; _} ->
+        Ext_attrs.has_doc ea
+    | Pstr_module
+        {pmb_ext_attrs= ea; pmb_expr= {pmod_attributes= attrs; _}; _}
      |Pstr_include
-        {pincl_mod= {pmod_attributes= atrs1; _}; pincl_attributes= atrs2; _}
-      ->
-        List.exists ~f:Attr.is_doc atrs1 || List.exists ~f:Attr.is_doc atrs2
-    | Pstr_modtype {pmtd_ext_attrs; _} -> Ext_attrs.has_doc pmtd_ext_attrs
-    | Pstr_module {pmb_ext_attrs; pmb_expr= {pmod_attributes; _}; _} ->
-        Ext_attrs.has_doc pmb_ext_attrs
-        || List.exists ~f:Attr.is_doc pmod_attributes
+        {pincl_mod= {pmod_attributes= attrs; _}; pincl_attributes= ea; _}
+     |Pstr_exception
+        { ptyexn_attributes= ea
+        ; ptyexn_constructor= {pext_attributes= attrs; _}
+        ; _ } ->
+        Ext_attrs.has_doc ea || List.exists ~f:Attr.is_doc attrs
     | Pstr_value {pvbs_bindings= []; _}
      |Pstr_type (_, [])
      |Pstr_recmodule []
@@ -421,29 +424,25 @@ module Signature_item = struct
   let has_doc itm =
     match itm.psig_desc with
     | Psig_attribute atr -> Attr.is_doc atr
-    (* one attribute list *)
-    | Psig_value {pval_attributes= atrs; _}
-     |Psig_type (_, {ptype_attributes= atrs; _} :: _)
-     |Psig_typesubst ({ptype_attributes= atrs; _} :: _)
-     |Psig_typext {ptyext_attributes= atrs; _}
-     |Psig_open {popen_attributes= atrs; _}
-     |Psig_extension (_, atrs)
-     |Psig_class_type ({pci_attributes= atrs; _} :: _)
-     |Psig_class ({pci_attributes= atrs; _} :: _) ->
-        List.exists ~f:Attr.is_doc atrs
-    (* two attribute list *)
-    | Psig_modtype {pmtd_ext_attrs= ea; _}
+    | Psig_extension (_, atrs) -> List.exists ~f:Attr.is_doc atrs
+    | Psig_value {pval_attributes= ea; _}
+     |Psig_type (_, {ptype_attributes= ea; _} :: _)
+     |Psig_typesubst ({ptype_attributes= ea; _} :: _)
+     |Psig_typext {ptyext_attributes= ea; _}
+     |Psig_open {popen_attributes= ea; _}
+     |Psig_class_type ({pci_attributes= ea; _} :: _)
+     |Psig_class ({pci_attributes= ea; _} :: _)
+     |Psig_modtype {pmtd_ext_attrs= ea; _}
      |Psig_modtypesubst {pmtd_ext_attrs= ea; _}
      |Psig_modsubst {pms_ext_attrs= ea; _} ->
         Ext_attrs.has_doc ea
     | Psig_include
-        {pincl_mod= {pmty_attributes= atrs1; _}; pincl_attributes= atrs2; _}
+        {pincl_mod= {pmty_attributes= atrs; _}; pincl_attributes= ea; _}
      |Psig_exception
-        { ptyexn_attributes= atrs1
-        ; ptyexn_constructor= {pext_attributes= atrs2; _}
-        ; _ } ->
-        List.exists ~f:Attr.is_doc atrs1 || List.exists ~f:Attr.is_doc atrs2
-    | Psig_recmodule
+        { ptyexn_attributes= ea
+        ; ptyexn_constructor= {pext_attributes= atrs; _}
+        ; _ }
+     |Psig_recmodule
         ({pmd_type= {pmty_attributes= atrs; _}; pmd_ext_attrs= ea; _} :: _)
      |Psig_module {pmd_ext_attrs= ea; pmd_type= {pmty_attributes= atrs; _}; _}
       ->
@@ -508,7 +507,7 @@ module Signature_item = struct
 end
 
 module Lb = struct
-  let has_doc itm = List.exists ~f:Attr.is_doc itm.pvb_attributes
+  let has_doc itm = Ext_attrs.has_doc itm.pvb_attributes
 
   let is_simple (i, (c : Conf.t)) =
     Poly.(c.fmt_opts.module_item_spacing.v = `Compact)
@@ -550,7 +549,7 @@ module Md = struct
 end
 
 module Td = struct
-  let has_doc itm = List.exists ~f:Attr.is_doc itm.ptype_attributes
+  let has_doc itm = Ext_attrs.has_doc itm.ptype_attributes
 
   let is_simple (i, (c : Conf.t)) =
     match c.fmt_opts.module_item_spacing.v with
@@ -699,19 +698,19 @@ let attrs_of_ext_attrs ea = ea.attrs_before @ ea.attrs_after
 let attributes = function
   | Pld _ -> []
   | Typ x -> x.ptyp_attributes
-  | Td x -> x.ptype_attributes
+  | Td x -> attrs_of_ext_attrs x.ptype_attributes
   | Cty x -> x.pcty_attributes
   | Pat x -> x.ppat_attributes
   | Exp x -> x.pexp_attributes
   | Fpe _ | Fpc _ -> []
   | Vc _ -> []
-  | Lb x -> x.pvb_attributes
+  | Lb x -> attrs_of_ext_attrs x.pvb_attributes
   | Bo _ -> []
   | Mb x -> attrs_of_ext_attrs x.pmb_ext_attrs
   | Md x -> attrs_of_ext_attrs x.pmd_ext_attrs
   | Cl x -> x.pcl_attributes
-  | Cd x -> x.pci_attributes
-  | Ctd x -> x.pci_attributes
+  | Cd x -> attrs_of_ext_attrs x.pci_attributes
+  | Ctd x -> attrs_of_ext_attrs x.pci_attributes
   | Mty x -> x.pmty_attributes
   | Mod x -> x.pmod_attributes
   | Sig _ -> []

lib/Ast.mli

@@ -234,3 +234,7 @@ val parenze_mty : module_type xt -> bool
 val parenze_mod : module_expr xt -> bool
 (** [parenze_mod xmod] holds when module_expr-in-context [xmod] should be
     parenthesized. *)
+
+module Ext_attrs : sig
+  val has_attrs : ext_attrs -> bool
+end

lib/Exposed.ml

@@ -59,7 +59,7 @@ module Right = struct
     | {pcd_args= args; _} -> constructor_arguments args
 
   let type_declaration = function
-    | {ptype_attributes= _ :: _; _} -> false
+    | {ptype_attributes= {attrs_after= _ :: _; _}; _} -> false
     | {ptype_cstrs= _ :: _ as cstrs; _} ->
         (* type a = ... constraint left = < ... > *)
         list ~elt:(fun (_left, right, _loc) -> core_type right) cstrs
@@ -73,7 +73,7 @@ module Right = struct
         list ~elt:constructor_declaration cdecls
 
   let type_extension = function
-    | {ptyext_attributes= _ :: _; _} -> false
+    | {ptyext_attributes= {attrs_after= _ :: _; _}; _} -> false
     (* type a += A of ... * ... * < ... > *)
     | {ptyext_constructors; _} ->
         list ~elt:extension_constructor ptyext_constructors
@@ -90,12 +90,15 @@ module Right = struct
 
   (* exception C of ... * ... * < ... > *)
   let type_exception = function
-    | {ptyexn_attributes= _ :: _; _} -> false
+    | {ptyexn_attributes= {attrs_after= _ :: _; _}; _}
+      ->
+        false
     | {ptyexn_constructor; _} -> extension_constructor ptyexn_constructor
 
   (* val x : < ... > *)
   let value_description = function
-    | {pval_attributes= _ :: _; _} -> false
+    | {pval_attributes= {attrs_after= _ :: _; _}; _} ->
+        false
     | {pval_prim= _ :: _; _} -> false
     | {pval_type= ct; _} -> core_type ct