fix ppx for forwardRef

Author: mununki

cli/reactjs_jsx_ppx_v3.ml

@@ -14,6 +14,10 @@ let isOptional str = match str with Optional _ -> true | _ -> false
 
 let isLabelled str = match str with Labelled _ -> true | _ -> false
 
+let isForwardRef = function
+| { pexp_desc = Pexp_ident { txt = (Ldot (Lident "React", "forwardRef")) } } -> true
+| _ -> false
+
 let getLabel str = match str with Optional str | Labelled str -> str | Nolabel -> ""
 
 let optionIdent = Lident "option"
@@ -34,12 +38,7 @@ let safeTypeFromValue valueStr =
 
 let keyType loc = Typ.constr ~loc { loc; txt = Lident "string" } []
 
-let refType loc = Typ.constr ~loc { loc; txt = Ldot (Lident "React", "ref") }
-                  [ 
-                    (Typ.constr ~loc { loc; txt = Ldot (Ldot (Lident "Js", "Nullable"), "t")}
-                      [(Typ.constr ~loc { loc; txt = Ldot (Lident "Dom", "element") } [])]
-                    ) 
-                  ]
+let refType loc = (Typ.constr ~loc { loc; txt = Ldot (Ldot (Lident "ReactDOM", "Ref"), "currentDomRef") } [])
 
 type 'a children = ListLiteral of 'a | Exact of 'a
 
@@ -570,9 +569,10 @@ let jsxMapper () =
                        pattern,
                        ({ pexp_desc = Pexp_fun _ } as internalExpression) );
                 } ->
-                    let wrap, hasUnit, exp = spelunkForFunExpression internalExpression in
+                    let wrap, hasUnit, hasForwardRef, exp = spelunkForFunExpression internalExpression in
                     ( wrap,
                       hasUnit,
+                      hasForwardRef,
                       unerasableIgnoreExp { expression with pexp_desc = Pexp_fun (label, default, pattern, exp) } )
                 (* let make = (()) => ... *)
                 (* let make = (_) => ... *)
@@ -584,13 +584,13 @@ let jsxMapper () =
                        { ppat_desc = Ppat_construct ({ txt = Lident "()" }, _) | Ppat_any },
                        _internalExpression );
                 } ->
-                    ((fun a -> a), true, expression)
+                    ((fun a -> a), true, false, expression)
                 (* let make = (~prop) => ... *)
                 | { pexp_desc = Pexp_fun ((Labelled _ | Optional _), _default, _pattern, _internalExpression) } ->
-                    ((fun a -> a), false, unerasableIgnoreExp expression)
+                    ((fun a -> a), false, false, unerasableIgnoreExp expression)
                 (* let make = (prop) => ... *)
                 | { pexp_desc = Pexp_fun (_nolabel, _default, pattern, _internalExpression) } ->
-                    if hasApplication.contents then ((fun a -> a), false, unerasableIgnoreExp expression)
+                    if !hasApplication then ((fun a -> a), false, false, unerasableIgnoreExp expression)
                     else
                       Location.raise_errorf ~loc:pattern.ppat_loc
                         "React: props need to be labelled arguments.\n\
@@ -599,28 +599,35 @@ let jsxMapper () =
                 (* let make = {let foo = bar in (~prop) => ...} *)
                 | { pexp_desc = Pexp_let (recursive, vbs, internalExpression) } ->
                     (* here's where we spelunk! *)
-                    let wrap, hasUnit, exp = spelunkForFunExpression internalExpression in
-                    (wrap, hasUnit, { expression with pexp_desc = Pexp_let (recursive, vbs, exp) })
+                    let wrap, hasUnit, hasForwardRef, exp = spelunkForFunExpression internalExpression in
+                    (wrap, hasUnit, hasForwardRef, { expression with pexp_desc = Pexp_let (recursive, vbs, exp) })
                 (* let make = React.forwardRef((~prop) => ...) *)
                 | { pexp_desc = Pexp_apply (wrapperExpression, [ (Nolabel, internalExpression) ]) } ->
                     let () = hasApplication := true in
-                    let _, hasUnit, exp = spelunkForFunExpression internalExpression in
-                    ((fun exp -> Exp.apply wrapperExpression [ (nolabel, exp) ]), hasUnit, exp)
+                    let _, hasUnit, _, exp = spelunkForFunExpression internalExpression in
+                    let hasForwardRef = isForwardRef wrapperExpression in
+                    ((fun exp -> Exp.apply wrapperExpression [ (nolabel, exp) ]), hasUnit, hasForwardRef, exp)
                 | { pexp_desc = Pexp_sequence (wrapperExpression, internalExpression) } ->
-                    let wrap, hasUnit, exp = spelunkForFunExpression internalExpression in
-                    (wrap, hasUnit, { expression with pexp_desc = Pexp_sequence (wrapperExpression, exp) })
-                | e -> ((fun a -> a), false, e)
+                    let wrap, hasUnit, hasForwardRef, exp = spelunkForFunExpression internalExpression in
+                    (wrap, hasUnit, hasForwardRef, { expression with pexp_desc = Pexp_sequence (wrapperExpression, exp) })
+                | e -> ((fun a -> a), false, false, e)
               in
-              let wrapExpression, hasUnit, expression = spelunkForFunExpression expression in
-              (wrapExpressionWithBinding wrapExpression, hasUnit, expression)
+              let wrapExpression, hasUnit, hasForwardRef, expression = spelunkForFunExpression expression in
+              (wrapExpressionWithBinding wrapExpression, hasUnit, hasForwardRef, expression)
             in
-            let bindingWrapper, _hasUnit, expression = modifiedBinding binding in
+            let bindingWrapper, _hasUnit, hasForwardRef, expression = modifiedBinding binding in
             (* do stuff here! *)
             let namedArgList, _newtypes, _forwardRef =
               recursivelyTransformNamedArgsForMake mapper (modifiedBindingOld binding) [] []
             in
             let namedTypeList = List.fold_left argToType [] namedArgList in
+            (* let _ = ref *)
             let vbIgnoreUnusedRef = Vb.mk (Pat.any ()) (Exp.ident (Location.mknoloc (Lident "ref"))) in
+            (* let ref = ref->Js.Nullable.fromOption *)
+            let vbRefFromOption = Vb.mk (Pat.var @@ Location.mknoloc "ref")
+              (Exp.apply (Exp.ident (Location.mknoloc (Ldot (Ldot (Lident "Js", "Nullable"), "fromOption"))))
+                [(Nolabel, Exp.ident (Location.mknoloc @@ Lident "ref"))])
+            in
             let namedArgWithDefaultValueList = List.filter_map argWithDefaultValue namedArgList in
             let vbMatch ((label, default)) =
               Vb.mk (Pat.var (Location.mknoloc label))
@@ -640,19 +647,31 @@ let jsxMapper () =
               makePropsRecordType "props" emptyLoc
                 ((true, "key", [], keyType emptyLoc) :: (true, "ref", [], refType pstr_loc) :: namedTypeList)
             in
-            let innerExpression = Exp.apply (Exp.ident (Location.mknoloc @@ Lident "make"))
-                                    [(Nolabel, Exp.ident (Location.mknoloc @@ Lident "props"))]
+            let innerExpression = if hasForwardRef then
+              Exp.apply (Exp.ident @@ Location.mknoloc @@ Lident "make")
+                [(Nolabel, Exp.record
+                  [ (Location.mknoloc @@ Lident "ref", Exp.apply ~attrs:optionalAttr
+                    (Exp.ident (Location.mknoloc (Ldot (Ldot (Lident "Js", "Nullable"), "toOption"))))
+                    [ (Nolabel, Exp.ident (Location.mknoloc @@ Lident "ref")) ])
+                  ]
+                  (Some (Exp.ident (Location.mknoloc @@ Lident "props"))))]
+              else Exp.apply (Exp.ident (Location.mknoloc @@ Lident "make"))
+                [(Nolabel, Exp.ident (Location.mknoloc @@ Lident "props"))]
             in
             let fullExpression =
               (* React component name should start with uppercase letter *)
               (* let make = { let \"App" = props => make(props); \"App" } *)
+              (* let make = React.forwardRef({
+                  let \"App" = (props, ref) => make({...props, ref: @optional (Js.Nullabel.toOption(ref))})
+                })*)
               Exp.fun_ nolabel None
               (match namedTypeList with
               | [] -> (Pat.var @@ Location.mknoloc "props")
               | _ -> (Pat.constraint_
                         (Pat.var @@ Location.mknoloc "props")
                         (Typ.constr (Location.mknoloc @@ Lident "props")([Typ.any ()]))))
-                innerExpression
+                (if hasForwardRef then Exp.fun_ nolabel None (Pat.var @@ Location.mknoloc "ref") innerExpression
+                else innerExpression)
             in
             let fullExpression =
               match fullModuleName with
@@ -667,7 +686,10 @@ let jsxMapper () =
               | Pexp_fun (_arg_label, _default, { ppat_desc = Ppat_construct ({ txt = Lident "()" }, _) | Ppat_any }, expr) ->
                 (patterns, expr)
               | Pexp_fun (arg_label, _default, { ppat_loc }, expr) ->
-                returnedExpression (({loc = ppat_loc; txt = Lident (getLabel arg_label)}, Pat.var { txt = getLabel arg_label; loc = ppat_loc}) :: patterns) expr
+                if isLabelled arg_label || isOptional arg_label then
+                  returnedExpression (({loc = ppat_loc; txt = Lident (getLabel arg_label)}, Pat.var { txt = getLabel arg_label; loc = ppat_loc}) :: patterns) expr
+                else
+                  returnedExpression patterns expr
               | _ -> (patterns, expr)
             in
             let patternsWithLid, expression = returnedExpression [] expression in
@@ -677,6 +699,7 @@ let jsxMapper () =
             let expression = if List.length vbMatchList = 0 then expression else (Exp.let_ Nonrecursive vbMatchList expression) in
             (* add let _ = ref to ignore unused warning *)
             let expression = Exp.let_ Nonrecursive [ vbIgnoreUnusedRef ] expression in
+            let expression = Exp.let_ Nonrecursive [ vbRefFromOption ] expression in
             let expression = Exp.fun_ Nolabel None
               begin
               Pat.constraint_ pattern

tests/ppx/react/expected/commentAtTop.res.txt

@@ -1,10 +1,7 @@
-type props<'msg> = { // test React JSX file
-  @optional key: string,
-  @optional ref: React.ref<Js.Nullable.t<Dom.element>>,
-  msg: 'msg,
-}
+type props<'msg> = {@optional key: string, @optional ref: ReactDOM.Ref.currentDomRef, msg: 'msg} // test React JSX file
 
 let make = ({msg, ref}: props<'msg>) => {
+  let ref = Js.Nullable.fromOption(ref)
   let _ = ref
 
   {

tests/ppx/react/expected/externalWithCustomName.res.txt

@@ -1,7 +1,7 @@
 module Foo = {
   type props<'a, 'b> = {
     @optional key: string,
-    @optional ref: React.ref<Js.Nullable.t<Dom.element>>,
+    @optional ref: ReactDOM.Ref.currentDomRef,
     a: 'a,
     b: 'b,
   }

tests/ppx/react/expected/innerModule.res.txt

@@ -1,11 +1,12 @@
 module Bar = {
   type props<'a, 'b> = {
     @optional key: string,
-    @optional ref: React.ref<Js.Nullable.t<Dom.element>>,
+    @optional ref: ReactDOM.Ref.currentDomRef,
     a: 'a,
     b: 'b,
   }
   let make = ({a, b, ref}: props<'a, 'b>) => {
+    let ref = Js.Nullable.fromOption(ref)
     let _ = ref
 
     Js.log("This function should be named `InnerModule.react$Bar`")
@@ -17,12 +18,13 @@ module Bar = {
   }
   type props<'a, 'b> = {
     @optional key: string,
-    @optional ref: React.ref<Js.Nullable.t<Dom.element>>,
+    @optional ref: ReactDOM.Ref.currentDomRef,
     a: 'a,
     b: 'b,
   }
 
   let component = ({a, b, ref}: props<'a, 'b>) => {
+    let ref = Js.Nullable.fromOption(ref)
     let _ = ref
 
     Js.log("This function should be named `InnerModule.react$Bar$component`")

tests/ppx/react/expected/newtype.res.txt

@@ -1,11 +1,12 @@
 type props<'a, 'b, 'c> = {
   @optional key: string,
-  @optional ref: React.ref<Js.Nullable.t<Dom.element>>,
+  @optional ref: ReactDOM.Ref.currentDomRef,
   a: 'a,
   b: 'b,
   c: 'c,
 }
 let make = ({ref}: props<'a, 'b, 'c>) => {
+  let ref = Js.Nullable.fromOption(ref)
   let _ = ref
   (type a, ~a: a, ~b: array<option<[#Foo(a)]>>, ~c: 'a, _) =>
     ReactDOMRe.createDOMElementVariadic("div", [])

tests/ppx/react/expected/topLevel.res.txt

@@ -1,10 +1,11 @@
 type props<'a, 'b> = {
   @optional key: string,
-  @optional ref: React.ref<Js.Nullable.t<Dom.element>>,
+  @optional ref: ReactDOM.Ref.currentDomRef,
   a: 'a,
   b: 'b,
 }
 let make = ({a, b, ref}: props<'a, 'b>) => {
+  let ref = Js.Nullable.fromOption(ref)
   let _ = ref
 
   Js.log("This function should be named 'TopLevel.react'")

tests/ppx/react/expected/typeConstraint.res.txt

@@ -1,10 +1,11 @@
 type props<'a, 'b> = {
   @optional key: string,
-  @optional ref: React.ref<Js.Nullable.t<Dom.element>>,
+  @optional ref: ReactDOM.Ref.currentDomRef,
   a: 'a,
   b: 'b,
 }
 let make: 'a. (~a: 'a, ~b: 'a, 'a) => React.element = ({ref}: props<'a, 'b>) => {
+  let ref = Js.Nullable.fromOption(ref)
   let _ = ref
   (type a): ((~a: a, ~b: a, a) => React.element) =>
     (~a, ~b, _) => ReactDOMRe.createDOMElementVariadic("div", [])