diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/ast_types.ml | 16 | ||||
| -rw-r--r-- | lib/fixture.ml | 118 |
2 files changed, 88 insertions, 46 deletions
diff --git a/lib/ast_types.ml b/lib/ast_types.ml index 7189db7..2a786f7 100644 --- a/lib/ast_types.ml +++ b/lib/ast_types.ml @@ -54,11 +54,11 @@ let rec print = function type ast_row_relation = | PColumn of Fixture.t - | CColumn of (string * string * (string list -> Fixture.t)) + | CColumn of (string * string * (Fixture.compiled list -> Fixture.t)) type ast_table_relation = | PTable of string * int * Fixture.t list - | CTable of (string * string) list * string * int * (string -> string list -> Fixture.t list) + | CTable of (string * string) list * string * int * (Fixture.compiled -> Fixture.compiled list -> Fixture.t list) (** parent (name, referenced id), row, child_name, fixture builder given a parent name and list of options *) (* TODO: Support multiple relations *) @@ -97,17 +97,17 @@ let extend_table_with_row table row = | CColumn (p,pr, f) -> (match table with | PTable (n, amount, l_p) -> CTable ([(p,pr)], n, amount, fun p' l -> - if p' = p then + if p' = Fixture.String p then f l :: l_p else [] ) | CTable (parents,c, amount, resolve_parents) -> - let new_resolver = fun requested_parent l -> - if requested_parent = p then + let new_resolver = fun (requested_parent : Fixture.compiled) l -> + if requested_parent = Fixture.String p then [f l] else - resolve_parents requested_parent l + resolve_parents requested_parent l in CTable ((p,pr) :: parents, c, amount, new_resolver) ) @@ -173,7 +173,7 @@ let rec resolve_fixtures tables name = | None -> failwith ("Could not find table " ^ name) and resolve_along_with_parents tables name amount parents c create_fixtures = let maybe_parents_fixtures = parents - |> List.map (fun (p,pr) -> (p,pr, resolve_fixtures tables p |> snd)) + |> List.map (fun (p,pr) -> (Fixture.String p,pr, resolve_fixtures tables p |> snd)) |> List.map (fun (p,pr,parent_fixtures) -> ( Fixture.find_entries_for_header parent_fixtures pr |> Result.map (fun ids -> create_fixtures p ids)) @@ -196,7 +196,7 @@ let%test "resolve_fixtures" = 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 + | ([[Fixture.String "id";_];[u;_]], [[Fixture.String "user_id"]; [v]]) -> v = u | _ -> false 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\"}]" |