Implement printer support for async arrow expressions

Author: Maxim

src/res_parsetree_viewer.ml

@@ -11,7 +11,7 @@ let arrowType ct =
       process attrsBefore (arg :: acc) typ2
     | {
      ptyp_desc = Ptyp_arrow ((Nolabel as lbl), typ1, typ2);
-     ptyp_attributes = [({txt = "bs"}, _)] as attrs;
+     ptyp_attributes = [({txt = "bs" | "async"}, _)] as attrs;
     } ->
       let arg = (attrs, lbl, typ1) in
       process attrsBefore (arg :: acc) typ2
@@ -55,6 +55,16 @@ let processUncurriedAttribute attrs =
   in
   process false [] attrs
 
+let processFunctionAttributes attrs =
+  let rec process async uncurried acc attrs =
+    match attrs with
+    | [] -> (async, uncurried, List.rev acc)
+    | ({Location.txt = "bs"}, _) :: rest -> process async true acc rest
+    | ({Location.txt = "async"}, _) :: rest -> process true uncurried acc rest
+    | attr :: rest -> process async uncurried (attr :: acc) rest
+  in
+  process false false [] attrs
+
 let collectListExpressions expr =
   let rec collect acc expr =
     match expr.pexp_desc with
@@ -316,7 +326,8 @@ let hasAttributes attrs =
       match attr with
       | ( {
             Location.txt =
-              "bs" | "res.template" | "ns.ternary" | "ns.braces" | "ns.iflet";
+              ( "bs" | "async" | "res.template" | "ns.ternary" | "ns.braces"
+              | "ns.iflet" );
           },
           _ ) ->
         false

src/res_parsetree_viewer.mli

@@ -17,6 +17,11 @@ val functorType :
 val processUncurriedAttribute :
   Parsetree.attributes -> bool * Parsetree.attributes
 
+(* determines whether a function is async and/or uncurried based on the given attributes *)
+val processFunctionAttributes :
+  Parsetree.attributes ->
+  bool (* async *) * bool (* uncurried *) * Parsetree.attributes
+
 type ifConditionKind =
   | If of Parsetree.expression
   | IfLet of Parsetree.pattern * Parsetree.expression

src/res_printer.ml

@@ -3135,8 +3135,8 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl =
         cmtTbl
     | Pexp_fun _ | Pexp_newtype _ ->
       let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in
-      let uncurried, attrs =
-        ParsetreeViewer.processUncurriedAttribute attrsOnArrow
+      let async, uncurried, attrs =
+        ParsetreeViewer.processFunctionAttributes attrsOnArrow
       in
       let returnExpr, typConstraint =
         match returnExpr.pexp_desc with
@@ -3156,7 +3156,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl =
       in
       let parametersDoc =
         printExprFunParameters ~customLayout ~inCallback:NoCallback ~uncurried
-          ~hasConstraint parameters cmtTbl
+          ~async ~hasConstraint parameters cmtTbl
       in
       let returnExprDoc =
         let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in
@@ -3298,8 +3298,8 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl =
 
 and printPexpFun ~customLayout ~inCallback e cmtTbl =
   let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in
-  let uncurried, attrs =
-    ParsetreeViewer.processUncurriedAttribute attrsOnArrow
+  let async, uncurried, attrs =
+    ParsetreeViewer.processFunctionAttributes attrsOnArrow
   in
   let returnExpr, typConstraint =
     match returnExpr.pexp_desc with
@@ -3313,7 +3313,7 @@ and printPexpFun ~customLayout ~inCallback e cmtTbl =
     | _ -> (returnExpr, None)
   in
   let parametersDoc =
-    printExprFunParameters ~customLayout ~inCallback ~uncurried
+    printExprFunParameters ~customLayout ~inCallback ~async ~uncurried
       ~hasConstraint:
         (match typConstraint with
         | Some _ -> true
@@ -4575,8 +4575,8 @@ and printCase ~customLayout (case : Parsetree.case) cmtTbl =
   in
   Doc.group (Doc.concat [Doc.text "| "; content])
 
-and printExprFunParameters ~customLayout ~inCallback ~uncurried ~hasConstraint
-    parameters cmtTbl =
+and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried
+    ~hasConstraint parameters cmtTbl =
   match parameters with
   (* let f = _ => () *)
   | [
@@ -4589,7 +4589,8 @@ and printExprFunParameters ~customLayout ~inCallback ~uncurried ~hasConstraint
      };
   ]
     when not uncurried ->
-    if hasConstraint then Doc.text "(_)" else Doc.text "_"
+    let any = if hasConstraint then Doc.text "(_)" else Doc.text "_" in
+    if async then Doc.concat [Doc.text "async "; any] else any
   (* let f = a => () *)
   | [
    ParsetreeViewer.Parameter
@@ -4603,7 +4604,8 @@ and printExprFunParameters ~customLayout ~inCallback ~uncurried ~hasConstraint
     when not uncurried ->
     let txtDoc =
       let var = printIdentLike stringLoc.txt in
-      if hasConstraint then addParens var else var
+      let var = if hasConstraint then addParens var else var in
+      if async then Doc.concat [Doc.text "async ("; var; Doc.rparen] else var
     in
     printComments txtDoc cmtTbl stringLoc.loc
   (* let f = () => () *)
@@ -4617,15 +4619,21 @@ and printExprFunParameters ~customLayout ~inCallback ~uncurried ~hasConstraint
      };
   ]
     when not uncurried ->
-    Doc.text "()"
+    if async then Doc.text "async ()" else Doc.text "()"
   (* let f = (~greeting, ~from as hometown, ~x=?) => () *)
   | parameters ->
     let inCallback =
       match inCallback with
       | FitsOnOneLine -> true
       | _ -> false
     in
-    let lparen = if uncurried then Doc.text "(. " else Doc.lparen in
+    let maybeAsyncLparen =
+      match (async, uncurried) with
+      | true, true -> Doc.text "async (. "
+      | true, false -> Doc.text "async ("
+      | false, true -> Doc.text "(. "
+      | false, false -> Doc.lparen
+    in
     let shouldHug = ParsetreeViewer.parametersShouldHug parameters in
     let printedParamaters =
       Doc.concat
@@ -4641,7 +4649,7 @@ and printExprFunParameters ~customLayout ~inCallback ~uncurried ~hasConstraint
     Doc.group
       (Doc.concat
          [
-           lparen;
+           maybeAsyncLparen;
            (if shouldHug || inCallback then printedParamaters
            else
              Doc.concat

test.res

@@ -0,0 +1,2 @@
+let f = (.) => ()
+let f = async () => delay(20)

tests/printer/expr/asyncAwait.res

@@ -0,0 +1,13 @@
+let sequentialAwait = async () => {
+  let result1 = await paused("first")
+  nodeJsAssert.equal(result1, "first")
+  
+  let result2 = await paused("second")
+  nodeJsAssert.equal(result2, "second")
+}
+
+let f = async () => ()
+let f = async (.) => ()
+let f = async f => f()
+let f = async (a, b) => a + b
+let f = async (. a, b) => a + b

tests/printer/expr/expected/asyncAwait.res.txt

@@ -0,0 +1,13 @@
+let sequentialAwait = async () => {
+  let result1 = @await paused("first")
+  nodeJsAssert.equal(result1, "first")
+
+  let result2 = @await paused("second")
+  nodeJsAssert.equal(result2, "second")
+}
+
+let f = async () => ()
+let f = async (. ()) => ()
+let f = async (f) => f()
+let f = async (a, b) => a + b
+let f = async (. a, b) => a + b