diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/fixture.ml | 118 |
1 files changed, 80 insertions, 38 deletions
diff --git a/lib/fixture.ml b/lib/fixture.ml index c45a8b9..6080fd9 100644 --- a/lib/fixture.ml +++ b/lib/fixture.ml @@ -19,22 +19,64 @@ let names = ] +let random_value_in_list values = List.nth values (Random.int (List.length values)) + +type compiled = + | Int of int + | String of string + | Bool of bool + | Float of float +[@@deriving eq] + +let show_compiled_csv fixture = + match fixture with + | Int i -> string_of_int i + | String s -> s + | Bool b -> string_of_bool b + | Float f -> string_of_float f + + let random_name () = List.nth names (Random.int (List.length names)) let%test "random_name" = List.mem (random_name ()) names +let json_of_compiled fixture = + match fixture with + | Int i -> string_of_int i + | String s -> "\"" ^ s ^ "\"" + | Bool b -> string_of_bool b + | Float f -> string_of_float f + + +let key_of_compiled key = + match key with + | Int _ -> failwith "Int is not a valid key" + | String s -> s + | Bool _ -> failwith "Bool is not a valid key" + | Float _ -> failwith "Float is not a valid key" + + type t = | Name of string | Uuidv4 of string - | Foreign of string * string list + | Foreign of string * compiled list | Int of string * int * int | Const of string * string | List of string * string list (* (Name, foreign ids to pick from) *) +let generate_fixture fixture = + match fixture with + | Name _ -> String (random_name ()) + | Uuidv4 _ -> String (Uuidm.v `V4 |> Uuidm.to_string) + | Foreign (_, reference) -> random_value_in_list reference + | Const (_, value) -> String value + | Int (_, min, max) -> Int (Random.int (max - min) + min) + | List (_, values) -> String (random_value_in_list values) + + 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 @@ -42,30 +84,6 @@ let%test "random_value_in_list" = 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 "hashed" password *) (* TODO: Support variables using @ *) @@ -76,6 +94,23 @@ let rec replicate element n = | n -> element :: replicate element (n - 1) +let%test "generate_uuid" = + generate_fixture (Uuidv4 "some_id") != generate_fixture (Uuidv4 "some_id") + + +let id_of_fixture fixture = + let id = + match fixture with + | Name id -> id + | Uuidv4 id -> id + | Foreign (id, _) -> id + | Const (id, _) -> id + | Int (id, _, _) -> id + | List (id, _) -> id + in + String id + + 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 @@ -85,7 +120,7 @@ let compile fixtures ~amount = let%test "create" = let defs = compile [ Uuidv4 "id"; Name "name" ] ~amount:2 in match defs with - | [ [ "id"; "name" ]; [ _; _ ]; [ _; _ ] ] -> true + | [ [ String "id"; String "name" ]; [ _; _ ]; [ _; _ ] ] -> true | _ -> false @@ -95,18 +130,18 @@ let get_id foreign_fixture = | _ -> Error "Not a foreign fixture" -let rec csv_of_string_list strs = +let rec csv_of_string_list (strs : compiled list) = match strs with | [] -> "" - | str :: [] -> str - | str :: rest -> str ^ "," ^ csv_of_string_list rest + | str :: [] -> show_compiled_csv str + | str :: rest -> show_compiled_csv 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 + let maybe_index = List.find_index (fun s -> s = String 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)) @@ -118,23 +153,30 @@ let csv_of_generated_fixtures fixtures = let%test "csv_of_generated_fixtures" = - let result = [ [ "id"; "name" ]; [ "1234"; "John" ] ] |> csv_of_generated_fixtures in + let result = + [ [ String "id"; String "name" ]; [ String "1234"; String "John" ] ] + |> csv_of_generated_fixtures + in result = "id,name\n1234,John" -let json_of_generated_fixtures fixtures = +let json_of_pair (key, value) = + "\"" ^ key_of_compiled key ^ "\": " ^ json_of_compiled value + + +let json_of_generated_fixtures (fixtures : compiled list list) = 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\"}]" + let result = + [ [ String "id"; String "name" ]; [ Int 1234; String "John" ] ] + |> json_of_generated_fixtures + in + result = "[{\"id\": 1234, \"name\": \"John\"}]" |