sneeker/fieldglass
1
6 Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Select generated operations without introducing hidden dependencies

Browse Source
This commit is contained in:
milner committed 2019-04-07 10:12:51 +00:00
1 parent c02ef26bc8
commit 3bde617d17
4 files changed
+64 -7
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

rewrite.ml
+19 -7
View File
@@ -17,10 +17,15 @@ type options = {
update_prefix : string;
self_first : bool;
function_label : string option;
getters : bool;
setters : bool;
updaters : bool;
lenses : bool;
}
let defaults = { field_prefix = Plain; get_prefix = None;
set_prefix = "set"; update_prefix = "update";
self_first = false; function_label = Some "f" }
self_first = false; function_label = Some "f";
getters = true; setters = true; updaters = true; lenses = true }
let word expression =
match expression.pexp_desc with
@@ -49,6 +54,13 @@ let configure options (label, expression) =
| Labelled "func_named_arg" -> { options with function_label = Some (word expression) }
| Labelled "func_no_named_arg" ->
{ options with function_label = if flag "func_no_named_arg" expression then None else Some "f" }
| Labelled "no_get" -> { options with getters = not (flag "no_get" expression) }
| Labelled "no_set" -> { options with setters = not (flag "no_set" expression) }
| Labelled "no_update" -> { options with updaters = not (flag "no_update" expression) }
| Labelled "no_lens" -> { options with lenses = not (flag "no_lens" expression) }
| Labelled "just_lens" ->
let functions = not (flag "just_lens" expression) in
{ options with getters = functions; setters = functions; updaters = functions }
| _ -> Location.raise_errorf ~loc:expression.pexp_loc
"fieldglass: unrecognised configuration option"
@@ -110,12 +122,12 @@ let generate options declaration =
let updater = arguments options.self_first label "__fg_function"
(replace (Exp.apply ~loc (value ~loc "__fg_function")
[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])
[(match options.get_prefix with None -> short_name | Some prefix -> prefix ^ "_" ^ short_name), getter;
options.set_prefix ^ "_" ^ short_name, setter options.self_first;
options.update_prefix ^ "_" ^ short_name, updater;
"_" ^ short_name, Exp.tuple ~loc [getter; setter false]]) fields (field_names fields))
List.concat (List.map (fun (enabled, name, body) ->
if enabled then [Str.value ~loc Nonrecursive [Vb.mk ~loc (variable ~loc name) body]] else [])
[options.getters, (match options.get_prefix with None -> short_name | Some prefix -> prefix ^ "_" ^ short_name), getter;
options.setters, options.set_prefix ^ "_" ^ short_name, setter options.self_first;
options.updaters, options.update_prefix ^ "_" ^ short_name, updater;
options.lenses, "_" ^ short_name, Exp.tuple ~loc [getter; setter false]])) fields (field_names fields))
let structure mapper items =
List.concat (List.map (fun item ->