aboutsummaryrefslogtreecommitdiff
path: root/lib/ast_types.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/ast_types.ml')
-rw-r--r--lib/ast_types.ml178
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
+
+