JSON support type handling

3 files changed, 89 insertions, 47 deletions

diff --git a/README.md b/README.md
index f6792cf..c4026b0 100644
--- a/README.md
+++ b/README.md
@@ -1,4 +1,4 @@
-# (WIP) Fixgen - Language agnostic fixture generator
+# Fixgen - Language agnostic fixture generator
 
 Usually wiring up fake test data is a bunch of work, especially when that data is relational. Fixgen helps to alleviate some of that pain by allowing you to very easily generate fixtures that can also reference other fixtures. It also has some nice characteristics:
 
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\"}]"