Update name conv to have special case for type t

dune-project

@@ -1,6 +1,6 @@
 (lang dune 2.7)
 (name ppx_make)
-(version "0.3.4")
+(version "0.4.0")
 
 (generate_opam_files true)
 

src/arg_type.ml

@@ -26,16 +26,16 @@ let get_attr (attrs : attribute list) =
   List.fold_left
     (fun acc (attr : attribute) ->
       (match attr.attr_name.txt with
-      | "main" | "make.main" -> Main
-      | "required" | "make.required" -> Required
-      | "default" | "make.default" -> (
-          match attr.attr_payload with
-          | PStr [ { pstr_desc = Pstr_eval (expr, _); _ } ] -> Default expr
-          | _ ->
-              Location.raise_errorf ~loc:attr.attr_loc
-                "value in default attribute is not supported")
-      (* ignore unknown attrs *)
-      | _ -> No_attr)
+        | "main" | "make.main" -> Main
+        | "required" | "make.required" -> Required
+        | "default" | "make.default" -> (
+            match attr.attr_payload with
+            | PStr [ { pstr_desc = Pstr_eval (expr, _); _ } ] -> Default expr
+            | _ ->
+                Location.raise_errorf ~loc:attr.attr_loc
+                  "value in default attribute is not supported")
+        (* ignore unknown attrs *)
+        | _ -> No_attr)
       |> check_res ~loc:attr.attr_loc acc)
     No_attr attrs
 

src/deriver.ml

@@ -16,8 +16,8 @@ let fun_expression_of_record ~loc ?choice (lds : label_declaration list) :
   Ast_helper.with_default_loc loc (fun () ->
       let arg_types =
         List.map
-          (fun { pld_loc = loc; pld_name; pld_type; pld_attributes = attrs; _ } ->
-            Arg_type.of_core_type ~loc ~attrs pld_name pld_type)
+          (fun { pld_loc = loc; pld_name; pld_type; pld_attributes = attrs; _ }
+             -> Arg_type.of_core_type ~loc ~attrs pld_name pld_type)
           lds
         |> List.rev
       in
@@ -30,9 +30,9 @@ let fun_expression_of_record ~loc ?choice (lds : label_declaration list) :
       in
       arg_types
       |> List.map (fun (name, _, _) ->
-             let lid = Utils.longident_loc_of_name name in
-             let expr = Ast_helper.Exp.ident lid in
-             (lid, expr))
+          let lid = Utils.longident_loc_of_name name in
+          let expr = Ast_helper.Exp.ident lid in
+          (lid, expr))
       |> (fun labels -> Ast_helper.Exp.record labels None)
       |> Utils.add_choice_to_expr choice
       |> fun expr ->
@@ -63,11 +63,11 @@ let fun_expression_of_tuple ~loc ?choice (cts : core_type list) : expression =
       in
       arg_types
       |> List.map (fun (name, _, _) ->
-             Ast_helper.with_default_loc name.loc (fun () ->
-                 let lid = Utils.longident_loc_of_name name in
-                 Ast_helper.Exp.ident lid))
+          Ast_helper.with_default_loc name.loc (fun () ->
+              let lid = Utils.longident_loc_of_name name in
+              Ast_helper.Exp.ident lid))
       |> (fun exprs ->
-           match exprs with [ expr ] -> expr | _ -> Ast_helper.Exp.tuple exprs)
+      match exprs with [ expr ] -> expr | _ -> Ast_helper.Exp.tuple exprs)
       |> Utils.add_choice_to_expr choice
       |> Ast_helper.Exp.fun_ Nolabel None (Ast_helper.Pat.any ())
       |> fun expr ->
@@ -89,8 +89,8 @@ let fun_core_type_of_record ~loc (name, params) (lds : label_declaration list) :
   Ast_helper.with_default_loc loc (fun () ->
       let arg_types =
         List.map
-          (fun { pld_loc = loc; pld_name; pld_type; pld_attributes = attrs; _ } ->
-            Arg_type.of_core_type ~loc ~attrs pld_name pld_type)
+          (fun { pld_loc = loc; pld_name; pld_type; pld_attributes = attrs; _ }
+             -> Arg_type.of_core_type ~loc ~attrs pld_name pld_type)
           lds
         |> List.rev
       in
@@ -198,13 +198,13 @@ let sig_item_of_core_type (name, params) (ct : core_type) : signature_item =
   let loc = ct.ptyp_loc in
   Ast_helper.with_default_loc loc (fun () ->
       (match ct with
-      | { ptyp_desc = Ptyp_tuple cts; _ } ->
-          (* T1 * ... * Tn *)
-          fun_core_type_of_tuple ~loc (name, params) cts
-      | [%type: [%t? in_ct] option] | [%type: [%t? in_ct] Option.t] ->
-          (* T option *)
-          fun_core_type_of_option ~loc (name, params) in_ct
-      | _ -> Utils.unsupported_error "core type" name)
+        | { ptyp_desc = Ptyp_tuple cts; _ } ->
+            (* T1 * ... * Tn *)
+            fun_core_type_of_tuple ~loc (name, params) cts
+        | [%type: [%t? in_ct] option] | [%type: [%t? in_ct] Option.t] ->
+            (* T option *)
+            fun_core_type_of_option ~loc (name, params) in_ct
+        | _ -> Utils.unsupported_error "core type" name)
       |> Ast_helper.Val.mk @@ Utils.gen_make_name name
       |> Ast_helper.Sig.value)
 
@@ -226,8 +226,8 @@ let sig_item_of_variant_choice (name, params) (cd : constructor_declaration) :
         Utils.unsupported_error "constructor declaration" name
       else
         (match cd.pcd_args with
-        | Pcstr_tuple cts -> fun_core_type_of_tuple ~loc (name, params) cts
-        | Pcstr_record lds -> fun_core_type_of_record ~loc (name, params) lds)
+          | Pcstr_tuple cts -> fun_core_type_of_tuple ~loc (name, params) cts
+          | Pcstr_record lds -> fun_core_type_of_record ~loc (name, params) lds)
         |> Ast_helper.Val.mk @@ Utils.gen_make_choice_name name cd.pcd_name
         |> Ast_helper.Sig.value)
 

src/utils.ml

@@ -43,10 +43,16 @@ let make_type_decl_generator f =
       |> List.map (f ~loc rec_flag)
       |> List.concat)
 
-let gen_make_name { txt = name; loc } = { txt = "make_" ^ name; loc }
+let gen_make_name { txt = name; loc } =
+  let txt = match name with "t" -> "make" | _ -> "make_" ^ name in
+  { txt; loc }
 
 let gen_make_choice_name { txt = name; _ } { txt = choice_name; loc } =
-  let txt = String.lowercase_ascii ("make_" ^ choice_name ^ "_of_" ^ name) in
+  let txt =
+    match name with
+    | "t" -> String.lowercase_ascii ("make_" ^ choice_name)
+    | _ -> String.lowercase_ascii ("make_" ^ choice_name ^ "_of_" ^ name)
+  in
   { txt; loc }
 
 let gen_tuple_label ~loc index = { txt = "v" ^ string_of_int index; loc }

test/misc_types.ml

@@ -1,3 +1,5 @@
 (* https://github.com/bn-d/ppx_make/issues/12 *)
 type a = { i : int } [@@deriving make, show]
 and b = int
+
+type t = { t : int } [@@deriving make]

test/test_make.ml

@@ -2,6 +2,10 @@ let test_multiple_type_decl _ =
   let open Misc_types in
   OUnit.assert_equal { i = 1 } @@ make_a ~i:1 ()
 
+let test_t_name _ =
+  let open Misc_types in
+  OUnit.assert_equal { t = 1 } @@ make ~t:1 ()
+
 let _ =
   let open OUnit2 in
   run_test_tt_main
@@ -13,4 +17,5 @@ let _ =
            Test_make_tuple.suite;
            Test_make_variant.suite;
            "test_multiple_type_decl" >:: test_multiple_type_decl;
+           "test_t_name" >:: test_t_name;
          ])