Initial commit

1 files changed, 178 insertions, 0 deletions

diff --git a/lib/ast_types.ml b/lib/ast_types.ml
new file mode 100644
index 0000000..1c5de60
--- /dev/null
+++ b/lib/ast_types.ml
@@ -0,0 +1,178 @@
+open Format
+module Fixture = Fixture
+
+type ast_row =
+  | Uuidv4 of string * ast_row
+  | Name of string * ast_row
+  | Foreign of string * string * string * ast_row
+  (* parent, row, child_name, row *)
+  | End
+[@@deriving show, eq]
+
+type ast_table =
+  | Table of string * ast_row * ast_table
+  | End
+[@@deriving show, eq]
+
+let rec print_row = function
+  | Uuidv4 (s, r) ->
+    printf "UUIDv4(%s)," s;
+    print_row r
+  | Foreign (p, r, c, next_row) ->
+    printf "Foreign(%s.%s, %s)," p r c;
+    print_row next_row
+  | Name (s, r) ->
+    printf "Name(%s)," s;
+    print_row r
+  | End -> printf "\n"
+
+
+let rec print = function
+  | Table (s, r, t) ->
+    printf "%s:" s;
+    print_row r;
+    print t
+  | End -> printf "\n"
+
+
+(* AST to Fixtures *)
+
+type ast_row_relation =
+  | PRow of Fixture.t
+  | CRow of (string * string * (string list -> Fixture.t))
+
+type ast_table_relation =
+  | PTable of string * Fixture.t list
+  | CTable of string * string * string * (string list -> Fixture.t list)
+  (** parent, row, child_name, row *)
+
+let table_name = function 
+  | PTable (n,_) -> n 
+  | CTable (_,_,c,_) -> c
+
+let rec ast_row_to_fixtures = function
+  | Uuidv4 (s, r) -> PRow (Fixture.Uuidv4 s) :: ast_row_to_fixtures r
+  | Foreign (p, r, c, next_row) ->
+    CRow (p, r, fun l -> Fixture.Foreign (c, l)) :: ast_row_to_fixtures next_row
+  | Name (s, r) -> PRow (Fixture.Name s) :: ast_row_to_fixtures r
+  | End -> []
+
+
+let ast_table_to_table name rows =
+  (** Convert an AST table to a Fixture table that we can more easily work with for
+     feeding the generated data as input into fixtures that depend on the generated
+     data from other fixtures *)
+  List.fold_left
+    (fun tbl row ->
+      match row with
+      | PRow r ->
+        (match tbl with
+         | PTable (n, l) -> PTable (n, r :: l)
+         | CTable (p, pr, c, f) -> CTable (p, pr, c, fun l -> r :: f l))
+      | CRow (p, pr, f) ->
+        (match tbl with
+         | PTable (c, lr) -> CTable (p, pr, c, fun l -> f l :: lr)
+         | CTable _ -> failwith "Cannot have multiple relations"))
+    (PTable (name, []))
+    rows
+
+
+let rec ast_table_to_tables ast =
+  (** Convert an AST table to a list of Fixture tables, so once data has been generated
+      it can be used as input for the next entry *)
+  match ast with
+  | Table (name, r, t) ->
+    print_endline ("Converting table: " ^ name);
+    ast_table_to_table name (ast_row_to_fixtures r) :: ast_table_to_tables t
+  | End -> []
+
+let%test "ast_table_to_tables" = 
+  let purchase = Table ("purchase", Uuidv4 ("id", Name ("name", End)), End) in
+  let ast = Table ("user", Uuidv4 ("id", Name ("name", End)), purchase) in
+  let tables = ast_table_to_tables ast in 
+  List.length tables == 2
+
+let generated_fixtures = ref (Hashtbl.create 10)
+
+let rec resolve_fixtures tables name ~amount = 
+  (* Verify if we have already generated fixtures for this table *) 
+  let maybe_fixtures = Hashtbl.find_opt !generated_fixtures name in 
+  match maybe_fixtures with 
+  | Some fixtures -> (name, fixtures) 
+  | None -> 
+  let maybe_table = List.find_opt (fun tbl -> table_name tbl = name) tables 
+  in 
+  match maybe_table with 
+  | Some (PTable (n,l)) -> 
+      let resolved = (n, Fixture.compile l ~amount) in 
+      (* store the generated fixtures for this table *)
+      Hashtbl.add !generated_fixtures name (snd resolved);
+      resolved 
+  | Some (CTable (p,pr,c,create_fixtures)) ->  (
+      let (_, parent_fixtures) = resolve_fixtures tables p ~amount in
+      (* store the generated fixtures for this table *) 
+      Hashtbl.add !generated_fixtures name parent_fixtures;
+      print_endline ("Resolving fixtures for " ^ c);
+      for i = 0 to List.length parent_fixtures - 1 do 
+        print_endline ("Parent fixture: " ^ Fixture.csv_of_string_list (List.nth parent_fixtures i));
+      done;
+      let generated_ids = Fixture.find_entries_for_header parent_fixtures pr in
+      print_endline ("Generated ids: " ^ String.concat ", " (Result.get_ok generated_ids));
+      match generated_ids with 
+        | Ok ids -> (c, Fixture.compile ~amount (create_fixtures ids)) 
+        | Error e -> failwith e
+  )
+  | None -> failwith ("Could not find table " ^ name)
+
+let%test "resolve_fixtures" = 
+  let tables = [
+    PTable ("user", [Fixture.Uuidv4 "id"; Fixture.Uuidv4 "uuid"]);
+    CTable ("user", "id", "posts", fun ids -> [Fixture.Foreign ("user_id", ids)])
+  ] in 
+  let (_, user_fixtures) = resolve_fixtures tables "user" ~amount:1 in 
+  let (_, purchase_fixtures) = resolve_fixtures tables "posts" ~amount:1 in 
+        for i = 0 to List.length user_fixtures - 1 do 
+          print_endline ("User fixture: " ^ Fixture.csv_of_string_list (List.nth user_fixtures i));
+        done;
+        for i = 0 to List.length purchase_fixtures - 1 do 
+          print_endline ("Purchase fixture: " ^ Fixture.csv_of_string_list (List.nth purchase_fixtures i));
+        done;
+  match (user_fixtures,purchase_fixtures) with 
+    | ([["id";_];[u;_]], [["user_id"]; [v]]) -> v = u
+    | _ -> 
+        false
+
+
+let show_tables tables = 
+  let show_table = function 
+    | PTable (n,_) -> n 
+    | CTable (_,_,c,_) -> c 
+  in 
+  tables |> List.map show_table |> String.concat "\n"
+
+
+let compile ast ~amount =
+  let tables = ast_table_to_tables ast in
+  print_endline ("Table length: " ^ string_of_int (List.length tables));
+  print_endline (show_tables tables);
+  let resolve_fixtures' = function 
+    | PTable (n,l) -> 
+        let resolved = (n, Fixture.compile l ~amount) in 
+        (* store the generated fixtures for this table *)
+        Hashtbl.add !generated_fixtures n (snd resolved);
+        resolved
+    | CTable (p,pr,c,create_fixtures) -> 
+      let (_, parent_fixtures) = resolve_fixtures tables p ~amount in
+      (* store the generated fixtures for this table *)
+      Hashtbl.add !generated_fixtures c parent_fixtures;
+      print_endline ("Resolving fixtures for " ^ c);
+      let generated_ids = Fixture.find_entries_for_header parent_fixtures pr in
+      match generated_ids with 
+        | Ok ids -> (c, Fixture.compile ~amount (create_fixtures ids)) 
+        | Error e -> failwith e
+  in
+  let result = List.map resolve_fixtures' tables in 
+  print_endline ("Result names: " ^ String.concat ", " (List.map fst result));
+  result
+
+