(**
  Main
*)

open ExtLib
open Sqlgg

module L = List
module S = String

let parse_one' (sql,props) =
    if Sqlgg_config.debug1 () then Printf.eprintf "------\n%s\n%!" sql;
    let (sql,schema,vars,kind) = Syntax.parse sql in
    begin match kind, !Gen.params_mode with
    | Insert (Some _,_), None -> Error.log "Cannot use `-params none` with autogenerated parameters"
    | _ -> ()
    end;
    let props = Props.set props "sql" sql in
    { Gen.schema; vars; kind; props }

(* Printexc.raise_with_backtrace is only available since 4.05.0 *)
exception With_backtrace of exn * Printexc.raw_backtrace

let () = Printexc.(register_printer begin function
  | With_backtrace (exn,bt) when raw_backtrace_length bt = 0 -> Some (to_string exn)
  | With_backtrace (exn,bt) -> Some (Printf.sprintf "%s\nBacktrace:\n%s" (to_string exn) (raw_backtrace_to_string bt))
  | _ -> None
end)

(** @return parsed statement or [None] in case of parsing failure.
    @raise exn for other errors (typing etc)
*)
let parse_one (sql, props as x) =
  try
    Some (parse_one' x)
  with
  | Parser_utils.Error (exn,(line,cnum,tok,tail)) ->
    begin
     let extra = match exn with
     | Sql.Schema.Error (_,msg) -> msg
     | exn -> Printexc.to_string exn
     in
     Error.log "==> %s" sql;
     if cnum = String.length sql && tok = "" then
       Error.log "Error: %s" extra
     else
       Error.log "Position %u:%u Tokens: %s%s\nError: %s" line cnum tok (String.slice ~last:32 tail) extra;
     None
    end
  | exn ->
    let bt = Printexc.get_raw_backtrace () in
    Error.log "Failed %s: %s" (Option.default "" @@ Props.get props "name") sql;
    let exn =
      match exn with
      | Prelude.At ((p1,p2),exn) -> Error.log "At : %s" (String.slice ~first:p1 ~last:p2 sql); exn
      | _ -> exn
    in
(*     Printexc.raise_with_backtrace exn bt *)
    raise @@ With_backtrace (exn,bt)

let parse_one (sql,props as x) =
  match Props.get props "noparse" with
  | Some _ -> Some { Gen.schema=[]; vars=[]; kind=Stmt.Other; props=Props.set props "sql" sql }
  | None -> parse_one x

let drop_while p e =
  while Option.map p (Enum.peek e) = Some true do
    Enum.junk e
  done

type token = [`Comment of string | `Token of string | `Char of char |
              `Space of string | `Prop of string * string | `Semicolon ]

let get_statements ch =
  let lexbuf = Lexing.from_channel ch in
  let tokens = Enum.from (fun () ->
    if lexbuf.Lexing.lex_eof_reached then raise Enum.No_more_elements else
    match Sql_lexer.ruleStatement lexbuf with
    | `Eof -> raise Enum.No_more_elements
    | #token as x -> x)
  in
  let extract () =
    let b = Buffer.create 1024 in
    let props = ref Props.empty in
    let answer () = Buffer.contents b, !props in
    let rec loop smth =
      match Enum.get tokens with
      | None -> if smth then Some (answer ()) else None
      | Some x ->
        match x with
        | `Comment s -> ignore s; loop smth (* do not include comments (option?) *)
        | `Char c -> Buffer.add_char b c; loop true
        | `Space _ when smth = false -> loop smth (* drop leading whitespaces *)
        | `Token s | `Space s -> Buffer.add_string b s; loop true
        | `Prop (n,v) -> props := Props.set !props n v; loop smth
        | `Semicolon -> Some (answer ())
    in
    loop false
  in
  let extract () = try extract () with e -> Error.log "lexer failed (%s)" (Printexc.to_string e); None in
  let rec next () =
    match extract () with
    | None -> raise Enum.No_more_elements
    | Some sql ->
      begin match parse_one sql with
      | None -> next ()
      | Some stmt ->
          let open Sql in
          if not (Sql.Schema.is_unique stmt.schema) then
            Printf.eprintf "Warning: this SQL statement will produce rowset with duplicate column names:\n%s\n" (fst sql);
          match List.exists (fun a -> Type.is_unit a.domain) stmt.schema with
          | true -> Error.log "Output schema contains column of type Unit, which is not allowed"; next ()
          | false ->
          (* FIXME iterate choice *)
          match List.filter_map (function (i,Single p) when Type.is_unit p.typ -> Some (Gen.show_param_name p i) | _ -> None) @@ List.mapi (fun i p -> i,p)  stmt.vars with
          | _::_ as l -> Error.log "Input parameter(s) of type Unit not allowed : %s" (String.concat " " l); next ()
          | [] ->
            stmt
      end
  in
  Enum.from next |> List.of_enum

let with_channel filename f =
  match try Some (open_in filename) with _ -> None with
  | None -> Error.log "cannot open file : %s" filename; f None
  | Some ch -> Std.finally (fun () -> close_in_noerr ch) f (Some ch)
