Fix problem with parameterized record types

Author: mrmurphy

ppx_src/src/Records.ml

@@ -44,7 +44,7 @@ let wrapInSpreadEncoders parsedFields baseExpr =
     (fun spreadExpr acc -> [%expr [%e spreadExpr] [%e acc]])
     spreadExprs baseExpr
 
-let generateEncoder parsedFields unboxed (rootTypeNameOfRecord : label) =
+let generateEncoder parsedFields unboxed (rootRecordTypeInfo : typeInfo) =
   (* If we've got a record with a spread type in it, we'll need to omit the spread
      from the generated fields, and handle its encoding differently. *)
   let parsedFieldsWithoutSpread =
@@ -58,7 +58,7 @@ let generateEncoder parsedFields unboxed (rootTypeNameOfRecord : label) =
        do more construction of things by hand with Ast_helper. *)
     Ast_helper.Pat.constraint_
       [%pat? valueToEncode]
-      (Utils.labelToCoreType rootTypeNameOfRecord)
+      (Utils.typeNameAndParamsToTypeDeclaration rootRecordTypeInfo)
   in
   match unboxed with
   | true ->
@@ -204,7 +204,7 @@ let generateDecoder decls unboxed =
         | Js.Json.JSONObject dict -> [%e generateNestedSwitches decls]
         | _ -> Decco.error "Not an object" v]
 
-let parseRecordField encodeDecodeFlags (rootTypeNameOfRecord : label)
+let parseRecordField encodeDecodeFlags
     {pld_name = {txt}; pld_loc; pld_type; pld_attributes} =
   let default =
     match getAttributeByName pld_attributes "decco.default" with
@@ -247,16 +247,13 @@ let parseRecordField encodeDecodeFlags (rootTypeNameOfRecord : label)
   }
 
 let generateCodecs ({doEncode; doDecode} as encodeDecodeFlags)
-    recordFieldDeclarations unboxed (rootTypeNameOfRecord : label) =
+    recordFieldDeclarations unboxed (rootRecordTypeInfo : typeInfo) =
   let parsedFieldDeclarations =
-    List.map
-      (parseRecordField encodeDecodeFlags rootTypeNameOfRecord)
-      recordFieldDeclarations
+    List.map (parseRecordField encodeDecodeFlags) recordFieldDeclarations
   in
   ( (match doEncode with
     | true ->
-      Some
-        (generateEncoder parsedFieldDeclarations unboxed rootTypeNameOfRecord)
+      Some (generateEncoder parsedFieldDeclarations unboxed rootRecordTypeInfo)
     | false -> None),
     match doDecode with
     | true -> Some (generateDecoder parsedFieldDeclarations unboxed)

ppx_src/src/Structure.ml

@@ -57,11 +57,19 @@ let buildRightHandSideOfEqualSignForCodecDeclarations (paramNames : label list)
 (* This is where the value bindings get made for the codec functions
    but it isn't where the codec functions themselves are generated. Those
    get passed in. This is the outermost layer of the t_encode and t_decode functions *)
-let generateCodecDecls typeName paramNames (encoder, decoder) =
-  let encoderPat = Pat.var (mknoloc (typeName ^ Utils.encoderFuncSuffix)) in
-  let encoderParamNames = List.map (fun s -> encoderVarPrefix ^ s) paramNames in
-  let decoderPat = Pat.var (mknoloc (typeName ^ Utils.decoderFuncSuffix)) in
-  let decoderParamNames = List.map (fun s -> decoderVarPrefix ^ s) paramNames in
+let generateCodecDecls (typeInfo : typeInfo) (encoder, decoder) =
+  let encoderPat =
+    Pat.var (mknoloc (typeInfo.typeName ^ Utils.encoderFuncSuffix))
+  in
+  let encoderParamNames =
+    List.map (fun s -> encoderVarPrefix ^ s) typeInfo.typeParams
+  in
+  let decoderPat =
+    Pat.var (mknoloc (typeInfo.typeName ^ Utils.decoderFuncSuffix))
+  in
+  let decoderParamNames =
+    List.map (fun s -> decoderVarPrefix ^ s) typeInfo.typeParams
+  in
   let encoderBindings =
     match encoder with
     | None -> []
@@ -71,9 +79,7 @@ let generateCodecDecls typeName paramNames (encoder, decoder) =
           ~attrs:[attrWarning [%expr "-39"]]
           encoderPat
           (buildRightHandSideOfEqualSignForCodecDeclarations encoderParamNames
-             encoder
-             {typeName; typeParams = paramNames}
-             true);
+             encoder typeInfo true);
       ]
   in
   let decoderBindings =
@@ -85,9 +91,7 @@ let generateCodecDecls typeName paramNames (encoder, decoder) =
           ~attrs:[attrWarning [%expr "-4"]; attrWarning [%expr "-39"]]
           decoderPat
           (buildRightHandSideOfEqualSignForCodecDeclarations decoderParamNames
-             decoder
-             {typeName; typeParams = paramNames}
-             false);
+             decoder typeInfo false);
       ]
   in
   [] @ encoderBindings @ decoderBindings
@@ -114,6 +118,7 @@ let mapTypeDecl decl =
   match makeEncodeDecodeFlagsFromDecoratorAttributes ptype_attributes with
   | Ok None -> []
   | Ok (Some encodeDecodeFlags) -> (
+    let typeInfo = {typeName; typeParams = getParamNames ptype_params} in
     (* Here we call the code to generate the codecs and build their
        value bindings (the let t_decode = ... part). We have various different
        types to handle, so there's a switch. Most simple cases are covered in
@@ -126,21 +131,17 @@ let mapTypeDecl decl =
       fail ptype_loc "Can't generate codecs for unspecified type"
     | Some {ptyp_desc = Ptyp_variant (rowFields, _, _)}, Ptype_abstract ->
       let rowFieldsDec = List.map (fun row -> row.prf_desc) rowFields in
-      generateCodecDecls typeName
-        (getParamNames ptype_params)
+      generateCodecDecls typeInfo
         (Polyvariants.generateCodecs encodeDecodeFlags rowFieldsDec isUnboxed)
     | Some manifest, _ ->
-      generateCodecDecls typeName
-        (getParamNames ptype_params)
+      generateCodecDecls typeInfo
         (Codecs.generateCodecs encodeDecodeFlags manifest)
     | None, Ptype_variant decls ->
-      generateCodecDecls typeName
-        (getParamNames ptype_params)
+      generateCodecDecls typeInfo
         (Variants.generateCodecs encodeDecodeFlags decls isUnboxed)
     | None, Ptype_record decls ->
-      generateCodecDecls typeName
-        (getParamNames ptype_params)
-        (Records.generateCodecs encodeDecodeFlags decls isUnboxed typeName)
+      generateCodecDecls typeInfo
+        (Records.generateCodecs encodeDecodeFlags decls isUnboxed typeInfo)
     | _ -> fail ptype_loc "This type is not handled by decco")
   | Error s -> fail ptype_loc s
 

ppx_src/src/Utils.ml

@@ -141,5 +141,5 @@ let labelToCoreType label = Ast_helper.Typ.constr (lid label) []
 
 type typeInfo = {typeName: label; typeParams: label list}
 
-let typeNameAndParamsToTypeDeclaration {typeName; typeParams} =
+let typeNameAndParamsToTypeDeclaration ({typeName; typeParams} : typeInfo) =
   Typ.constr (lid typeName) (List.map (fun s -> Typ.var s) typeParams)

test/compiler_only_tests/ParameterizedRecords.res

@@ -0,0 +1,6 @@
+// At one point we had a regression where
+// the PPX failed to generate the type parameters
+// for the type of the decoder when using a parameterized
+// record. This test ensures that the issue is fixed.
+@decco
+type t<'param> = {blob: 'param}

test/compiler_only_tests/ReadMe.md

@@ -0,0 +1 @@
+This directory just contains rescript files that will be typechecked when `rescript build` runs. They don't run jest tests. But if they have a compiler error, they should fail the build.