Customise getter, setter, and updater names independently

This commit is contained in:
milner committed 2019-03-30 13:59:36 +00:00
1 parent c6dddc3568
commit 65114446e0
2 files changed
+28 -5

No files matched your search

+16 -5
View File
@@ -10,8 +10,14 @@ let lambda ~loc label pattern body = Exp.fun_ ~loc label None pattern body
let is_marker (name, _) = name.txt = "fieldglass" || name.txt = "lens"
type prefix = Plain | Named of string | Type_name
type options = { field_prefix : prefix }
let defaults = { field_prefix = Plain }
type options = {
field_prefix : prefix;
get_prefix : string option;
set_prefix : string;
update_prefix : string;
}
let defaults = { field_prefix = Plain; get_prefix = None;
set_prefix = "set"; update_prefix = "update" }
let word expression =
match expression.pexp_desc with
@@ -30,9 +36,12 @@ let flag name expression =
let configure options (label, expression) =
match label with
| Labelled "field_prefix" -> { field_prefix = Named (word expression) }
| Labelled "field_prefix" -> { options with field_prefix = Named (word expression) }
| Labelled "field_prefix_from_type" ->
{ field_prefix = if flag "field_prefix_from_type" expression then Type_name else Plain }
{ options with field_prefix = if flag "field_prefix_from_type" expression then Type_name else Plain }
| Labelled "get_prefix" -> { options with get_prefix = Some (word expression) }
| Labelled "set_prefix" -> { options with set_prefix = word expression }
| Labelled "update_prefix" -> { options with update_prefix = word expression }
| _ -> Location.raise_errorf ~loc:expression.pexp_loc
"fieldglass: unrecognised configuration option"
@@ -92,7 +101,9 @@ let generate options declaration =
[Nolabel, Exp.field ~loc source (ident ~loc name)]))) in
List.map (fun (name, body) ->
Str.value ~loc Nonrecursive [Vb.mk ~loc (variable ~loc name) body])
[short_name, getter; "set_" ^ short_name, setter; "update_" ^ short_name, updater;
[(match options.get_prefix with None -> short_name | Some prefix -> prefix ^ "_" ^ short_name), getter;
options.set_prefix ^ "_" ^ short_name, setter;
options.update_prefix ^ "_" ^ short_name, updater;
"_" ^ short_name, Exp.tuple ~loc [getter; setter]]) fields (field_names fields))
let structure mapper items =