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
|
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
| Foreign of string * string * string * ast_row
(* parent, row, child_name, row *)
| End
[@@deriving show, eq]
type ast_table =
| 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
| 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 =
| PRow of Fixture.t
| CRow of (string * string * (string list -> Fixture.t))
type ast_table_relation =
| PTable of string * int * Fixture.t list
| CTable of string * string * string * int * (string list -> Fixture.t list)
(** parent, row, child_name, row *)
let table_name = function
| PTable (n,_,_) -> n
| CTable (_,_,c,_,_) -> c
let rec ast_row_to_fixtures = function
| Uuidv4 (s, r) -> PRow (Fixture.Uuidv4 s) :: ast_row_to_fixtures r
| Foreign (p, r, c, next_row) ->
CRow (p, r, fun l -> Fixture.Foreign (c, l)) :: ast_row_to_fixtures next_row
| Name (s, r) -> PRow (Fixture.Name s) :: ast_row_to_fixtures r
| Int (s, min, max, r) -> PRow (Fixture.Int (s, min, max)) :: ast_row_to_fixtures r
| End -> []
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
(fun tbl row ->
match row with
| PRow r ->
(match tbl with
| PTable (n, amount, l) -> PTable (n, amount, r :: l)
| CTable (p, pr, c, amount, f) -> CTable (p, pr, c, amount, fun l -> r :: f l))
| CRow (p, pr, f) ->
(match tbl with
| PTable (c,amount, lr ) -> CTable (p, pr, c, amount, fun l -> f l :: lr)
| CTable _ -> failwith "Cannot have multiple relations"))
(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) ->
print_endline ("Converting table: " ^ name);
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)
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 (p,pr,c, amount, create_fixtures)) -> (
let (_, parent_fixtures) = resolve_fixtures tables p in
(* store the generated fixtures for this table *)
Hashtbl.add !generated_fixtures name parent_fixtures;
print_endline ("Resolving fixtures for " ^ c);
for i = 0 to List.length parent_fixtures - 1 do
print_endline ("Parent fixture: " ^ Fixture.csv_of_string_list (List.nth parent_fixtures i));
done;
let generated_ids = Fixture.find_entries_for_header parent_fixtures pr in
print_endline ("Generated ids: " ^ String.concat ", " (Result.get_ok generated_ids));
match generated_ids with
| Ok ids -> (c, Fixture.compile ~amount (create_fixtures ids))
| Error e -> failwith e
)
| None -> failwith ("Could not find table " ^ name)
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
for i = 0 to List.length user_fixtures - 1 do
print_endline ("User fixture: " ^ Fixture.csv_of_string_list (List.nth user_fixtures i));
done;
for i = 0 to List.length purchase_fixtures - 1 do
print_endline ("Purchase fixture: " ^ Fixture.csv_of_string_list (List.nth purchase_fixtures i));
done;
match (user_fixtures,purchase_fixtures) with
| ([["id";_];[u;_]], [["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
print_endline ("Table length: " ^ string_of_int (List.length tables));
print_endline (show_tables tables);
let resolve_fixtures' = function
| PTable (n, amount, l) ->
let (n,_,resolved) = (n, amount, Fixture.compile l ~amount) in
(* store the generated fixtures for this table *)
Hashtbl.add !generated_fixtures n resolved;
(n,resolved)
| CTable (p,pr,c, amount, create_fixtures) ->
let (_, parent_fixtures) = resolve_fixtures tables p in
(* store the generated fixtures for this table *)
Hashtbl.add !generated_fixtures c parent_fixtures;
print_endline ("Resolving fixtures for " ^ c);
let generated_ids = Fixture.find_entries_for_header parent_fixtures pr in
match generated_ids with
| Ok ids -> (c, Fixture.compile ~amount (create_fixtures ids))
| Error e -> failwith e
in
let result = List.map resolve_fixtures' tables in
print_endline ("Result names: " ^ String.concat ", " (List.map fst result));
result
|