Fix printing & parsing of nested uncurried syntax.

formatTest/unit_tests/expected_output/uncurried.re

@@ -14,12 +14,28 @@ f(. a);
 
 f(. (1, 2));
 
+f([@bs] (1, 2));
+
+f(. [@bs] (1, 2));
+
 f(. (1, 2), (3, 4));
 
+f(. [@bs] (1, 2), [@bs] (3, 4));
+
+(f(. [@bs] (1, 2)))(. [@bs] (3, 4));
+
 f(. "string");
 
+f(. "string", "2string");
+
+(f(. "string"))(. "2string");
+
+(f(. [@bs] "string"))(. [@bs] "2string");
+
 f(. 1);
 
+f(. [@bs] 1);
+
 f(. {
   a: "supersupersupersupersupersuperlong",
   b: "supersupersupersupersupersuperlong",
@@ -116,11 +132,11 @@ type f = int => (. int) => unit;
 
 add(. 2);
 
-add(. 2);
+(add(. 2))(. 3);
 
-add(. 2, . 3);
+add(. 2, [@bs] 3);
 
-add(. 2, . 3);
+((add(. 2, 3, 4))(. 5, 6, 7))(. 8, 9, 10);
 
 type timerId;
 
@@ -134,3 +150,23 @@ let id =
 
 let id =
   setTimeout(1000, (.) => Js.log("hello"));
+
+foo([@bs] {val a = 1});
+
+foo(. [@bs] {val a = 1});
+
+foo(. [@bs] {val a = 1});
+
+foo([@attr1] [@bs] [@attr2] {val a = 1});
+
+add([@attr] [@bs] [@attr] 1);
+
+add(. [@attr] [@bs] [@attr] 1);
+
+add(. [@attr] [@bs] [@attr] 1);
+
+let a = foo(. foo(. 3));
+
+let a = foo(. foo(. 3));
+
+(add(1, 2))(. 3, 4);

formatTest/unit_tests/input/uncurried.re

@@ -12,12 +12,28 @@ f(. a);
 
 f(. (1, 2));
 
+f([@bs] (1, 2));
+
+f(. [@bs] (1, 2));
+
 f(. (1, 2), (3, 4));
 
+f(. [@bs] (1, 2), [@bs] (3, 4));
+
+f(. [@bs] (1, 2), . [@bs] (3, 4));
+
 f(. "string");
 
+f(. "string", "2string");
+
+f(. "string", . "2string");
+
+f(. [@bs] "string", . [@bs] "2string");
+
 f(. 1);
 
+f(. [@bs] 1);
+
 f(. {a: "supersupersupersupersupersuperlong", b: "supersupersupersupersupersuperlong"});
 
 let f = (. a, b) => a + b;
@@ -108,16 +124,36 @@ type f = (int, . int) => unit;
 
 add(. 2);
 
-([@bs] add(. 2));
-
 add(. 2, . 3);
 
 ([@bs] add(2, [@bs] 3));
 
+add(. 2, 3, 4, . 5, 6, 7, . 8, 9, 10);
+
 type timerId;
 
 [@bs.val] external setTimeout : ([@bs] (unit => unit), int) => timerId = "setTimeout";
 
 let id = setTimeout([@bs] (() => Js.log("hello")), 1000);
 
 let id = setTimeout(1000, [@bs] (() => Js.log("hello")));
+
+foo([@bs] {val a = 1});
+
+[@bs] foo([@bs] {val a = 1});
+
+foo(. [@bs] {val a = 1});
+
+foo([@attr1][@bs][@attr2] {val a = 1});
+
+add([@attr][@bs][@attr] 1);
+
+[@bs] add([@attr][@bs][@attr] 1);
+
+add(. [@attr][@bs][@attr] 1);
+
+let a = [@bs] foo ([@bs] foo(3));
+
+let a = foo(. foo(. 3));
+
+add(1, 2, . 3, 4);

src/reason-parser/reason_heuristics.ml

@@ -75,3 +75,18 @@ let funAppCallbackExceedsWidth ~printWidth ~args ~funExpr () =
  * | X(y) =>
  *)
 let singleTokenPatternOmmitTrail txt = String.length txt < 4
+
+(* Indicates whether an expression can be printed with the uncurried
+ * dot notation. At the moment uncurried function application & definition
+ * only makes sense in the context of a Pexp_apply or Pexp_fun
+ *
+ * Examples:
+ * [@bs] add(2, 3); -> add(. 2, 3);   (* Pexp_apply *)
+ * setTimeout([@bs] () => Js.log("hola"), 1000);  (* Pexp_fun *)
+ *  -> setTimeout((.) => Js.log("hola"), 1000);
+ *)
+let bsExprCanBeUncurried expr =
+  match Ast_404.Parsetree.(expr.pexp_desc) with
+  | Pexp_fun _
+  | Pexp_apply _ -> true
+  | _ -> false

src/reason-parser/reason_parser.mly

@@ -132,7 +132,7 @@ open Ast_mapper
 
 *)
 
-let uncurry_payload loc = ({loc; txt = "bs"}, PStr [])
+let uncurry_payload ?(name="bs") loc = ({loc; txt = name}, PStr [])
 
 let dummy_loc () = {
   loc_start = Lexing.dummy_pos;
@@ -367,7 +367,7 @@ let mkexp_cons consloc args loc =
   mkexp ~loc (Pexp_construct(mkloc (Lident "::") consloc, Some args))
 
 let mkexp_constructor_unit ?(uncurried=false) consloc loc =
-  let attrs = if uncurried then [uncurry_payload loc] else [] in
+  let attrs = if uncurried then [uncurry_payload ~name:"uncurry" loc] else [] in
   mkexp ~attrs ~loc (Pexp_construct(mkloc (Lident "()") consloc, None))
 
 let ghexp_cons consloc args loc =
@@ -608,30 +608,96 @@ let process_underscore_application args =
         exp_apply in
   (args, wrap)
 
+(**
+  * Joins a 'body' and it's 'args' to form a Pexp_apply.
+  * Example:
+  * 'add' (body) and '[1, 2]' (args) become a Pexp_apply representing 'add(1, 2)'
+  *
+  * Note that `add(. 1, 2)(. 3, 4)` & `add(. 1, 2, . 3, 4)` both
+  * give `[[@uncurry] 1, 2, [@uncurry] 3, 4]]` as args.
+  * The dot is parsed as [@uncurry] to distinguish between specific
+  * uncurrying and [@bs]. They can appear in the same arg:
+  * `add(. [@bs] 1)` is a perfectly valid, the dot indicates uncurrying
+  * for the whole application of 'add' and [@bs] sits on the `1`.
+  * Due to the dot of uncurried application possibly appearing in any
+  * position of the args, we need to post-process the args and split
+  * all args in groups that are uncurried (or not).
+  * add(. 1, . 2) should be parsed as (add(. 1))(. 2)
+  * The args can be splitted here in [1] & [2], based on those groups
+  * we can recursively build the correct nested Pexp_apply here.
+  *  -> Pexp_apply (Pexp_apply (add, 1), 2)   (* simplified ast *)
+  *)
 let mkexp_app_rev startp endp (body, args) =
-  let (args, uncurried) =
-    begin match (List.rev args) with
-    (* lifts the uncurried attr to the "top" expression, if the first arg isn't a callback
-     * example:
-     * f(. a, b, c) -> [@bs] f(a, b, c)  (attr sits on the "f" expr)
-     * f((.) => 42, 1000) -> f([@bs] () => 42, 1000) (attr needs to stay on the callback) *)
-    | (Nolabel, ({pexp_attributes; pexp_desc} as e))::tl when
-          match pexp_desc with
-          | Pexp_fun _ -> false
-          | _ -> true
-      ->
-      let (new_attrs, uncurried) = match pexp_attributes with
-      | ({txt = "bs"}, PStr [])::tl -> (tl, true)
-      | attrs -> (attrs, false)
-      in
-      (((Nolabel, {e with pexp_attributes = new_attrs})::tl), uncurried)
-  | xs -> (xs, false)
-  end in
   let loc = mklocation startp endp in
-  let attrs = if uncurried then [uncurry_payload loc] else [] in
-  let (args, wrap) = process_underscore_application args in
-  if args = [] then { body with pexp_loc = loc } else
-    wrap (mkexp ~attrs ~loc (Pexp_apply (body, args)))
+  if args = [] then {body with pexp_loc = loc}
+  else
+  (*
+   * Post process the arguments and transform [@uncurry] into [@bs].
+   * Returns a tuple with a boolean (was it uncurried?) and
+   * the posible rewritten arg.
+   *)
+  let rec process_args acc es =
+    match es with
+    | (lbl, e)::es ->
+        let attrs = e.pexp_attributes in
+        let hasUncurryAttr = ref false in
+        let newAttrs = List.filter (function
+          | ({txt = "uncurry"}, PStr []) ->
+              hasUncurryAttr := true;
+              false
+          | _ -> true) attrs
+        in
+        let uncurried = !hasUncurryAttr in
+        let newArg = (lbl, { e with pexp_attributes = newAttrs }) in
+        process_args ((uncurried, newArg)::acc) es
+    | [] -> acc
+    in
+    (*
+     * Groups all uncurried args falling under the same Pexp_apply
+     * Example:
+     *    add(. 2, 3, . 4, 5) or add(. 2, 3)(. 4, 5)  (equivalent)
+     * This results in two groups: (true, [2, 3]) & (true, [4, 5])
+     * Both groups have 'true' as their first tuple element, because
+     * they are uncurried.
+     * add(2, 3, . 4) results in the groups (false, [2, 3]) & (true, [4])
+     *)
+    let rec group grp acc = function
+    | (uncurried, arg)::xs ->
+        let (_u, grp) = grp in
+        if uncurried = true then begin
+          group (true, [arg]) ((_u, (List.rev grp))::acc) xs
+        end else begin
+          group (_u, (arg::grp)) acc xs
+        end
+    | [] ->
+        let (_u, grp) = grp in
+        List.rev ((_u, (List.rev grp))::acc)
+    in
+    (*
+     * Recursively transforms all groups into a (possibly uncurried)
+     * Pexp_apply
+     *
+     * Example:
+     *   Given the groups (true, [2, 3]) & (true, [4, 5]) and body 'add',
+     *   we get the two nested Pexp_apply associated with
+     *   (add(. 2, 3))(. 4, 5)
+     *)
+    let rec make_appl body = function
+      | args::xs ->
+          let (uncurried, args) = args in
+          let expr = if args = [] then body
+          else
+            let (args, wrap) = process_underscore_application args in
+            let expr = mkexp (Pexp_apply (body, args)) in
+            let expr = if uncurried then {expr with pexp_attributes = [uncurry_payload loc]} else expr in
+            wrap expr
+          in
+            make_appl expr xs
+      | [] -> {body with pexp_loc = loc}
+    in
+    let processed_args = process_args [] args in
+    let groups = group (false, []) [] processed_args in
+    make_appl body groups
 
 let mkmod_app mexp marg =
   mkmod ~loc:(mklocation mexp.pmod_loc.loc_start marg.pmod_loc.loc_end)
@@ -3066,7 +3132,7 @@ labeled_expr_constraint:
     if uncurried then
       let (lbl, argExpr) = $2 in
       let loc = mklocation $startpos $endpos in
-      let up = uncurry_payload loc in
+      let up = uncurry_payload ~name:"uncurry" loc in
       (lbl, {argExpr with pexp_attributes = up::argExpr.pexp_attributes})
     else $2
   }

src/reason-parser/reason_pprint_ast.ml

@@ -294,25 +294,23 @@ let rec partitionAttributes ?(allowUncurry=true) attrs : attributesPartition =
     | [] ->
         {arityAttrs=[]; docAttrs=[]; stdAttrs=[]; jsxAttrs=[]; uncurried = false}
     | (({txt = "bs"}, PStr []) as attr)::atTl ->
-        let partition = partitionAttributes atTl in
+        let partition = partitionAttributes ~allowUncurry atTl in
         if allowUncurry then
           {partition with uncurried = true}
-        else begin
-          {partition with stdAttrs=attr::partition.stdAttrs}
-        end
+        else {partition with stdAttrs=attr::partition.stdAttrs}
     | (({txt="JSX"; loc}, _) as jsx)::atTl ->
-        let partition = partitionAttributes atTl in
+        let partition = partitionAttributes ~allowUncurry atTl in
         {partition with jsxAttrs=jsx::partition.jsxAttrs}
     | (({txt="explicit_arity"; loc}, _) as arity_attr)::atTl
     | (({txt="implicit_arity"; loc}, _) as arity_attr)::atTl ->
-        let partition = partitionAttributes atTl in
+        let partition = partitionAttributes ~allowUncurry atTl in
         {partition with arityAttrs=arity_attr::partition.arityAttrs}
     (*| (({txt="ocaml.text"; loc}, _) as doc)::atTl
     | (({txt="ocaml.doc"; loc}, _) as doc)::atTl ->
         let partition = partitionAttributes atTl in
         {partition with docAttrs=doc::partition.docAttrs}*)
     | atHd::atTl ->
-        let partition = partitionAttributes atTl in
+        let partition = partitionAttributes ~allowUncurry atTl in
         {partition with stdAttrs=atHd::partition.stdAttrs}
 
 let extractStdAttrs attrs =
@@ -3143,7 +3141,8 @@ let printer = object(self:'self)
     match self#unparseExprRecurse x with
     | SpecificInfixPrecedence ({reducePrecedence; shiftPrecedence}, resolvedRule) ->
         self#unparseResolvedRule resolvedRule
-    | FunctionApplication itms -> formatAttachmentApplication applicationFinalWrapping None (itms, Some x.pexp_loc)
+    | FunctionApplication itms ->
+        formatAttachmentApplication applicationFinalWrapping None (itms, Some x.pexp_loc)
     | PotentiallyLowPrecedence itm -> itm
     | Simple itm -> itm
 
@@ -3247,7 +3246,10 @@ let printer = object(self:'self)
   method unparseExprRecurse x =
     let x = self#process_underscore_application x in
     (* If there are any attributes, render unary like `(~-) x [@ppx]`, and infix like `(+) x y [@attr]` *)
-    let {arityAttrs; stdAttrs; jsxAttrs; uncurried} = partitionAttributes x.pexp_attributes in
+
+    let {arityAttrs; stdAttrs; jsxAttrs; uncurried} =
+      partitionAttributes ~allowUncurry:(Reason_heuristics.bsExprCanBeUncurried x) x.pexp_attributes
+    in
     let () = if uncurried then Hashtbl.add uncurriedTable x.pexp_loc true in
     let x = {x with pexp_attributes = (arityAttrs @ stdAttrs @ jsxAttrs) } in
     (* If there's any attributes, recurse without them, then apply them to
@@ -6220,23 +6222,9 @@ let printer = object(self:'self)
 
 
   method label_x_expression_param (l, e) =
-    let (uncurried, e) =
-      let {uncurried; stdAttrs} = partitionAttributes e.pexp_attributes in
-      if uncurried then
-        (true, {e with pexp_attributes = stdAttrs})
-      else (false, e)
-    in
     let term = self#unparseConstraintExpr e in
     let param = match (l, e) with
-      (* image `setTimeout((.) => Js.log("hola"), 1000)` 
-       * the first arg is a Pexp_fun, with an attribute [@bs], which flows through this case. 
-       * We want the dot to be formatted inside of the arguments of the callback
-       * Without this pattern match, we would get `setTimeout(. () => Js.log("hola"), 1000)` *)
-      | Nolabel, {pexp_loc; pexp_desc = Pexp_fun _} when uncurried ->
-          Hashtbl.add uncurriedTable pexp_loc true;
-          self#unparseExpr e
-      | (Nolabel, _) ->
-        if uncurried then makeList ~postSpace:true [atom "."; term] else term
+      | (Nolabel, _) -> term
       | (Labelled lbl, _) when is_punned_labelled_expression e lbl ->
         makeList [atom namedArgSym; term]
       | (Optional lbl, _) when is_punned_labelled_expression e lbl ->