Reason V4 Feature [Lint Warnings Injected]

Summary:

Test Plan:

Reviewers:

CC:

Author: jordwalke

formatTest/typeCheckedTests/expected_output/mlVariants.re

@@ -1,3 +1,4 @@
+[@reason.version 3.7];
 /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */
 
 type polyVariantsInMl = [

src/reason-parser/reason_attributes.ml

@@ -13,6 +13,15 @@ type attributesPartition = {
   uncurried : bool
 }
 
+let is_stylistic_attr = function
+  | { attr_name = {txt="reason.raw_literal"}; _}
+  (* Consider warnings to be "stylistic" attributes - attributes that do not
+   * affect printing *)
+  | { attr_name = {txt="ocaml.ppwarn"}; _}
+  | { attr_name = {txt="reason.preserve_braces"}; _} -> true
+  | _ -> false
+
+
 (** Partition attributes into kinds *)
 let rec partitionAttributes ?(partDoc=false) ?(allowUncurry=true) attrs : attributesPartition =
   match attrs with
@@ -36,10 +45,7 @@ let rec partitionAttributes ?(partDoc=false) ?(allowUncurry=true) attrs : attrib
   | ({ attr_name = {txt="ocaml.doc" | "ocaml.text"}; _} as doc)::atTl when partDoc = true ->
     let partition = partitionAttributes ~partDoc ~allowUncurry atTl in
     {partition with docAttrs=doc::partition.docAttrs}
-  | ({ attr_name = {txt="reason.raw_literal"}; _} as attr) :: atTl ->
-    let partition = partitionAttributes ~partDoc ~allowUncurry atTl in
-    {partition with stylisticAttrs=attr::partition.stylisticAttrs}
-  | ({ attr_name = {txt="reason.preserve_braces"}; _} as attr) :: atTl ->
+  | attr :: atTl when is_stylistic_attr attr ->
     let partition = partitionAttributes ~partDoc ~allowUncurry atTl in
     {partition with stylisticAttrs=attr::partition.stylisticAttrs}
   | atHd :: atTl ->
@@ -63,8 +69,7 @@ let extract_raw_literal attrs =
 
 let without_stylistic_attrs attrs =
   let rec loop acc = function
-    | attr :: rest when (partitionAttributes [attr]).stylisticAttrs != [] ->
-        loop acc rest
+    | attr :: rest when is_stylistic_attr attr -> loop acc rest
     | [] -> List.rev acc
     | attr :: rest -> loop (attr :: acc) rest
   in

src/reason-parser/reason_pprint_ast.ml

@@ -294,6 +294,14 @@ let expandLocation pos ~expand:(startPos, endPos) =
     }
   }
 
+let should_keep_floating_stylistic_structure_attr = function
+  | {pstr_desc=Pstr_attribute a; _} -> not (Reason_attributes.is_stylistic_attr a)
+  | _ -> true
+
+let should_keep_floating_stylistic_sig_attr = function
+  | {psig_desc=Psig_attribute a; _} -> not (Reason_attributes.is_stylistic_attr a)
+  | _ -> true
+
 (* Computes the location of the attribute with the lowest line number
  * that isn't ghost. Useful to determine the start location of an item
  * in the parsetree that has attributes.
@@ -1063,7 +1071,7 @@ let makeTup ?(wrap=("", ""))?(trailComma=true) ?(uncurried = false) l =
     ~sep:(if trailComma then commaTrail else commaSep)
     ~postSpace:true
     ~break:IfNeed l
-    
+
 (* Makes angle brackets < > *)
 let typeParameterBookends ?(wrap=("", ""))?(trailComma=true) l =
   let useAngle = Reason_version.supports Reason_version.AngleBracketTypes in
@@ -7582,7 +7590,7 @@ let printer = object(self:'self)
           ~xf:self#structure_item
           ~getLoc:(fun x -> x.pstr_loc)
           ~comments:self#comments
-          structureItems
+          (List.filter should_keep_floating_stylistic_structure_attr structureItems)
       in
       source_map ~loc:{loc_start; loc_end; loc_ghost = false}
         (makeList
@@ -8321,10 +8329,28 @@ let record_version_mapper super =
   in
   { super with Ast_mapper.structure_item; Ast_mapper.signature_item }
 
+(* These won't get removed from partitioning since they are individual floating
+ * attributes *)
+let remove_floating_style_attributes super =
+  let super_structure = super.Ast_mapper.structure in
+  let super_signature = super.Ast_mapper.signature in
+  let structure mapper structure =
+    super_structure
+      mapper
+      (List.filter should_keep_floating_stylistic_structure_attr structure)
+  in
+  let signature mapper signature =
+    super_signature
+      mapper
+      (List.filter should_keep_floating_stylistic_sig_attr signature)
+  in
+  { super with Ast_mapper.structure; Ast_mapper.signature }
+
 let preprocessing_mapper =
   ml_to_reason_swap_operator_mapper
-    (record_version_mapper (escape_stars_slashes_mapper
-      (add_explicit_arity_mapper Ast_mapper.default_mapper)))
+    (remove_floating_style_attributes
+      (record_version_mapper (escape_stars_slashes_mapper
+        (add_explicit_arity_mapper Ast_mapper.default_mapper))))
 
 let core_type ppf x =
   format_layout ppf

src/reason-version/reason_version.ml

@@ -22,7 +22,7 @@ type package_version = {
 
 type feature =
   | AngleBracketTypes
-  
+
 (**
  * Tracks the current package version of Reason parser/printer. This is
  * primarily for printing the version with `refmt --version`.
@@ -77,7 +77,7 @@ let within
 
 let at_least (major, minor) =
   within ~inclusive:true (major, minor) ~inclusive:true (10000,0)
-  
+
 let supports = function
   | AngleBracketTypes -> at_least (3, 8)
 
@@ -102,6 +102,11 @@ let _split_on_char sep_char str =
   String.sub str 0 j.contents :: r.contents
 
 module Ast_nodes = struct
+  let mk_warning_attribute_payload ~loc msg =
+    let exp = Exp.mk ~loc  (Pexp_constant (Pconst_string(msg, None))) in
+    let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in
+    PStr [item]
+
   let mk_version_attr_payload major minor =
     let major, minor = string_of_int major, string_of_int minor in
     let loc = dummy_loc () in
@@ -122,7 +127,26 @@ module Ast_nodes = struct
         first :: created :: rest
       | _ -> created :: itms
       )
-    | Some efv -> itms
+    | Some efv -> begin
+        if efv.major > package_version.major ||
+            (efv.major == package_version.major && efv.minor > package_version.minor) then
+          let efv_mjr = string_of_int efv.major in
+          let efv_mnr = string_of_int efv.minor in
+          let pkg_mjr = string_of_int package_version.major in
+          let pkg_mnr = string_of_int package_version.minor in
+          let msg =
+            "This file specifies a reason.version " ^ efv_mjr ^ "." ^ efv_mnr ^
+            " which is greater than the package version " ^ pkg_mjr ^ "." ^ pkg_mnr ^
+            " Either upgrade the Reason package or lower the version specified in [@reason.version ]." in
+          (* let loc = match itms with *)
+          (* | hd :: _ -> hd.pstr_loc *)
+          (* | [] -> loc *)
+          (* in *)
+          let attr_payload = mk_warning_attribute_payload ~loc msg in
+          let created = (creator ~loc {attr_name={loc; txt="ocaml.ppwarn"}; attr_payload; attr_loc=loc}) in
+          created :: itms
+        else itms
+    end
 
   let inject_attr_from_version_impl itms =
     let insert_after = function
@@ -131,15 +155,15 @@ module Ast_nodes = struct
     in
     let creator = (fun ~loc x -> Str.mk ~loc (Pstr_attribute x)) in
     inject_attr_from_version itms ~insert_after ~creator
-  
+
   let inject_attr_from_version_intf itms =
     let insert_after = function
       | {psig_desc = Psig_attribute {attr_name = {loc; txt="ocaml.doc"|"ocaml.text"}}} -> true
       | _ -> false
     in
     let creator = (fun ~loc x -> Sig.mk ~loc (Psig_attribute x)) in
     inject_attr_from_version itms ~insert_after ~creator
-    
+
   let extract_version_attribute_structure_item structure_item =
     (match structure_item with
     | {pstr_desc=(Pstr_attribute {