Merge pull request #18 from cryptosense/reverse-factory-names

Prefix factory names instead of suffixing them

README.md

@@ -31,7 +31,7 @@ let full_name {first_name; last_name; middle_name; _} =
 When writing tests for the `full_name` function, you don't want to bother defining `age` and
 `hobbies` every time so you use a factory method that looks like:
 ```ocaml
-val factory_person :
+val person_factory :
   ?first_name: string ->
   ?middle_name: string ->
   ?last_name: string ->
@@ -44,10 +44,10 @@ val factory_person :
 and let's you write your test in a more concise manner:
 ```ocaml
 test
-  ~input:(factory_person ~first_name:"John" ?middle_name:None ~last_name:"Doe" ())
+  ~input:(person_factory ~first_name:"John" ?middle_name:None ~last_name:"Doe" ())
   ~expected:"John Doe";
 test
-  ~input:(factory_person ~first_name:"Robyn" ~middle_name:"Rihanna" ~last_name:"Fenty" ())
+  ~input:(person_factory ~first_name:"Robyn" ~middle_name:"Rihanna" ~last_name:"Fenty" ())
   ~expected:"Robyn \"Rihanna\" Fenty"
 ```
 
@@ -89,7 +89,7 @@ variant type definition.
 
 You can derive factory functions from record type definitions. This will derive a single factory
 function that has an optional argument per field. The name of the factory function depends on the
-name of the type, `factory` will be derived from type `t` and `factory_<type_name>` for any other
+name of the type, `factory` will be derived from type `t` and `<type_name>_factory` for any other
 type.
 
 Each optional parameter will expect the same type as the one declared for the corresponding field,
@@ -115,14 +115,14 @@ will derive the following factory functions:
 ```ocaml
 val factory : ?a: int -> ?b: string -> unit -> t
 
-val factory_u : ?c: 'a list -> ?d: 'a -> unit -> 'a t
+val u_factory : ?c: 'a list -> ?d: 'a -> unit -> 'a t
 ```
 
 #### Variant types
 
 You can also derive factory functions from variant type definitions. This will derive one of them
-per constructor. Those functions will be named based on the type, just as for the record types but
-will have a `_<lowercased_constructor_name>` suffix.
+per constructor. Those functions will be named based on the type and the constructor name and have
+a `<type_name>_<lowercased_constructor_name>_` prefix.
 
 Constant constructor factories will have a single `unit` argument, while for constructors with tuple
 arguments, including 1-element tuples, they will have `?tup<element_tuple_index>` arguments starting
@@ -146,13 +146,13 @@ type 'a u =
 
 will derive the following factory functions:
 ```ocaml
-val factory_a : unit -> t
+val a_factory : unit -> t
 
-val factory_b : ?tup0: string -> unit -> t
+val b_factory : ?tup0: string -> unit -> t
 
-val factory_u_c : ?tup0: int -> ?tup1: 'a -> 'a u
+val u_c_factory : ?tup0: int -> ?tup1: 'a -> 'a u
 
-val factory_u_d : ?some_int: int -> ?some_list: 'a list -> 'a u
+val u_d_factory : ?some_int: int -> ?some_list: 'a list -> 'a u
 ```
 
 ### default
@@ -167,8 +167,8 @@ own whereas for custom types we expect to find one in the right place. Eg for a
 can use it by attaching `[@@deriving default]` to type definitions.
 
 It can be used with most core types, record and variant types. It will derive a single value
-which name will be based on the type name in the same fashion as factory functions' names, ie
-`default` or `default_<type_name>`.
+which name will be based on the type name, ie `default` for type `t` or `default_<type_name>`
+otherwise.
 
 In some cases it's impossible to derive a default from a parametrized type. For example you can't
 derive a default value from the following type:

lib/default.ml

@@ -1,7 +1,7 @@
 open Ppxlib
 
 let _name_from_type_name type_name =
-  Printf.sprintf "default%s" @@ Util.suffix_from_type_name type_name
+  Printf.sprintf "default%s" @@ Util.affix_from_type_name ~kind:`Suffix type_name
 
 let expr_from_lident ~loc {txt; loc = err_loc} =
   match txt with

lib/factory.ml

@@ -1,11 +1,21 @@
 open Ppxlib
 
-let _name_from_type_name type_name =
-  Printf.sprintf "factory%s" @@ Util.suffix_from_type_name type_name
+let prefix ~type_name ?constructor_name () =
+  let type_prefix = Util.affix_from_type_name ~kind:`Prefix type_name in
+  let constructor_prefix =
+    match constructor_name with
+    | None -> ""
+    | Some constructor_name -> (String.lowercase_ascii constructor_name) ^ "_"
+  in
+  Printf.sprintf "%s%s" type_prefix constructor_prefix
+
+let factory_name prefix = Printf.sprintf "%sfactory" prefix
 
 let _name_from_type_and_constructor_name ~type_name ~constructor_name =
-  let base_factory_name = _name_from_type_name type_name in
-  Printf.sprintf "%s_%s" base_factory_name (String.lowercase_ascii constructor_name)
+  factory_name (prefix ~type_name ~constructor_name ())
+
+let _name_from_type_name type_name =
+  factory_name (prefix ~type_name ())
 
 let arg_names_from_labels labels =
   List.map (fun {pld_name; _} -> pld_name.txt) labels

lib/util.ml

@@ -1,8 +1,10 @@
 open Ppxlib
 
-let suffix_from_type_name = function
-  | "t" -> ""
-  | s -> "_" ^ s
+let affix_from_type_name ~kind type_name =
+  match type_name, kind with
+  | "t", _ -> ""
+  | _, `Suffix -> "_" ^ type_name
+  | _, `Prefix -> type_name ^ "_"
 
 let constr_from_type_param ~loc (core_type, _variance) =
   {core_type with ptyp_loc = loc; ptyp_attributes = []}

lib/util.mli

@@ -1,7 +1,7 @@
 open Ppxlib
 
 (** Return the suffix to apply to a derived value name, based on the type name *)
-val suffix_from_type_name : string -> string
+val affix_from_type_name : kind: [`Prefix | `Suffix] -> string -> string
 
 (** Return the core type describing the type declared in the given declaration.
     E.g. will return [[%type: 'a t]] for [type 'a t = A of int | B of 'a].

test/deriver/pp_factory.expected.ml

@@ -7,7 +7,7 @@ module Types :
       int_field: int ;
       string_field: string ;
       other_field: A.B.t }[@@deriving factory]
-    val factory_simple_record :
+    val simple_record_factory :
       ?int_field:int ->
         ?string_field:string -> ?other_field:A.B.t -> unit -> simple_record
     type simple_variant =
@@ -17,31 +17,31 @@ module Types :
       | D of {
       int_field: int ;
       string_field: string } [@@deriving factory]
-    val factory_simple_variant_a : unit -> simple_variant
-    val factory_simple_variant_b : ?tup0:int -> unit -> simple_variant
-    val factory_simple_variant_c :
+    val simple_variant_a_factory : unit -> simple_variant
+    val simple_variant_b_factory : ?tup0:int -> unit -> simple_variant
+    val simple_variant_c_factory :
       ?tup0:int -> ?tup1:string -> unit -> simple_variant
-    val factory_simple_variant_d :
+    val simple_variant_d_factory :
       ?int_field:int -> ?string_field:string -> unit -> simple_variant
     type record_with_options =
       {
       non_optional: int ;
       optional: int option ;
       nested: int option option }[@@deriving factory]
-    val factory_record_with_options :
+    val record_with_options_factory :
       ?non_optional:int ->
         ?optional:int -> ?nested:int option -> unit -> record_with_options
     type 'a parametrized = {
       param: 'a option ;
       non_paramed: string }[@@deriving factory]
-    val factory_parametrized :
+    val parametrized_factory :
       ?param:'a -> ?non_paramed:string -> unit -> 'a parametrized
     type copied = simple_record =
       {
       int_field: int ;
       string_field: string ;
       other_field: A.B.t }[@@deriving factory]
-    val factory_copied :
+    val copied_factory :
       ?int_field:int ->
         ?string_field:string -> ?other_field:A.B.t -> unit -> copied
   end =
@@ -51,7 +51,7 @@ module Types :
       int_field: int ;
       string_field: string ;
       other_field: A.B.t }[@@deriving factory]
-    let factory_simple_record ?(int_field= 0)  ?(string_field= "") 
+    let simple_record_factory ?(int_field= 0)  ?(string_field= "") 
       ?(other_field= A.B.default)  () =
       { int_field; string_field; other_field }
     type simple_variant =
@@ -61,28 +61,28 @@ module Types :
       | D of {
       int_field: int ;
       string_field: string } [@@deriving factory]
-    let factory_simple_variant_a () = A
-    let factory_simple_variant_b ?(tup0= 0)  () = B tup0
-    let factory_simple_variant_c ?(tup0= 0)  ?(tup1= "")  () = C (tup0, tup1)
-    let factory_simple_variant_d ?(int_field= 0)  ?(string_field= "")  () =
+    let simple_variant_a_factory () = A
+    let simple_variant_b_factory ?(tup0= 0)  () = B tup0
+    let simple_variant_c_factory ?(tup0= 0)  ?(tup1= "")  () = C (tup0, tup1)
+    let simple_variant_d_factory ?(int_field= 0)  ?(string_field= "")  () =
       D { int_field; string_field }
     type record_with_options =
       {
       non_optional: int ;
       optional: int option ;
       nested: int option option }[@@deriving factory]
-    let factory_record_with_options ?(non_optional= 0)  ?optional  ?nested 
+    let record_with_options_factory ?(non_optional= 0)  ?optional  ?nested 
       () = { non_optional; optional; nested }
     type 'a parametrized = {
       param: 'a option ;
       non_paramed: string }[@@deriving factory]
-    let factory_parametrized ?param  ?(non_paramed= "")  () =
+    let parametrized_factory ?param  ?(non_paramed= "")  () =
       { param; non_paramed }
     type copied = simple_record =
       {
       int_field: int ;
       string_field: string ;
       other_field: A.B.t }[@@deriving factory]
-    let factory_copied ?(int_field= 0)  ?(string_field= "")  ?(other_field=
+    let copied_factory ?(int_field= 0)  ?(string_field= "")  ?(other_field=
       A.B.default)  () = { int_field; string_field; other_field }
   end 

test/lib/test_factory.ml

@@ -7,7 +7,7 @@ let test__name_from_type_name =
   in
   "_name_from_type_name" >:::
   [ "Is factory" >:: test ~input:"t" ~expected:"factory"
-  ; "Uses right suffix" >:: test ~input:"a" ~expected:"factory_a"
+  ; "Uses right prefix" >:: test ~input:"a" ~expected:"a_factory"
   ]
 
 let test__name_from_type_and_constructor_name =
@@ -18,9 +18,9 @@ let test__name_from_type_and_constructor_name =
     assert_equal ~ctxt ~cmp:[%eq: string] ~printer:[%show: string] expected actual
   in
   "_name_from_type_and_constructor_name" >:::
-  [ "Handle type t" >:: test ~type_name:"t" ~constructor_name:"A" ~expected:"factory_a"
-  ; "Handle other type names" >:: test ~type_name:"u" ~constructor_name:"A" ~expected:"factory_u_a"
-  ; "Lowercase ctr name" >:: test ~type_name:"u" ~constructor_name:"RSA" ~expected:"factory_u_rsa"
+  [ "Handle type t" >:: test ~type_name:"t" ~constructor_name:"A" ~expected:"a_factory"
+  ; "Handle other type names" >:: test ~type_name:"u" ~constructor_name:"A" ~expected:"u_a_factory"
+  ; "Lowercase ctr name" >:: test ~type_name:"u" ~constructor_name:"RSA" ~expected:"u_rsa_factory"
   ]
 
 let suite =

test/lib/test_util.ml

@@ -1,14 +1,15 @@
 open OUnit2
 
-let test_suffix_from_type_name =
-  let test ~input ~expected ctxt =
-    let actual = Ppx_factory_lib.Util.suffix_from_type_name input in
+let test_affix_from_type_name =
+  let test ~kind ~type_name ~expected ctxt =
+    let actual = Ppx_factory_lib.Util.affix_from_type_name ~kind type_name in
     assert_equal ~ctxt ~cmp:[%eq: string] ~printer:[%show: string] expected actual
   in
-  "suffix_from_type_name" >:::
-  [ "Type t" >:: test ~input:"t" ~expected:""
-  ; "Other type name" >:: test ~input:"a" ~expected:"_a"
-  ; "Preserves leading underscores" >:: test ~input:"_a" ~expected:"__a"
+  "affix_from_type_name" >:::
+  [ "Type t" >:: test ~kind:`Suffix ~type_name:"t" ~expected:""
+  ; "Suffix" >:: test ~kind:`Suffix ~type_name:"a" ~expected:"_a"
+  ; "Prefix" >:: test ~kind:`Prefix ~type_name:"a" ~expected:"a_"
+  ; "Preserves leading underscores" >:: test ~kind:`Suffix ~type_name:"_a" ~expected:"__a"
   ]
 
 module List_ = struct
@@ -59,6 +60,6 @@ end
 
 let suite =
   "Util" >:::
-  [ test_suffix_from_type_name
+  [ test_affix_from_type_name
   ; List_.suite
   ]