Support more than 1 many-relations

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 }