src/main.ml

   1 (**
   2   Main
   3 *)
   4
   5 open ExtLib
   6
   7 module L = List
   8 module S = String
   9
  10 let parse_one_exn (sql,props) =
  11     if Sqlgg_config.debug1 () then Printf.eprintf "------\n%s\n%!" sql;
  12     let (sql,schema,params,kind) = Syntax.parse sql in
  13     begin match kind, !Gen.params_mode with
  14     | Insert (Some _,_), None -> Error.log "Cannot use `-params none` with autogenerated parameters"
  15     | _ -> ()
  16     end;
  17     let props = Props.set props "sql" sql in
  18     { Gen.schema; params; kind; props }
  19
  20 let parse_one (sql, props as x) =
  21   try
  22     Some (parse_one_exn x)
  23   with
  24   | Parser_utils.Error (exn,(line,cnum,tok,tail)) ->
  25     begin
  26      let extra = match exn with
  27      | Sql.Schema.Error (_,msg) -> msg
  28      | exn -> Printexc.to_string exn
  29      in
  30      Error.log "==> %s" sql;
  31      if cnum = String.length sql && tok = "" then
  32        Error.log "Error: %s" extra
  33      else
  34        Error.log "Position %u:%u Tokens: %s%s\nError: %s" line cnum tok (String.slice ~last:32 tail) extra;
  35      None
  36     end
  37   | exn ->
  38     Error.log "Failed %s: %s" (Option.default "" @@ Props.get props "name") sql;
  39     raise exn
  40
  41 let parse_one (sql,props as x) =
  42   match Props.get props "noparse" with
  43   | Some _ -> Some { Gen.schema=[]; params=[]; kind=Stmt.Other; props=Props.set props "sql" sql }
  44   | None -> parse_one x
  45
  46 let drop_while p e =
  47   while Option.map p (Enum.peek e) = Some true do
  48     Enum.junk e
  49   done
  50
  51 type token = [`Comment of string | `Token of string | `Char of char |
  52               `Space of string | `Prop of string * string | `Semicolon ]
  53
  54 let get_statements ch =
  55   let lexbuf = Lexing.from_channel ch in
  56   let tokens = Enum.from (fun () ->
  57     if lexbuf.Lexing.lex_eof_reached then raise Enum.No_more_elements else
  58     match Sql_lexer.ruleStatement lexbuf with
  59     | `Eof -> raise Enum.No_more_elements
  60     | #token as x -> x)
  61   in
  62   let extract () =
  63     let b = Buffer.create 1024 in
  64     let props = ref Props.empty in
  65     let answer () = Buffer.contents b, !props in
  66     let rec loop smth =
  67       match Enum.get tokens with
  68       | None -> if smth then Some (answer ()) else None
  69       | Some x ->
  70         match x with
  71         | `Comment s -> ignore s; loop smth (* do not include comments (option?) *)
  72         | `Char c -> Buffer.add_char b c; loop true
  73         | `Space _ when smth = false -> loop smth (* drop leading whitespaces *)
  74         | `Token s | `Space s -> Buffer.add_string b s; loop true
  75         | `Prop (n,v) -> props := Props.set !props n v; loop smth
  76         | `Semicolon -> Some (answer ())
  77     in
  78     loop false
  79   in
  80   let extract () = try extract () with e -> Error.log "lexer failed (%s)" (Printexc.to_string e); None in
  81   let rec next () =
  82     match extract () with
  83     | None -> raise Enum.No_more_elements
  84     | Some sql ->
  85       begin match parse_one sql with
  86       | None -> next ()
  87       | Some stmt ->
  88           if not (Sql.Schema.is_unique stmt.schema) then
  89             Error.log "Error: this SQL statement will produce rowset with duplicate column names:\n%s\n" (fst sql);
  90           stmt
  91       end
  92   in
  93   Enum.from next |> List.of_enum
  94
  95 let with_channel filename f =
  96   match try Some (open_in filename) with _ -> None with
  97   | None -> Error.log "cannot open file : %s" filename; f None
  98   | Some ch -> Std.finally (fun () -> close_in_noerr ch) f (Some ch)