react.component sharedProps argument

Author: mununki

cli/react_jsx_common.ml

@@ -16,6 +16,25 @@ let hasAttr (loc, _) = loc.txt = "react.component"
 let hasAttrOnBinding {pvb_attributes} =
   List.find_opt hasAttr pvb_attributes <> None
 
+let coreTypeOfAttrs attributes =
+  List.find_map
+    (fun ({txt}, payload) ->
+      match (txt, payload) with
+      | "react.component", PTyp coreType -> Some coreType
+      | _ -> None)
+    attributes
+
+let typVarsOfCoreType {ptyp_desc} =
+  match ptyp_desc with
+  | Ptyp_constr (_, coreTypes) ->
+    List.filter
+      (fun {ptyp_desc} ->
+        match ptyp_desc with
+        | Ptyp_var _ -> true
+        | _ -> false)
+      coreTypes
+  | _ -> []
+
 let raiseError ~loc msg = Location.raise_errorf ~loc msg
 
 let raiseErrorMultipleReactComponent ~loc =

cli/reactjs_jsx_v4.ml

@@ -311,13 +311,30 @@ let makeTypeDecls propsName loc namedTypeList =
       ~kind:(Ptype_record labelDeclList);
   ]
 
+let makeTypeDeclsWithCoreType propsName loc coreType typVars =
+  [
+    Type.mk ~loc {txt = propsName; loc} ~kind:Ptype_abstract
+      ~params:(typVars |> List.map (fun v -> (v, Invariant)))
+      ~manifest:coreType;
+  ]
+
 (* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *)
-let makePropsRecordType propsName loc namedTypeList =
-  Str.type_ Nonrecursive (makeTypeDecls propsName loc namedTypeList)
+let makePropsRecordType ~coreTypeOfAttr ~typVarsOfCoreType propsName loc
+    namedTypeList =
+  Str.type_ Nonrecursive
+    (match coreTypeOfAttr with
+    | None -> makeTypeDecls propsName loc namedTypeList
+    | Some coreType ->
+      makeTypeDeclsWithCoreType propsName loc coreType typVarsOfCoreType)
 
 (* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *)
-let makePropsRecordTypeSig propsName loc namedTypeList =
-  Sig.type_ Nonrecursive (makeTypeDecls propsName loc namedTypeList)
+let makePropsRecordTypeSig ~coreTypeOfAttr ~typVarsOfCoreType propsName loc
+    namedTypeList =
+  Sig.type_ Nonrecursive
+    (match coreTypeOfAttr with
+    | None -> makeTypeDecls propsName loc namedTypeList
+    | Some coreType ->
+      makeTypeDeclsWithCoreType propsName loc coreType typVarsOfCoreType)
 
 let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc
     attrs callArguments =
@@ -733,6 +750,12 @@ let transformStructureItem ~config mapper item =
         config.hasReactComponent <- true;
         check_string_int_attribute_iter.structure_item
           check_string_int_attribute_iter item;
+        let coreTypeOfAttr = React_jsx_common.coreTypeOfAttrs pval_attributes in
+        let typVarsOfCoreType =
+          coreTypeOfAttr
+          |> Option.map React_jsx_common.typVarsOfCoreType
+          |> Option.value ~default:[]
+        in
         let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) =
           match ptyp_desc with
           | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest))
@@ -749,11 +772,14 @@ let transformStructureItem ~config mapper item =
         let retPropsType =
           Typ.constr ~loc:pstr_loc
             (Location.mkloc (Lident "props") pstr_loc)
-            (makePropsTypeParams namedTypeList)
+            (match coreTypeOfAttr with
+            | None -> makePropsTypeParams namedTypeList
+            | Some _ -> typVarsOfCoreType)
         in
         (* type props<'x, 'y> = { x: 'x, y?: 'y, ... } *)
         let propsRecordType =
-          makePropsRecordType "props" pstr_loc namedTypeList
+          makePropsRecordType ~coreTypeOfAttr ~typVarsOfCoreType "props"
+            pstr_loc namedTypeList
         in
         (* can't be an arrow because it will defensively uncurry *)
         let newExternalType =
@@ -787,6 +813,14 @@ let transformStructureItem ~config mapper item =
           React_jsx_common.raiseErrorMultipleReactComponent ~loc:pstr_loc
         else (
           config.hasReactComponent <- true;
+          let coreTypeOfAttr =
+            React_jsx_common.coreTypeOfAttrs binding.pvb_attributes
+          in
+          let typVarsOfCoreType =
+            coreTypeOfAttr
+            |> Option.map React_jsx_common.typVarsOfCoreType
+            |> Option.value ~default:[]
+          in
           let bindingLoc = binding.pvb_loc in
           let bindingPatLoc = binding.pvb_pat.ppat_loc in
           let binding =
@@ -977,7 +1011,8 @@ let transformStructureItem ~config mapper item =
           let vbMatchList = List.map vbMatch namedArgWithDefaultValueList in
           (* type props = { ... } *)
           let propsRecordType =
-            makePropsRecordType "props" pstr_loc namedTypeList
+            makePropsRecordType ~coreTypeOfAttr ~typVarsOfCoreType "props"
+              pstr_loc namedTypeList
           in
           let innerExpression =
             Exp.apply
@@ -989,19 +1024,23 @@ let transformStructureItem ~config mapper item =
                 [(Nolabel, Exp.ident (Location.mknoloc @@ Lident "ref"))]
               | false -> [])
           in
+          let makePropsPattern = function
+            | [] -> Pat.var @@ Location.mknoloc "props"
+            | _ ->
+              Pat.constraint_
+                (Pat.var @@ Location.mknoloc "props")
+                (Typ.constr (Location.mknoloc @@ Lident "props") [Typ.any ()])
+          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 ()]))
+              (match coreTypeOfAttr with
+              | None -> makePropsPattern namedTypeList
+              | Some _ -> makePropsPattern typVarsOfCoreType)
               (if hasForwardRef then
                Exp.fun_ nolabel None
                  (Pat.var @@ Location.mknoloc "ref")
@@ -1105,8 +1144,12 @@ let transformStructureItem ~config mapper item =
               (Pat.constraint_ recordPattern
                  (Typ.constr ~loc:emptyLoc
                     {txt = Lident "props"; loc = emptyLoc}
-                    (makePropsTypeParams ~stripExplicitOption:true
-                       ~stripExplicitJsNullableOfRef:hasForwardRef namedTypeList)))
+                    (match coreTypeOfAttr with
+                    | None ->
+                      makePropsTypeParams ~stripExplicitOption:true
+                        ~stripExplicitJsNullableOfRef:hasForwardRef
+                        namedTypeList
+                    | Some _ -> typVarsOfCoreType)))
               expression
           in
           (* let make = ({id, name, ...}: props<'id, 'name, ...>) => { ... } *)
@@ -1182,6 +1225,12 @@ let transformSignatureItem ~config _mapper item =
       check_string_int_attribute_iter.signature_item
         check_string_int_attribute_iter item;
       let hasForwardRef = ref false in
+      let coreTypeOfAttr = React_jsx_common.coreTypeOfAttrs pval_attributes in
+      let typVarsOfCoreType =
+        coreTypeOfAttr
+        |> Option.map React_jsx_common.typVarsOfCoreType
+        |> Option.value ~default:[]
+      in
       let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) =
         match ptyp_desc with
         | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest))
@@ -1204,10 +1253,13 @@ let transformSignatureItem ~config _mapper item =
       let retPropsType =
         Typ.constr
           (Location.mkloc (Lident "props") psig_loc)
-          (makePropsTypeParams namedTypeList)
+          (match coreTypeOfAttr with
+          | None -> makePropsTypeParams namedTypeList
+          | Some _ -> typVarsOfCoreType)
       in
       let propsRecordType =
-        makePropsRecordTypeSig "props" psig_loc
+        makePropsRecordTypeSig ~coreTypeOfAttr ~typVarsOfCoreType "props"
+          psig_loc
           ((* If there is Nolabel arg, regard the type as ref in forwardRef *)
            (if !hasForwardRef then [(true, "ref", [], refType Location.none)]
            else [])

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

@@ -0,0 +1,71 @@
+@@jsxConfig({version: 4, mode: "classic"})
+
+module V4C1 = {
+  type props = sharedProps<string>
+
+  @react.component(: sharedProps<string>) let make = ({x, y, _}: props) => React.string(x ++ y)
+  let make = {
+    let \"SharedProps$V4C1" = props => make(props)
+
+    \"SharedProps$V4C1"
+  }
+}
+
+module V4C2 = {
+  type props<'a> = sharedProps<'a>
+
+  @react.component(: sharedProps<'a>) let make = ({x, y, _}: props<'a>) => React.string(x ++ y)
+  let make = {
+    let \"SharedProps$V4C2" = (props: props<_>) => make(props)
+
+    \"SharedProps$V4C2"
+  }
+}
+
+module V4C3 = {
+  type props = sharedProps<string>
+
+  external make: React.componentLike<props, React.element> = "default"
+}
+
+module V4C4 = {
+  type props<'a> = sharedProps<'a>
+
+  external make: React.componentLike<props<'a>, React.element> = "default"
+}
+
+@@jsxConfig({version: 4, mode: "automatic"})
+
+module V4A1 = {
+  type props = sharedProps<string>
+
+  @react.component(: sharedProps<string>) let make = ({x, y, _}: props) => React.string(x ++ y)
+  let make = {
+    let \"SharedProps$V4A1" = props => make(props)
+
+    \"SharedProps$V4A1"
+  }
+}
+
+module V4A2 = {
+  type props<'a> = sharedProps<'a>
+
+  @react.component(: sharedProps<'a>) let make = ({x, y, _}: props<'a>) => React.string(x ++ y)
+  let make = {
+    let \"SharedProps$V4A2" = (props: props<_>) => make(props)
+
+    \"SharedProps$V4A2"
+  }
+}
+
+module V4A3 = {
+  type props = sharedProps<string>
+
+  external make: React.componentLike<props, React.element> = "default"
+}
+
+module V4A4 = {
+  type props<'a> = sharedProps<'a>
+
+  external make: React.componentLike<props<'a>, React.element> = "default"
+}

tests/ppx/react/expected/sharedProps.resi.txt

@@ -0,0 +1,27 @@
+@@jsxConfig({version: 4, mode: "classic"})
+
+module V4C1: {
+  type props = sharedProps<string>
+
+  let make: React.componentLike<props, React.element>
+}
+
+module V4C2: {
+  type props<'a> = sharedProps<'a>
+
+  let make: React.componentLike<props<'a>, React.element>
+}
+
+@@jsxConfig({version: 4, mode: "automatic"})
+
+module V4A1: {
+  type props = sharedProps<string>
+
+  let make: React.componentLike<props, React.element>
+}
+
+module V4A2: {
+  type props<'a> = sharedProps<'a>
+
+  let make: React.componentLike<props<'a>, React.element>
+}

tests/ppx/react/sharedProps.res

@@ -0,0 +1,43 @@
+@@jsxConfig({version:4, mode: "classic"})
+
+module V4C1 = {
+  @react.component(:sharedProps<string>)
+  let make = (~x, ~y) => React.string(x ++ y)
+}
+
+module V4C2 = {
+  @react.component(:sharedProps<'a>)
+  let make = (~x, ~y) => React.string(x ++ y)
+}
+
+module V4C3 = {
+  @react.component(:sharedProps<string>)
+  external make: (~x: string, ~y: 'a) => React.element = "default"
+}
+
+module V4C4 = {
+  @react.component(:sharedProps<'a>)
+  external make: (~x: string, ~y: 'a) => React.element = "default"
+}
+
+@@jsxConfig({version:4, mode: "automatic"})
+
+module V4A1 = {
+  @react.component(:sharedProps<string>)
+  let make = (~x, ~y) => React.string(x ++ y)
+}
+
+module V4A2 = {
+  @react.component(:sharedProps<'a>)
+  let make = (~x, ~y) => React.string(x ++ y)
+}
+
+module V4A3 = {
+  @react.component(:sharedProps<string>)
+  external make: (~x: string, ~y: 'a) => React.element = "default"
+}
+
+module V4A4 = {
+  @react.component(:sharedProps<'a>)
+  external make: (~x: string, ~y: 'a) => React.element = "default"
+}

tests/ppx/react/sharedProps.resi

@@ -0,0 +1,23 @@
+@@jsxConfig({version:4, mode: "classic"})
+
+module V4C1: {
+  @react.component(:sharedProps<string>)
+  let make: (~x: string) => React.element
+}
+
+module V4C2: {
+  @react.component(:sharedProps<'a>)
+  let make: (~x: string) => React.element
+}
+
+@@jsxConfig({version:4, mode: "automatic"})
+
+module V4A1: {
+  @react.component(:sharedProps<string>)
+  let make: (~x: string) => React.element
+}
+
+module V4A2: {
+  @react.component(:sharedProps<'a>)
+  let make: (~x: string) => React.element
+}