open Format
module Fixture = Fixture

type ast_row =
  | Uuidv4 of string * ast_row
  | Name of string * ast_row
  | Int of string * int * int * ast_row
  | Const of string * string * ast_row
  | List of string * string list * ast_row
  | Foreign of string * string * string * ast_row
  (* parent, row, child_name, row *)
  | End
[@@deriving show, eq]

type ast_table =
  | Table of string * int * ast_row * ast_table
  | End
[@@deriving show, eq]
(** In hindsight, this could've been represented as a list of tables instead using separated list command 
    TODO: Rewrite this to use a list of tables instead of a tree *)

let rec print_row = function
  | Uuidv4 (s, r) ->
    printf "UUIDv4(%s)," s;
    print_row r
  | List (s, l, r) ->
    printf "List(%s, %s)," s (String.concat ", " l);
    print_row r
  | Const (s, v, r) ->
    printf "Const(%s, %s)," s v;
    print_row r
  | Foreign (p, r, c, next_row) ->
    printf "Foreign(%s.%s, %s)," p r c;
    print_row next_row
  | Int (s, min, max, r) ->
    printf "Int(%s, %d, %d)," s min max;
    print_row r
  | Name (s, r) ->
    printf "Name(%s)," s;
    print_row r
  | End -> printf "\n"


let rec print = function
  | Table (s, amount, r, t) ->
    printf "%s (%d):" s amount;
    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 * int *  Fixture.t list
  | CTable of string * string * string * int * (string list -> Fixture.t list)
  (** parent, row, child_name, row *)
  (* TODO: Support multiple relations *)
  

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
  | 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
  | End -> []


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"))
    (PTable (name, amount, []))
    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, amount, r, t) ->
    ast_table_to_table name amount (ast_row_to_fixtures r) :: ast_table_to_tables t
  | End -> []

let%test "ast_table_to_tables" = 
  let purchase = Table ("purchase", 5, Uuidv4 ("id", Name ("name", End)), End) in
  let ast = Table ("user", 2, 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)
(** 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 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 
  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, amount, 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, 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
  )
  | None -> failwith ("Could not find table " ^ name)

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)])
  ] in 
  let (_, user_fixtures) = resolve_fixtures tables "user"  in 
  let (_, purchase_fixtures) = resolve_fixtures tables "posts" in 
  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 =
  let tables = ast_table_to_tables ast in
  let resolve_fixtures' = function 
    | PTable (n, amount, l) -> 
        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
  in
  let result = List.map resolve_fixtures' tables in 
  result