src/main.ml

   1 (**
   2   Main
   3 *)
   4
   5 open Printf
   6 open Operators
   7 open ListMore
   8 open ExtString
   9 open Apply
  10
  11 module L = List
  12 module S = String
  13
  14 let repeat f x k =
  15   let rec loop () =
  16     match f x with
  17     | Some z -> k z
  18     | None -> ()
  19   in
  20   loop ()
  21
  22 let parse_one_exn (sql,props) =
  23 (*     print_endline stmt; *)
  24     let (s,p,k) = Parser.parse_stmt sql in
  25     (* fill VALUES *)
  26     let (sql,p) = match k with
  27     | Stmt.Insert (Some s,_) ->
  28       let module B = Buffer in
  29       let b = B.create 100 in
  30       B.add_string b sql;
  31       B.add_string b " (";
  32       let params = ref [] in
  33       s >> List.iter (fun attr ->
  34         if !params <> [] then B.add_string b ",";
  35         let name = "@" ^ attr.RA.name in
  36         let param = ((Some attr.RA.name,(B.length b,B.length b + String.length name)),attr.RA.domain) in
  37         B.add_string b name;
  38         params := param :: !params
  39       );
  40       B.add_string b ")";
  41       (B.contents b, p @ (List.rev !params))
  42     | _ -> (sql,p)
  43     in
  44     {Stmt.schema=s; params=p; kind=k; props=Props.set props "sql" sql}
  45
  46 let parse_one (sql,props as x) =
  47   try
  48     Some (parse_one_exn x)
  49   with
  50   | Parser_utils.Error (exn,(line,cnum,tok,tail)) ->
  51     begin
  52      let extra = Printexc.to_string exn in
  53      Error.log "==> %s" sql;
  54      if cnum = String.length sql && tok = "" then
  55        Error.log "Exception %s" extra
  56      else
  57        Error.log "Exception %s in %u:%u at \"%s%s\"" extra line cnum tok (String.slice ~last:32 tail);
  58      None
  59     end
  60
  61 let parse_one (sql,props as x) =
  62   match Props.get props "noparse" with
  63   | Some _ -> Some { Stmt.schema=[]; params=[]; kind=Stmt.Other; props=Props.set props "sql" sql }
  64   | None -> parse_one x
  65
  66 let get_statements ch =
  67   let lexbuf = Lexing.from_channel ch in
  68   let f () = try Sql_lexer.ruleStatement Props.empty lexbuf with exn -> None in
  69   let rec next () =
  70     match f () with
  71     | None -> raise Enum.No_more_elements
  72     | Some sql ->
  73       begin match parse_one sql with
  74       | None -> next ()
  75       | Some stmt ->
  76           if not (RA.Schema.is_unique stmt.Stmt.schema) then
  77             Error.log "Error: this SQL statement will produce rowset with duplicate column names:\n%s\n" (fst sql);
  78           stmt
  79       end
  80   in
  81   Enum.from next
  82
  83 let with_file filename f =
  84   match catch Std.input_file filename with
  85   | None -> Error.log "cannot open file : %s" filename
  86   | Some s -> f s
  87
  88 let with_channel filename f =
  89   match catch open_in filename with
  90   | None -> Error.log "cannot open file : %s" filename
  91   | Some ch -> Std.finally (fun () -> close_in_noerr ch) f ch
  92