Customise getter, setter, and updater names independently
This commit is contained in:
2 files changed
+28
-5
No files matched your search
+16
-5
@@ -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 =
|
||||
|
||||
Reference in new issue
Block a user