aboutsummaryrefslogtreecommitdiff
path: root/lib/fixture.ml
blob: 94c39a935abb1a89237dab371f09acda6226d983 (plain)
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 not only as strings *)

let%test "json_of_generated_fixtures" =
  let result = [ [ "id"; "name" ]; [ "1234"; "John" ] ] |> json_of_generated_fixtures in
  result = "[{\"id\": \"1234\", \"name\": \"John\"}]"