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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
|
open Format
module Fixture = Fixture
type ast_row =
| Uuidv4 of string * ast_row
| Name of string * ast_row
| Int of string * int * int * ast_row
| Increment of string * ast_row
| Const of string * string * ast_row
| List of string * string list * ast_row
| Foreign of string * string * string * ast_row
(* parent, row, child_name, row *)
| End
[@@deriving show, eq]
type ast_table =
(** In hindsight, this could've been represented as a list of tables instead using separated_list function
TODO: Rewrite this to use a list of tables instead of a tree *)
| Table of string * int * ast_row * ast_table
| End
[@@deriving show, eq]
let rec print_row = function
| Uuidv4 (s, r) ->
printf "UUIDv4(%s)," s;
print_row r
| List (s, l, r) ->
printf "List(%s, %s)," s (String.concat ", " l);
print_row r
| Increment (s, r) ->
printf "Increment(%s)," s;
print_row r
| Const (s, v, r) ->
printf "Const(%s, %s)," s v;
print_row r
| Foreign (p, r, c, next_row) ->
printf "Foreign(%s.%s, %s)," p r c;
print_row next_row
| Int (s, min, max, r) ->
printf "Int(%s, %d, %d)," s min max;
print_row r
| Name (s, r) ->
printf "Name(%s)," s;
print_row r
| End -> printf "\n"
let rec print = function
| Table (s, amount, r, t) ->
printf "%s (%d):" s amount;
print_row r;
print t
| End -> printf "\n"
(* AST to Fixtures *)
type ast_row_relation =
| PColumn of Fixture.t
| CColumn of (string * string * (Fixture.compiled list -> Fixture.t))
type ast_table_relation =
| PTable of string * int * Fixture.t list
| CTable of (string * string) list * string * int * (Fixture.compiled -> Fixture.compiled list -> Fixture.t list)
(** parent (name, referenced id), row, child_name, fixture builder given a parent name and list of options *)
let table_name = function
| PTable (n,_,_) -> n
| CTable (_,c,_,_) -> c
let rec ast_row_to_fixtures = function
| Uuidv4 (s, r) -> PColumn (Fixture.Uuidv4 s) :: ast_row_to_fixtures r
| Foreign (p, r, c, next_row) ->
CColumn (p, r, fun l -> Fixture.Foreign (c, l)) :: ast_row_to_fixtures next_row
| Name (s, r) -> PColumn (Fixture.Name s) :: ast_row_to_fixtures r
| Int (s, min, max, r) -> PColumn (Fixture.Int (s, min, max)) :: ast_row_to_fixtures r
| Const (s, v, r) -> PColumn (Fixture.Const (s, v)) :: ast_row_to_fixtures r
| List (s, l, r) -> PColumn (Fixture.List (s, l)) :: ast_row_to_fixtures r
| Increment (s, r) -> PColumn (Fixture.Increment s) :: ast_row_to_fixtures r
| End -> []
let extend_table_with_row table row =
(** This function is magic, but essentially it takes a table and a column and extends the table.
For columns where we reference a parent table, we need to be able to resolve that parent in order to
know the fixtures, thus we need to instead build a function that takes the generated values for a parent and
adds the rows.
For that, we constructuct a function that takes a parent name and a list of options
and applies it to the correct location.
For understanding this kind of technique, look up contravariant functors
*)
match row with
| PColumn r ->
(match table with
| PTable (n, amount, l) -> PTable (n, amount, r :: l)
| CTable (parents,c, amount, f) -> CTable (parents, c, amount, fun p l -> r :: f p l)
)
| CColumn (p,pr, f) ->
(match table with
| PTable (n, amount, l_p) -> CTable ([(p,pr)], n, amount, fun p' l ->
if p' = Fixture.String p then
f l :: l_p
else
[]
)
| CTable (parents,c, amount, resolve_parents) ->
let new_resolver = fun (requested_parent : Fixture.compiled) l ->
if requested_parent = Fixture.String p then
[f l]
else
resolve_parents requested_parent l
in
CTable ((p,pr) :: parents, c, amount, new_resolver)
)
let ast_table_to_table name amount rows =
(** Convert an AST table to a Fixture table that we can more easily work with for
feeding the generated data as input into fixtures that depend on the generated
data from other fixtures *)
List.fold_left
extend_table_with_row
(PTable (name, amount, []))
rows
let rec ast_table_to_tables ast =
(** Convert an AST table to a list of Fixture tables, so once data has been generated
it can be used as input for the next entry *)
match ast with
| Table (name, amount, r, t) ->
ast_table_to_table name amount (ast_row_to_fixtures r) :: ast_table_to_tables t
| End -> []
let%test "ast_table_to_tables" =
let purchase = Table ("purchase", 5, Uuidv4 ("id", Name ("name", End)), End) in
let ast = Table ("user", 2, Uuidv4 ("id", Name ("name", End)), purchase) in
let tables = ast_table_to_tables ast in
List.length tables == 2
let generated_fixtures = ref (Hashtbl.create 10)
(** Used to not regenerate a different fixture for the same table. Also theoretically speeds up the compilation process by not generating the same fixture twice. I do not know what kind of monstrosity of a fixture you'd need for it to matter, but neat regardless. *)
let collect_results result_list =
(** Collect the results of a list of results into a single result *)
let rec collect_results' = function
| [] -> Ok []
| (Ok l) :: tl ->
(match collect_results' tl with
| Ok l' -> Ok (l @ l')
| Error e -> Error e
)
| (Error e) :: _ -> Error e
in
collect_results' result_list
let rec resolve_fixtures tables name =
(* Verify if we have already generated fixtures for this table *)
let maybe_fixtures = Hashtbl.find_opt !generated_fixtures name in
match maybe_fixtures with
| Some fixtures -> (name, fixtures)
| None ->
let maybe_table = List.find_opt (fun tbl -> table_name tbl = name) tables
in
match maybe_table with
| Some (PTable (n, amount, l)) ->
let resolved = (n, Fixture.compile l ~amount) in
(* store the generated fixtures for this table *)
Hashtbl.add !generated_fixtures name (snd resolved);
resolved
| Some (CTable (parents, c, amount, create_fixtures)) -> (
resolve_along_with_parents tables name amount parents c create_fixtures
)
| None -> failwith ("Could not find table " ^ name)
and resolve_along_with_parents tables name amount parents c create_fixtures =
let maybe_parents_fixtures = parents
|> List.map (fun (p,pr) -> (Fixture.String p,pr, resolve_fixtures tables p |> snd))
|> List.map (fun (p,pr,parent_fixtures) -> (
Fixture.find_entries_for_header parent_fixtures pr
|> Result.map (fun ids -> create_fixtures p ids))
)
|> collect_results
in
(* store the generated fixtures for this table *)
match maybe_parents_fixtures with
| Ok parents_fixtures ->
let compiled = Fixture.compile ~amount parents_fixtures in
Hashtbl.add !generated_fixtures name compiled;
(c, compiled)
| Error e -> failwith e
let%test "resolve_fixtures" =
let tables = [
PTable ("user", 1, [Fixture.Uuidv4 "id"; Fixture.Uuidv4 "uuid"]);
CTable ([("user", "id")], "posts", 1, fun _ ids -> [Fixture.Foreign ("user_id", ids)])
] in
let (_, user_fixtures) = resolve_fixtures tables "user" in
let (_, purchase_fixtures) = resolve_fixtures tables "posts" in
match (user_fixtures,purchase_fixtures) with
| ([[Fixture.String "id";_];[u;_]], [[Fixture.String "user_id"]; [v]]) -> v = u
| _ ->
false
let show_tables tables =
let show_table = function
| PTable (n,_,_) -> n
| CTable (_,c,_,_) -> c
in
tables |> List.map show_table |> String.concat "\n"
let compile ast =
let tables = ast_table_to_tables ast in
let resolve_fixtures' = function
| PTable (n, amount, l) ->
let (n,_,resolved) = (n, amount, Fixture.compile l ~amount) in
Hashtbl.add !generated_fixtures n resolved;
(n,resolved)
| CTable (parents,c, amount, create_fixtures) ->
let (c, resolved) = resolve_along_with_parents tables c amount parents c create_fixtures in
Hashtbl.add !generated_fixtures c resolved;
(c,resolved)
in
let result = List.map resolve_fixtures' tables in
result
|