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
|
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
| 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 =
| Table of string * int * ast_row * ast_table
| End
[@@deriving show, eq]
(** In hindsight, this could've been represented as a list of tables instead using separated list command
TODO: Rewrite this to use a list of tables instead of a tree *)
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
| 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 =
| 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 *)
(* TODO: Support multiple relations *)
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
| Const (s, v, r) -> PRow (Fixture.Const (s, v)) :: ast_row_to_fixtures r
| List (s, l, r) -> PRow (Fixture.List (s, l)) :: 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) ->
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 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;
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
)
| 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
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
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 (p,pr,c, amount, create_fixtures) ->
let (_, parent_fixtures) = resolve_fixtures tables p in
Hashtbl.add !generated_fixtures c parent_fixtures;
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
result
|