/home/runner/work/klsn/klsn/_build/test/cover/ct/klsn_rule_annotation.html

1 %% @doc
2 %% Parse transform for -klsn_input_rule and -klsn_output_rule attributes.
3 %% Include "klsn/include/klsn_rule_annotation.hrl" to enable.
4 -module(klsn_rule_annotation).
5
6 -export([parse_transform/2]).
7
8 -record(state, {
9 input = none
10 , output = none
11 }).
12
13 %% @doc Apply the rule annotations to the following function form.
14 -spec parse_transform([term()], list()) -> [term()].
15 parse_transform(Forms, _Options) ->
16 
:-(
 Module = module_name_(Forms),
17 
:-(
 {FormsRev, _State} = lists:foldl(fun(Form, {Acc, State}) ->
18 
:-(
 transform_form_(Form, Module, Acc, State)
19 end, {[], #state{}}, Forms),
20 
:-(
 lists:reverse(FormsRev).
21
22 transform_form_({attribute, Line, klsn_input_rule, Rules0}, _Module, Acc, State) ->
23 
:-(
 ensure_input_rules_(Rules0, Line),
24 
:-(
 {Acc, State#state{input = {Line, Rules0}}};
25 transform_form_({attribute, Line, klsn_output_rule, Rule}, _Module, Acc, State) ->
26 
:-(
 {Acc, State#state{output = {Line, Rule}}};
27 transform_form_({function, _, _, _, _}=Form, Module, Acc, State) ->
28 
:-(
 case State of
29 #state{input = none, output = none} ->
30 
:-(
 {[Form|Acc], State};
31 #state{input = InputRule, output = OutputRule} ->
32 
:-(
 NewForms = rewrite_function_(Module, Form, InputRule, OutputRule),
33 
:-(
 {lists:reverse(NewForms) ++ Acc, #state{}}
34 end;
35 transform_form_(Form, _Module, Acc, State) ->
36 
:-(
 {[Form|Acc], State}.
37
38 module_name_(Forms) ->
39 
:-(
 case lists:search(fun
40 ({attribute, _, module, _}) ->
41 
:-(
 true;
42 (_) ->
43 
:-(
 false
44 end, Forms) of
45 {value, {attribute, _, module, Module}} ->
46 
:-(
 Module;
47 false ->
48 
:-(
 erlang:error({klsn_rule_annotation, missing_module_attribute})
49 end.
50
51 ensure_input_rules_(Rules, _Line) when is_list(Rules) ->
52 
:-(
 ok;
53 ensure_input_rules_(Rules, Line) ->
54 
:-(
 erlang:error({klsn_input_rule, Line, invalid_input_rule, Rules}).
55
56 rewrite_function_(Module, {function, Line, Name, Arity, Clauses}, InputRule, OutputRule) ->
57 
:-(
 InputRules = case InputRule of
58 none ->
59 
:-(
 none;
60 {_, Rules} ->
61 
:-(
 Rules
62 end,
63 
:-(
 OutputRuleTerm = case OutputRule of
64 none ->
65 
:-(
 none;
66 {_, Rule} ->
67 
:-(
 Rule
68 end,
69 
:-(
 InputRules1 = ensure_input_arity_(InputRules, Arity, Line, Name),
70 
:-(
 OrigName = original_name_(Name, Arity),
71 
:-(
 OrigFun = {function, Line, OrigName, Arity, Clauses},
72 
:-(
 WrapperFun = build_wrapper_(Line, Module, Name, Arity, OrigName, InputRules1, OutputRuleTerm),
73 
:-(
 [WrapperFun, OrigFun].
74
75 ensure_input_arity_(none, _Arity, _Line, _Name) ->
76 
:-(
 none;
77 ensure_input_arity_(Rules, Arity, Line, Name) when is_list(Rules) ->
78 
:-(
 case length(Rules) =:= Arity of
79 true ->
80 
:-(
 Rules;
81 false ->
82 
:-(
 erlang:error({klsn_input_rule, Line, {arity_mismatch, Name, Arity, length(Rules)}})
83 end;
84 ensure_input_arity_(Rules, _Arity, Line, Name) ->
85 
:-(
 erlang:error({klsn_input_rule, Line, {invalid_rule_list, Name, Rules}}).
86
87 original_name_(Name, _Arity) ->
88 
:-(
 list_to_atom("__klsn_rule_annotation__orig__" ++ atom_to_list(Name)).
89
90 build_wrapper_(Line, Module, Name, Arity, OrigName, InputRules, OutputRule) ->
91 
:-(
 ArgVars = arg_vars_(Line, Arity),
92 
:-(
 ArgsListExpr = list_ast_(Line, ArgVars),
93 
:-(
 {InputExprs, CallArgs} = build_input_validations_(
94 Line, Module, Name, ArgsListExpr, InputRules, ArgVars
95 ),
96 
:-(
 ResultVar = var_(Line, 'Result'),
97 
:-(
 OrigCall = call_local_(Line, OrigName, CallArgs),
98 
:-(
 ResultMatch = {match, Line, ResultVar, OrigCall},
99 
:-(
 Body = case OutputRule of
100 none ->
101 
:-(
 InputExprs ++ [ResultMatch];
102 _ ->
103 
:-(
 OutputExpr = build_output_validation_(
104 Line, Module, Name, ArgsListExpr, ResultVar, OutputRule
105 ),
106 
:-(
 InputExprs ++ [ResultMatch, OutputExpr]
107 end,
108 
:-(
 Clause = {clause, Line, ArgVars, [], Body},
109 
:-(
 {function, Line, Name, Arity, [Clause]}.
110
111 arg_vars_(Line, Arity) ->
112 
:-(
 [var_(Line, list_to_atom("Arg" ++ integer_to_list(I))) || I <- lists:seq(1, Arity)].
113
114 norm_vars_(Line, Arity) ->
115 
:-(
 [var_(Line, list_to_atom("Arg" ++ integer_to_list(I) ++ "N")) || I <- lists:seq(1, Arity)].
116
117 build_input_validations_(_Line, _Module, _Name, _ArgsListExpr, none, ArgVars) ->
118 
:-(
 {[], ArgVars};
119 build_input_validations_(Line, Module, Name, ArgsListExpr, Rules, ArgVars) ->
120 
:-(
 NormVars = norm_vars_(Line, length(ArgVars)),
121 
:-(
 ExprsRev = build_input_exprs_(
122 Line, Module, Name, ArgsListExpr, Rules, ArgVars, NormVars, 1, []
123 ),
124 
:-(
 {lists:reverse(ExprsRev), NormVars}.
125
126 build_input_exprs_(_Line, _Module, _Name, _ArgsListExpr, [], [], [], _Index, Acc) ->
127 
:-(
 Acc;
128 build_input_exprs_(Line, Module, Name, ArgsListExpr,
129 [Rule|Rules], [ArgVar|ArgVars], [NormVar|NormVars], Index, Acc) ->
130 
:-(
 Expr = input_match_expr_(
131 Line, Module, Name, ArgsListExpr, Index, Rule, ArgVar, NormVar
132 ),
133 
:-(
 build_input_exprs_(
134 Line, Module, Name, ArgsListExpr, Rules, ArgVars, NormVars, Index + 1, [Expr|Acc]
135 ).
136
137 input_match_expr_(Line, Module, Name, ArgsListExpr, Index, Rule, ArgVar, NormVar) ->
138 
:-(
 EvalCall = call_remote_(
139 Line,
140 klsn_rule,
141 eval,
142 [ArgVar, erl_parse:abstract(Rule, Line), erl_parse:abstract(#{}, Line)]
143 ),
144 
:-(
 NormValueVar = var_(Line, list_to_atom("NormValue" ++ integer_to_list(Index))),
145 
:-(
 ReasonVar = var_(Line, list_to_atom("Reason" ++ integer_to_list(Index))),
146 
:-(
 ErrorTuple = tuple_ast_(Line, [
147 atom_(Line, klsn_input_rule),
148 tuple_ast_(Line, [atom_(Line, Module), atom_(Line, Name), ArgsListExpr]),
149 integer_(Line, Index),
150 ReasonVar
151 ]),
152 
:-(
 ErrorCall = call_remote_(Line, erlang, error, [ErrorTuple]),
153 
:-(
 CaseExpr = {'case', Line, EvalCall, [
154 {clause, Line, [tuple_ast_(Line, [atom_(Line, valid), var_(Line, '_')])], [], [ArgVar]},
155 {clause, Line, [tuple_ast_(Line, [atom_(Line, normalized), NormValueVar, var_(Line, '_')])], [], [NormValueVar]},
156 {clause, Line, [tuple_ast_(Line, [atom_(Line, reject), ReasonVar])], [], [ErrorCall]}
157 ]},
158 
:-(
 {match, Line, NormVar, CaseExpr}.
159
160 build_output_validation_(Line, Module, Name, ArgsListExpr, ResultVar, Rule) ->
161 
:-(
 EvalCall = call_remote_(
162 Line,
163 klsn_rule,
164 eval,
165 [ResultVar, erl_parse:abstract(Rule, Line), erl_parse:abstract(#{}, Line)]
166 ),
167 
:-(
 NormValueVar = var_(Line, 'NormValueOut'),
168 
:-(
 ReasonVar = var_(Line, 'ReasonOut'),
169 
:-(
 ErrorTuple = tuple_ast_(Line, [
170 atom_(Line, klsn_output_rule),
171 tuple_ast_(Line, [atom_(Line, Module), atom_(Line, Name), ArgsListExpr]),
172 ResultVar,
173 ReasonVar
174 ]),
175 
:-(
 ErrorCall = call_remote_(Line, erlang, error, [ErrorTuple]),
176 
:-(
 {'case', Line, EvalCall, [
177 {clause, Line, [tuple_ast_(Line, [atom_(Line, valid), var_(Line, '_')])], [], [ResultVar]},
178 {clause, Line, [tuple_ast_(Line, [atom_(Line, normalized), NormValueVar, var_(Line, '_')])], [], [NormValueVar]},
179 {clause, Line, [tuple_ast_(Line, [atom_(Line, reject), ReasonVar])], [], [ErrorCall]}
180 ]}.
181
182 atom_(Line, Atom) ->
183 
:-(
 {atom, Line, Atom}.
184
185 var_(Line, Name) ->
186 
:-(
 {var, Line, Name}.
187
188 integer_(Line, Value) ->
189 
:-(
 {integer, Line, Value}.
190
191 tuple_ast_(Line, Elements) ->
192 
:-(
 {tuple, Line, Elements}.
193
194 list_ast_(Line, []) ->
195 
:-(
 {nil, Line};
196 list_ast_(Line, [H|T]) ->
197 
:-(
 {cons, Line, H, list_ast_(Line, T)}.
198
199 call_remote_(Line, Module, Function, Args) ->
200 
:-(
 {call, Line, {remote, Line, atom_(Line, Module), atom_(Line, Function)}, Args}.
201
202 call_local_(Line, Function, Args) ->
203 
:-(
 {call, Line, atom_(Line, Function), Args}.
Line Hits Source