From 262f161f42c4e59beec41c6f440336c38385426a Mon Sep 17 00:00:00 2001 From: Marc Coquand Date: Wed, 20 Dec 2023 20:46:00 -0600 Subject: Initial commit --- lib/ast_types.ml | 178 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 178 insertions(+) create mode 100644 lib/ast_types.ml (limited to 'lib/ast_types.ml') 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 + + -- cgit v1.2.3