aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/ast_types.ml16
-rw-r--r--lib/fixture.ml118
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\"}]"