JSON support type handling

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