JSON support type handling

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\"}]"