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
|
let names =
[ "Alice"
; "Bob"
; "Charlie"
; "Dave"
; "Eve"
; "Frank"
; "Grace"
; "Heidi"
; "Ivan"
; "Judy"
; "Mallory"
; "Oscar"
; "Peggy"
; "Sybil"
; "Trent"
; "Victor"
; "Walter"
]
let random_name () = List.nth names (Random.int (List.length names))
let%test "random_name" = List.mem (random_name ()) names
type t =
| Name of string
| Uuidv4 of string
| Foreign of string * string list
| Int of string * int * int
| Const of string * string
| List of string * string list
(* (Name, foreign ids to pick from) *)
let add_name name fixtures = Name name :: fixtures
let add_uuid uuid fixtures = Uuidv4 uuid :: fixtures
let add_foreign id values fixtures = Foreign (id, values) :: fixtures
let random_value_in_list values = List.nth values (Random.int (List.length values))
let%test "random_value_in_list" =
let values = [ "a"; "b"; "c" ] in
let result = random_value_in_list values in
List.mem result values
let generate_fixture fixture =
match fixture with
| Name _ -> random_name ()
| Uuidv4 _ -> Uuidm.v `V4 |> Uuidm.to_string
| Foreign (_, reference) -> random_value_in_list reference
| Const (_, value) -> value
| Int (_, min, max) -> Random.int (max - min) + min |> string_of_int
| List (_, values) -> random_value_in_list values
let%test "generate_uuid" =
generate_fixture (Uuidv4 "some_id") != generate_fixture (Uuidv4 "some_id")
let id_of_fixture fixture =
match fixture with
| Name id -> id
| Uuidv4 id -> id
| Foreign (id, _) -> id
| Const (id, _) -> id
| Int (id, _, _) -> id
| List (id, _) -> id
(* TODO: Support email *)
(* TODO: Support arbitrary string *)
(* TODO: Support "hashed" password *)
(* TODO: Support variables using @ *)
(* TODO: Support JSON export *)
let rec replicate element n =
match n with
| 0 -> []
| n -> element :: replicate element (n - 1)
let compile fixtures ~amount =
let identifiers = List.map id_of_fixture fixtures in
let values = replicate fixtures amount |> List.map (List.map generate_fixture) in
identifiers :: values
let%test "create" =
let defs = compile [ Uuidv4 "id"; Name "name" ] ~amount:2 in
match defs with
| [ [ "id"; "name" ]; [ _; _ ]; [ _; _ ] ] -> true
| _ -> false
let get_id foreign_fixture =
match String.split_on_char '.' foreign_fixture with
| [ _; id ] -> Ok id
| _ -> Error "Not a foreign fixture"
let rec csv_of_string_list strs =
match strs with
| [] -> ""
| str :: [] -> str
| str :: rest -> str ^ "," ^ csv_of_string_list rest
let find_entries_for_header str_fixtures str =
match str_fixtures with
| [] -> Error "No fixtures"
| header :: rest ->
let maybe_index = List.find_index (fun s -> s = str) header in
(match maybe_index with
| Some index -> Ok (List.map (fun row -> List.nth row index) rest)
| None -> Error ("Could not find header: " ^ str ^ " in " ^ csv_of_string_list header))
let csv_of_generated_fixtures fixtures =
let of_strings = List.map csv_of_string_list fixtures in
String.concat "\n" of_strings
let%test "csv_of_generated_fixtures" =
let result = [ [ "id"; "name" ]; [ "1234"; "John" ] ] |> csv_of_generated_fixtures in
result = "id,name\n1234,John"
let json_of_generated_fixtures fixtures =
let headers = List.hd fixtures in
let rows = List.tl fixtures in
let json_of_row row =
let pairs = List.combine headers row in
let json_of_pair (key, value) = "\"" ^ key ^ "\": \"" ^ value ^ "\"" in
"{" ^ String.concat ", " (List.map json_of_pair pairs) ^ "}"
in
"[" ^ String.concat ", " (List.map json_of_row rows) ^ "]"
(* TODO: Should export correct types, not only strings *)
let%test "json_of_generated_fixtures" =
let result = [ [ "id"; "name" ]; [ "1234"; "John" ] ] |> json_of_generated_fixtures in
result = "[{\"id\": \"1234\", \"name\": \"John\"}]"
|