Fix deriving accessors in uncurried mode (#6687)

* Implement handle uncurried in deriving accessors

* Handle variants with no parameters in transform and move build tests

* Add deriving accessors fix to the changelog

Author: JonoPrest

CHANGELOG.md

@@ -15,6 +15,7 @@
 #### :bug: Bug Fix
 
 - Fix misparsing in/after JSX. https://github.com/rescript-lang/rescript-compiler/pull/6686
+- Fix `@deriving(accessors)` outputting curried functions in uncurried mode https://github.com/rescript-lang/rescript-compiler/pull/6687
 
 # 11.1.0-rc.4
 

jscomp/frontend/ast_derive_projector.ml

@@ -14,6 +14,13 @@ let init () =
       {
         structure_gen =
           (fun (tdcls : tdcls) _explict_nonrec ->
+            let handle_uncurried_accessor_tranform ~loc ~arity accessor =
+              (* Accessors with no params (arity of 0) are simply values and not functions *)
+              match Config.uncurried.contents with
+              | Uncurried when arity > 0 ->
+                Ast_uncurried.uncurriedFun ~loc ~arity accessor
+              | _ -> accessor
+            in
             let handle_tdcl tdcl =
               let core_type =
                 Ast_derive_util.core_type_of_type_declaration tdcl
@@ -39,7 +46,9 @@ let init () =
                          (Pat.constraint_ (Pat.var {txt; loc}) core_type)
                          (Exp.field
                             (Exp.ident {txt = Lident txt; loc})
-                            {txt = Longident.Lident pld_label; loc})))
+                            {txt = Longident.Lident pld_label; loc})
+                      (*arity will alwys be 1 since these are single param functions*)
+                      |> handle_uncurried_accessor_tranform ~arity:1 ~loc))
               | Ptype_variant constructor_declarations ->
                 Ext_list.map constructor_declarations
                   (fun
@@ -94,7 +103,8 @@ let init () =
                              annotate_type
                          in
                          Ext_list.fold_right vars exp (fun var b ->
-                             Ast_compatible.fun_ (Pat.var {loc; txt = var}) b)))
+                             Ast_compatible.fun_ (Pat.var {loc; txt = var}) b)
+                         |> handle_uncurried_accessor_tranform ~loc ~arity))
               | Ptype_abstract | Ptype_open ->
                 Ast_derive_util.notApplicable tdcl.ptype_loc derivingName;
                 []
@@ -103,6 +113,13 @@ let init () =
             Ext_list.flat_map tdcls handle_tdcl);
         signature_gen =
           (fun (tdcls : Parsetree.type_declaration list) _explict_nonrec ->
+            let handle_uncurried_type_tranform ~loc ~arity t =
+              match Config.uncurried.contents with
+              (* Accessors with no params (arity of 0) are simply values and not functions *)
+              | Uncurried when arity > 0 ->
+                Ast_uncurried.uncurriedType ~loc ~arity t
+              | _ -> t
+            in
             let handle_tdcl tdcl =
               let core_type =
                 Ast_derive_util.core_type_of_type_declaration tdcl
@@ -119,7 +136,10 @@ let init () =
               | Ptype_record label_declarations ->
                 Ext_list.map label_declarations (fun {pld_name; pld_type} ->
                     Ast_comb.single_non_rec_val ?attrs:gentype_attrs pld_name
-                      (Ast_compatible.arrow core_type pld_type))
+                      (Ast_compatible.arrow core_type pld_type
+                      (*arity will alwys be 1 since these are single param functions*)
+                      |> handle_uncurried_type_tranform ~arity:1
+                           ~loc:pld_name.loc))
               | Ptype_variant constructor_declarations ->
                 Ext_list.map constructor_declarations
                   (fun
@@ -135,6 +155,7 @@ let init () =
                       | Pcstr_tuple pcd_args -> pcd_args
                       | Pcstr_record _ -> assert false
                     in
+                    let arity = pcd_args |> List.length in
                     let annotate_type =
                       match pcd_res with
                       | Some x -> x
@@ -143,7 +164,8 @@ let init () =
                     Ast_comb.single_non_rec_val ?attrs:gentype_attrs
                       {loc; txt = Ext_string.uncapitalize_ascii con_name}
                       (Ext_list.fold_right pcd_args annotate_type (fun x acc ->
-                           Ast_compatible.arrow x acc)))
+                           Ast_compatible.arrow x acc)
+                      |> handle_uncurried_type_tranform ~arity ~loc))
               | Ptype_open | Ptype_abstract ->
                 Ast_derive_util.notApplicable tdcl.ptype_loc derivingName;
                 []

jscomp/test/DerivingAccessorsCurried.js

@@ -0,0 +1,21 @@
+//Assert that deriving accessors does not break
+//In curried mode
+
+@deriving(accessors)
+type myRecord = { myField: int }
+
+@deriving(accessors)
+type variant = | NoParam | Num(int) | DoubleNum(int, int)
+
+//Asserts the correct signature for derived accessor
+let _myFieldAlias: myRecord => int = myField
+let _noParamAlias: variant = noParam
+let _numAlias: int => variant = num
+let _doubleNumAlias: (int, int) => variant = doubleNum
+
+//Asserts that inference works when composing
+//with derived functions
+let compose = (a, accessor) => accessor(a)
+let _composedMyField = compose({ myField: 1 }, myField)
+let _composedNum = compose(1, num)
+

jscomp/test/DerivingAccessorsCurried.res

@@ -0,0 +1,22 @@
+//Assert that deriving accessors does not break
+//In uncurried mode
+@@uncurried
+
+@deriving(accessors)
+type myRecord = { myField: int }
+
+@deriving(accessors)
+type variant = | NoParam | Num(int) | DoubleNum(int, int)
+
+//Asserts the correct signature for derived accessor
+let _myFieldAlias: myRecord => int = myField
+let _noParamAlias: variant = noParam
+let _numAlias: int => variant = num
+let _doubleNumAlias: (int, int) => variant = doubleNum
+
+//Asserts that inference works when composing
+//with derived functions
+let compose = (a, accessor) => accessor(a)
+let _composedMyField = compose({ myField: 1 }, myField)
+let _composedNum = compose(1, num)
+