aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/ast_types.ml126
-rw-r--r--lib/lexer.mll1
2 files changed, 86 insertions, 41 deletions
diff --git a/lib/ast_types.ml b/lib/ast_types.ml
index 6996435..7189db7 100644
--- a/lib/ast_types.ml
+++ b/lib/ast_types.ml
@@ -13,7 +13,7 @@ type ast_row =
[@@deriving show, eq]
type ast_table =
-(** In hindsight, this could've been represented as a list of tables instead using separated list command
+(** In hindsight, this could've been represented as a list of tables instead using separated_list function
TODO: Rewrite this to use a list of tables instead of a tree *)
| Table of string * int * ast_row * ast_table
@@ -53,46 +53,71 @@ let rec print = function
(* AST to Fixtures *)
type ast_row_relation =
- | PRow of Fixture.t
- | CRow of (string * string * (string list -> Fixture.t))
+ | PColumn of Fixture.t
+ | CColumn of (string * string * (string list -> Fixture.t))
type ast_table_relation =
| PTable of string * int * Fixture.t list
- | CTable of string * string * string * int * (string list -> Fixture.t list)
- (** parent, row, child_name, row *)
+ | CTable of (string * string) list * string * int * (string -> string 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 *)
let table_name = function
| PTable (n,_,_) -> n
- | CTable (_,_,c,_,_) -> c
+ | CTable (_,c,_,_) -> c
let rec ast_row_to_fixtures = function
- | Uuidv4 (s, r) -> PRow (Fixture.Uuidv4 s) :: ast_row_to_fixtures r
+ | Uuidv4 (s, r) -> PColumn (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
- | Int (s, min, max, r) -> PRow (Fixture.Int (s, min, max)) :: ast_row_to_fixtures r
- | Const (s, v, r) -> PRow (Fixture.Const (s, v)) :: ast_row_to_fixtures r
- | List (s, l, r) -> PRow (Fixture.List (s, l)) :: ast_row_to_fixtures r
+ CColumn (p, r, fun l -> Fixture.Foreign (c, l)) :: ast_row_to_fixtures next_row
+ | Name (s, r) -> PColumn (Fixture.Name s) :: ast_row_to_fixtures r
+ | Int (s, min, max, r) -> PColumn (Fixture.Int (s, min, max)) :: ast_row_to_fixtures r
+ | Const (s, v, r) -> PColumn (Fixture.Const (s, v)) :: ast_row_to_fixtures r
+ | List (s, l, r) -> PColumn (Fixture.List (s, l)) :: ast_row_to_fixtures r
| End -> []
+let extend_table_with_row table row =
+ (** This function is magic, but essentially it takes a table and a column and extends the table.
+ For columns where we reference a parent table, we need to be able to resolve that parent in order to
+ know the fixtures, thus we need to instead build a function that takes the generated values for a parent and
+ adds the rows.
+
+ For that, we constructuct a function that takes a parent name and a list of options
+ and applies it to the correct location.
+
+ For understanding this kind of technique, look up contravariant functors
+ *)
+ match row with
+ | PColumn r ->
+ (match table with
+ | PTable (n, amount, l) -> PTable (n, amount, r :: l)
+ | CTable (parents,c, amount, f) -> CTable (parents, c, amount, fun p l -> r :: f p l)
+ )
+ | CColumn (p,pr, f) ->
+ (match table with
+ | PTable (n, amount, l_p) -> CTable ([(p,pr)], n, amount, fun p' l ->
+ if p' = 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
+ [f l]
+ else
+ resolve_parents requested_parent l
+ in
+ CTable ((p,pr) :: parents, c, amount, new_resolver)
+ )
let ast_table_to_table name amount 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, amount, l) -> PTable (n, amount, r :: l)
- | CTable (p, pr, c, amount, f) -> CTable (p, pr, c, amount, fun l -> r :: f l))
- | CRow (p, pr, f) ->
- (match tbl with
- | PTable (c,amount, lr ) -> CTable (p, pr, c, amount, fun l -> f l :: lr)
- | CTable _ -> failwith "Cannot have multiple relations"))
+ extend_table_with_row
(PTable (name, amount, []))
rows
@@ -114,6 +139,20 @@ let%test "ast_table_to_tables" =
let generated_fixtures = ref (Hashtbl.create 10)
(** Used to not regenerate a different fixture for the same table. Also theoretically speeds up the compilation process by not generating the same fixture twice. I do not know what kind of monstrosity of a fixture you'd need for it to matter, but neat regardless. *)
+let collect_results result_list =
+ (** Collect the results of a list of results into a single result *)
+ let rec collect_results' = function
+ | [] -> Ok []
+ | (Ok l) :: tl ->
+ (match collect_results' tl with
+ | Ok l' -> Ok (l @ l')
+ | Error e -> Error e
+ )
+ | (Error e) :: _ -> Error e
+ in
+ collect_results' result_list
+
+
let rec resolve_fixtures tables name =
(* Verify if we have already generated fixtures for this table *)
let maybe_fixtures = Hashtbl.find_opt !generated_fixtures name in
@@ -128,21 +167,31 @@ let rec resolve_fixtures tables name =
(* store the generated fixtures for this table *)
Hashtbl.add !generated_fixtures name (snd resolved);
resolved
- | Some (CTable (p,pr,c, amount, create_fixtures)) -> (
- let (_, parent_fixtures) = resolve_fixtures tables p in
- (* store the generated fixtures for this table *)
- Hashtbl.add !generated_fixtures name parent_fixtures;
- 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
+ | Some (CTable (parents, c, amount, create_fixtures)) -> (
+ resolve_along_with_parents tables name amount parents c create_fixtures
)
| 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,parent_fixtures) -> (
+ Fixture.find_entries_for_header parent_fixtures pr
+ |> Result.map (fun ids -> create_fixtures p ids))
+ )
+ |> collect_results
+ in
+ (* store the generated fixtures for this table *)
+ match maybe_parents_fixtures with
+ | Ok parents_fixtures ->
+ let compiled = Fixture.compile ~amount parents_fixtures in
+ Hashtbl.add !generated_fixtures name compiled;
+ (c, compiled)
+ | Error e -> failwith e
let%test "resolve_fixtures" =
let tables = [
PTable ("user", 1, [Fixture.Uuidv4 "id"; Fixture.Uuidv4 "uuid"]);
- CTable ("user", "id", "posts", 1, fun ids -> [Fixture.Foreign ("user_id", ids)])
+ CTable ([("user", "id")], "posts", 1, fun _ ids -> [Fixture.Foreign ("user_id", ids)])
] in
let (_, user_fixtures) = resolve_fixtures tables "user" in
let (_, purchase_fixtures) = resolve_fixtures tables "posts" in
@@ -155,7 +204,7 @@ let%test "resolve_fixtures" =
let show_tables tables =
let show_table = function
| PTable (n,_,_) -> n
- | CTable (_,_,c,_,_) -> c
+ | CTable (_,c,_,_) -> c
in
tables |> List.map show_table |> String.concat "\n"
@@ -167,15 +216,10 @@ let compile ast =
let (n,_,resolved) = (n, amount, Fixture.compile l ~amount) in
Hashtbl.add !generated_fixtures n resolved;
(n,resolved)
- | CTable (p,pr,c, amount, create_fixtures) ->
- let (_, parent_fixtures) = resolve_fixtures tables p in
- Hashtbl.add !generated_fixtures c parent_fixtures;
- 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
+ | CTable (parents,c, amount, create_fixtures) ->
+ let (c, resolved) = resolve_along_with_parents tables c amount parents c create_fixtures in
+ Hashtbl.add !generated_fixtures c resolved;
+ (c,resolved)
in
let result = List.map resolve_fixtures' tables in
result
-
-
diff --git a/lib/lexer.mll b/lib/lexer.mll
index c6f2b93..e2f6469 100644
--- a/lib/lexer.mll
+++ b/lib/lexer.mll
@@ -15,6 +15,7 @@ let id = ['a'-'z' 'A'-'Z' '-']*
let newline = '\r' | '\n' | "\r\n"
let many_newline = newline+
+(* TODO: Support _ and - in identifiers *)
rule read =
parse
| "uuidv4" { UUIDV4 }