Fix top level extensions

HISTORY.md

@@ -1,6 +1,7 @@
 ## 3.9 (unreleased)
 
 - Fix missing patterns around contraint pattern (a pattern with a type annotation).
+- Fix top level extension printing
 
 ## 3.8.2
 

formatTest/unit_tests/expected_output/extensions.re

@@ -350,6 +350,8 @@ let () = {
   something_else();
 };
 
+let f = [%bs.raw x => x];
+
 [%bs.raw x => x];
 
 let work = () => {

formatTest/unit_tests/input/extensions.re

@@ -348,6 +348,8 @@ let () = {
   something_else();
 };
 
+let f = [%bs.raw x => x];
+
 [%bs.raw x => x];
 
 let work = () => {

src/reason-parser/reason_pprint_ast.ml

@@ -7576,29 +7576,42 @@ let printer = object(self:'self)
     | Pmod_constraint _
     | Pmod_structure _ -> self#simple_module_expr x
 
-
   method structure structureItems =
+    (* We don't have any way to know if an extension is placed at the top level by the parsetree
+    while there's a difference syntactically (% for structure_items/expressons and %% for top_level).
+    This small fn detects this particular case (structure > structure_item > extension > value) and 
+    prints with double % *)
+    let structure_item item =
+      match item.pstr_desc with
+      | Pstr_extension ((extension, PStr [item]), attrs) ->
+          begin match item.pstr_desc with
+            (* In case of a value, the extension gets inlined `let%private a = 1` *)
+            | Pstr_value (rf, vb_list) -> self#bindings ~extension (rf, vb_list)
+            | _ -> self#attach_std_item_attrs attrs (self#payload "%%" extension (PStr [item]))
+          end
+      | _ -> self#structure_item item
+    in
     match structureItems with
     | [] -> atom ""
-    | first::_ as structureItems ->
+    | first :: _ as structureItems ->
       let last = match (List.rev structureItems) with | last::_ -> last | [] -> assert false in
       let loc_start = first.pstr_loc.loc_start in
       let loc_end = last.pstr_loc.loc_end in
       let items =
         groupAndPrint
-          ~xf:self#structure_item
+          ~xf:structure_item
           ~getLoc:(fun x -> x.pstr_loc)
           ~comments:self#comments
           structureItems
       in
       source_map ~loc:{loc_start; loc_end; loc_ghost = false}
         (makeList
-           ~postSpace:true
-           ~break:Always_rec
-           ~indent:0
-           ~inline:(true, false)
-           ~sep:(SepFinal (";", ";"))
-           items)
+          ~postSpace:true
+          ~break:Always_rec
+          ~indent:0
+          ~inline:(true, false)
+          ~sep:(SepFinal (";", ";"))
+          items)
 
   (*
      How do modules become parsed?

test/extensions.t/input.re

@@ -348,16 +348,29 @@ let () = {
   something_else();
 };
 
-[%bs.raw x => x];
-
 let work = () => {
   open Syntax;
   let%bind name = x;
   name;
 };
 
-/** header */
-[%raw "console.log(42)"];
+/* Extensions can have % or %% at the top-level */
+
+[%bs.raw x => x];
+
+[%%bs.raw x => x];
+
+[%%randomExtension "with string payload"];
+
+[%%randomExtension { with_obj: 33 }];
+
+[%randomExtension { with_obj: 33 }];
+
+/** with a comment on top */
+[%%raw "console.log(42)"];
+
+/* extensions live under expresions with only one % */
+let f = [%bs.raw x => x];
 
 /* https://github.com/facebook/reason/issues/2032 */
 let predicate =

test/extensions.t/run.t

@@ -352,16 +352,29 @@ Format extensions
     something_else();
   };
 
-  [%bs.raw x => x];
-
   let work = () => {
     open Syntax;
     let%bind name = x;
     name;
   };
 
-  /** header */
-  [%raw "console.log(42)"];
+  /* Extensions can have % or %% at the top-level */
+
+  [%bs.raw x => x];
+
+  [%%bs.raw x => x];
+
+  [%%randomExtension "with string payload"];
+
+  [%%randomExtension {with_obj: 33}];
+
+  [%randomExtension {with_obj: 33}];
+
+  /** with a comment on top */
+  [%%raw "console.log(42)"];
+
+  /* extensions live under expresions with only one % */
+  let f = [%bs.raw x => x];
 
   /* https://github.com/facebook/reason/issues/2032 */
   let predicate =