Nested uncurrying + paren hugging

formatTest/unit_tests/expected_output/uncurried.re

@@ -10,6 +10,21 @@ f(. a, b, c);
 [@attr]
 f(. a, b, c);
 
+f(. a);
+
+f(. (1, 2));
+
+f(. (1, 2), (3, 4));
+
+f(. "string");
+
+f(. 1);
+
+f(. {
+  a: "supersupersupersupersupersuperlong",
+  b: "supersupersupersupersupersuperlong",
+});
+
 let f = (. a, b) => a + b;
 
 let f = [@attr] ((. a, b) => a + b);
@@ -98,3 +113,24 @@ Thing.map(
 type f = int => (. int) => unit;
 
 type f = int => (. int) => unit;
+
+add(. 2);
+
+add(. 2);
+
+add(. 2, . 3);
+
+add(. 2, . 3);
+
+type timerId;
+
+[@bs.val]
+external setTimeout :
+  ((. unit) => unit, int) => timerId =
+  "setTimeout";
+
+let id =
+  setTimeout((.) => Js.log("hello"), 1000);
+
+let id =
+  setTimeout(1000, (.) => Js.log("hello"));

formatTest/unit_tests/input/uncurried.re

@@ -8,6 +8,18 @@ f(. a, b, c);
 
 [@attr] f(. a, b, c);
 
+f(. a);
+
+f(. (1, 2));
+
+f(. (1, 2), (3, 4));
+
+f(. "string");
+
+f(. 1);
+
+f(. {a: "supersupersupersupersupersuperlong", b: "supersupersupersupersupersuperlong"});
+
 let f = (. a, b) => a + b;
 
 let f = [@attr] (. a, b) => a + b;
@@ -93,3 +105,19 @@ Thing.map(
 type f = int => (. int) => unit;
 
 type f = (int, . int) => unit;
+
+add(. 2);
+
+([@bs] add(. 2));
+
+add(. 2, . 3);
+
+([@bs] add(2, [@bs] 3));
+
+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")));

src/reason-parser/reason_parser.mly

@@ -582,11 +582,29 @@ let mkcty_arrow ({Location.txt = (label, cod); loc}, uncurried) dom =
   let ct = mkcty ~loc (Pcty_arrow (label, cod, dom)) in
   {ct with pcty_attributes = (if uncurried then [uncurry_payload loc] else [])}
 
-let mkexp_app_rev startp endp (body, args, uncurried) =
+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
   if args = [] then { body with pexp_loc = loc } else
-    mkexp ~attrs ~loc (Pexp_apply (body, List.rev args))
+    mkexp ~attrs ~loc (Pexp_apply (body, args))
 
 let mkmod_app mexp marg =
   mkmod ~loc:(mklocation mexp.pmod_loc.loc_start marg.pmod_loc.loc_end)
@@ -1885,8 +1903,7 @@ mark_position_cl
        * class newclass = oldclass withInitArg;
        * let inst = new newclass;
        */
-    { let (args, _uncurried) = $2 in
-      mkclass(Pcl_apply($1, args)) }
+    { mkclass(Pcl_apply($1, $2)) }
   | attribute class_expr
     { {$2 with pcl_attributes = $1 :: $2.pcl_attributes} }
   /*
@@ -2934,17 +2951,16 @@ simple_expr_no_call:
 ;
 
 simple_expr_call:
-  | mark_position_exp(simple_expr_template(simple_expr)) { $1, [], false}
+  | mark_position_exp(simple_expr_template(simple_expr)) { ($1, []) }
   | simple_expr_call labeled_arguments
-    { let (body, args, _uncurried) = $1 in
-      let (lbled_args, uncurried) = $2 in
-    (body, List.rev_append lbled_args args, uncurried) }
+    { let (body, args) = $1 in
+      (body, List.rev_append $2 args) }
   | LBRACKET expr_comma_seq_extension RBRACKET
     { let seq, ext_opt = $2 in
       let loc = mklocation $startpos($2) $endpos($2) in
-      (make_real_exp (mktailexp_extension loc seq ext_opt), [], false)
+      (make_real_exp (mktailexp_extension loc seq ext_opt), [])
     }
-  | simple_expr_template_constructor { ($1, [], false) }
+  | simple_expr_template_constructor { ($1, []) }
 ;
 
 simple_expr_direct_argument:
@@ -3001,27 +3017,20 @@ non_labeled_argument_list:
 ;
 
 %inline labelled_expr_comma_list:
-  lseparated_list(COMMA, labeled_expr) COMMA? { $1 };
+  lseparated_list(COMMA, uncurried_labeled_expr) COMMA? { $1 };
 
 labeled_arguments:
   | mark_position_exp(simple_expr_direct_argument)
-    { ([(Nolabel, $1)], false) }
+    { [(Nolabel, $1)] }
   | parenthesized(labelled_expr_comma_list)
     { match $1 with
       | [] -> let loc = mklocation $startpos $endpos in
-              ([(Nolabel, mkexp_constructor_unit loc loc)], false)
-      | xs -> (xs, false)
+              [(Nolabel, mkexp_constructor_unit loc loc)]
+      | xs -> xs
     }
-  | LPAREN DOT labelled_expr_comma_list RPAREN
-    { let loc = mklocation $startpos $endpos in 
-      match $3 with
-      | [] -> ([(Nolabel, mkexp_constructor_unit loc loc)], true)
-      | xs -> List.iter (function
-          | (Labelled _, _) ->
-                raise Syntax_util.(Error(loc, (Syntax_error "Uncurried function application with labelled arguments is not supported at the moment.")));
-                ()
-          | _ -> ()) xs;
-        (xs, true)
+  | LPAREN DOT RPAREN
+    { let loc = mklocation $startpos $endpos in
+      [(Nolabel, mkexp_constructor_unit ~uncurried:true loc loc)]
     }
 ;
 
@@ -3038,6 +3047,18 @@ labeled_expr_constraint:
     }
 ;
 
+%inline uncurried_labeled_expr:
+  | DOT? labeled_expr {
+    let uncurried = match $1 with | Some _ -> true | None _ -> false in
+    if uncurried then
+      let (lbl, argExpr) = $2 in
+      let loc = mklocation $startpos $endpos in
+      let up = uncurry_payload loc in
+      (lbl, {argExpr with pexp_attributes = up::argExpr.pexp_attributes})
+    else $2
+  }
+;
+
 labeled_expr:
   | expr_optional_constraint { (Nolabel, $1) }
   | TILDE as_loc(val_longident)

src/reason-parser/reason_pprint_ast.ml

@@ -6186,38 +6186,54 @@ let printer = object(self:'self)
    *  when the line length dictates breaking. Notice how `({` and `})` 'hug'.
    *  Also see "isSingleArgParenApplication" which determines if
    *  this kind of formatting should happen. *)
-  method singleArgParenApplication = function
+  method singleArgParenApplication ?(uncurried=false) es =
+    let lparen = if uncurried then "(. " else "(" in
+    match es with
     | [{pexp_attributes = []; pexp_desc = Pexp_record (l, eo)}] ->
-      self#unparseRecord ~wrap:("(", ")") l eo
+      self#unparseRecord ~wrap:(lparen, ")") l eo
     | [{pexp_attributes = []; pexp_desc = Pexp_tuple l}] ->
-      self#unparseSequence ~wrap:("(", ")") ~construct:`Tuple l
+      self#unparseSequence ~wrap:(lparen, ")") ~construct:`Tuple l
     | [{pexp_attributes = []; pexp_desc = Pexp_array l}] ->
-      self#unparseSequence ~wrap:("(", ")") ~construct:`Array l
+      self#unparseSequence ~wrap:(lparen, ")") ~construct:`Array l
     | [{pexp_attributes = []; pexp_desc = Pexp_object cs}] ->
-      self#classStructure ~wrap:("(", ")") cs
+      self#classStructure ~wrap:(lparen, ")") cs
     | [{pexp_attributes = []; pexp_desc = Pexp_extension (s, p)}] when s.txt = "bs.obj" ->
-      self#formatBsObjExtensionSugar ~wrap:("(", ")") p
+      self#formatBsObjExtensionSugar ~wrap:(lparen, ")") p
     | [({pexp_attributes = []; pexp_desc} as exp)] when (is_simple_list_expr exp) ->
           (match view_expr exp with
           | `list xs ->
-              self#unparseSequence ~construct:`List ~wrap:("(", ")") xs
+              self#unparseSequence ~construct:`List ~wrap:(lparen, ")") xs
           | `cons xs ->
-              self#unparseSequence ~construct:`ES6List ~wrap:("(", ")") xs
+              self#unparseSequence ~construct:`ES6List ~wrap:(lparen, ")") xs
           | _ -> assert false)
     | _ -> assert false
 
 
   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 with
-      | Nolabel -> term
-      | Labelled lbl when is_punned_labelled_expression e lbl ->
+    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
+      | (Labelled lbl, _) when is_punned_labelled_expression e lbl ->
         makeList [atom namedArgSym; term]
-      | Optional lbl when is_punned_labelled_expression e lbl ->
+      | (Optional lbl, _) when is_punned_labelled_expression e lbl ->
         makeList [atom namedArgSym; label term (atom "?")]
-      | Labelled lbl ->
+      | (Labelled lbl, _) ->
         label (atom (namedArgSym ^ lbl ^ "=")) term
-      | Optional lbl ->
+      | (Optional lbl, _) ->
         label (atom (namedArgSym ^ lbl ^ "=?")) term
     in
     source_map ~loc:e.pexp_loc param
@@ -6239,7 +6255,7 @@ let printer = object(self:'self)
        *  when the line-length indicates breaking.
        *)
       | [(Nolabel, exp)] when isSingleArgParenApplication [exp] ->
-          self#singleArgParenApplication [exp]
+          self#singleArgParenApplication ~uncurried [exp]
       | params ->
           makeTup ~uncurried (List.map self#label_x_expression_param params)