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
  | Increment of string * ast_row
  | Email of string * ast_row
  | Const of string * string * ast_row
  | List of string * string list * ast_row
  | Username of string * ast_row
  | Foreign of string * string * string * ast_row
  (* parent, row, child_name, row *)
  | End
[@@deriving show, eq]

type ast_table =
(** 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
  | End
[@@deriving show, eq]

let rec print_row = function
  | Uuidv4 (s, r) ->
    printf "UUIDv4(%s)," s;
    print_row r
  | Username (s, r) ->
    printf "User(%s)," s;
    print_row r
  | List (s, l, r) ->
    printf "List(%s, %s)," s (String.concat ", " l);
    print_row r
  | Increment (s, r) -> 
    printf "Increment(%s)," s;
    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
  | Email (s, r) ->
    printf "Email(%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 =
  | PColumn of Fixture.t
  | CColumn of (string * string * (Fixture.compiled list -> Fixture.t))

type ast_table_relation =
  | PTable of string * int *  Fixture.t list
  | CTable of (string * string) list * string * int * (Fixture.compiled -> Fixture.compiled list -> Fixture.t list)
  (** parent (name, referenced id), row, child_name, fixture builder given a parent name and list of options *)
  

let table_name = function 
  | PTable (n,_,_) -> n 
  | CTable (_,c,_,_) -> c

let rec ast_row_to_fixtures = function
  | Uuidv4 (s, r) -> PColumn (Fixture.Uuidv4 s) :: ast_row_to_fixtures r
  | Foreign (p, r, c, next_row) ->
    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
  | Increment (s, r) -> PColumn (Fixture.Increment s) :: ast_row_to_fixtures r
  | Email (s, r) -> PColumn (Fixture.Email s) :: ast_row_to_fixtures r
  | Username (s, r) -> PColumn (Fixture.Username s) :: 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' = Fixture.String p then 
            f l  :: l_p 
          else 
            []
          )
      | CTable (parents,c, amount, resolve_parents) -> 
          let new_resolver = fun (requested_parent : Fixture.compiled) l -> 
            if requested_parent = Fixture.String 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
    extend_table_with_row
    (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 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 
  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 (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) -> (Fixture.String 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)])
  ] in 
  let (_, user_fixtures) = resolve_fixtures tables "user"  in 
  let (_, purchase_fixtures) = resolve_fixtures tables "posts" in 
  match (user_fixtures,purchase_fixtures) with 
    | ([[Fixture.String "id";_];[u;_]], [[Fixture.String "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 (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