Source file template_configuration.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
open Dec_template
exception Failed_rule_eval of Spin_error.t
let validate_of_rule ~context ~config_name (rule : Configuration.rule) =
let context_with_config = Hashtbl.copy context in
fun (v : string) ->
Hashtbl.add context_with_config config_name v;
let result =
Template_expr.to_result
Template_expr.to_bool
rule.expr
~context:context_with_config
in
match result with
| Error e ->
raise (Failed_rule_eval e)
| Ok result ->
if result then
Ok v
else
let error_message = Template_expr.eval rule.message ~context in
Error error_message
let prompt_config ?(use_defaults = false) ~context (config : Configuration.t) =
let open Result.Syntax in
let* default =
match config.default with
| None ->
Ok None
| Some default ->
let+ result =
Template_expr.to_result Template_expr.eval default ~context
in
Some result
in
let validate =
List.fold_left
(fun acc rule v ->
let f = validate_of_rule ~context ~config_name:config.name rule in
Result.bind (acc v) f)
(fun v -> Result.ok v)
config.rules
in
match use_defaults, config.prompt, default with
| true, _, Some default ->
Result.ok (Some default)
| _, Some (Configuration.Input input_t), _ ->
let v = Inquire.input input_t.message ?default ~validate in
Ok (Some v)
| _, Some (Configuration.Select select_t), _ ->
let default_v =
Option.map
(fun default -> List.index (String.equal default) select_t.values)
default
in
let v =
Inquire.select
select_t.message
~options:select_t.values
?default:default_v
in
Ok (Some v)
| _, Some (Configuration.Confirm confirm_t), _ ->
let+ default =
match default with
| None ->
Result.ok None
| Some default ->
let+ result =
Template_expr.to_result
Template_expr.to_bool
(Expr.String default)
~context
in
Some result
in
let v = Inquire.confirm confirm_t.message ?default in
Some (Bool.to_string v)
| _, None, _ ->
Ok default
let populate_context
?(use_defaults = false)
~context
(configurations : Dec_template.Configuration.t list)
=
let open Result.Syntax in
Result.List.fold_left
(fun _ (config : Configuration.t) ->
if Hashtbl.mem context config.name then
Result.ok ()
else
let env_var_name =
Printf.sprintf "SPIN_%s" (String.uppercase_ascii config.name)
in
match Sys.getenv_opt env_var_name with
| Some data ->
Hashtbl.add context config.name data;
Result.ok ()
| None ->
let+ data_opt =
try prompt_config config ~context ~use_defaults with
| Failed_rule_eval e ->
Error e
| exn ->
raise exn
in
(match data_opt with
| Some data ->
Hashtbl.add context config.name data;
()
| None ->
()))
()
configurations