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)),Some 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     let stmt = parse_one_exn x in
  49     if not (RA.Schema.is_unique stmt.Stmt.schema) then
  50       Error.log "Error: this SQL statement will produce rowset with duplicate column names:\n%s\n" sql;
  51     Some stmt
  52   with
  53   | Parser_utils.Error (exn,(line,cnum,tok)) ->
  54     begin
  55      let extra = Printexc.to_string exn in
  56      Error.log "==> %s" sql;
  57      if cnum = String.length sql then
  58        Error.log "Exception %s" extra
  59      else
  60        Error.log "Exception %s in %u:%u at lexeme \"%s\"" extra line cnum tok;
  61      None
  62     end
  63
  64 let get_statements ch =
  65   let lexbuf = Lexing.from_channel ch in
  66   let f () = try Sql_lexer.ruleStatement Props.empty lexbuf with exn -> None in
  67   let rec next () =
  68     match f () with
  69     | None -> raise Enum.No_more_elements
  70     | Some sql ->
  71       begin match parse_one sql with
  72       | None -> next ()
  73       | Some stmt -> stmt
  74       end
  75   in
  76   Enum.from next
  77
  78 let with_file filename f =
  79   match catch Std.input_file filename with
  80   | None -> Error.log "cannot open file : %s" filename
  81   | Some s -> f s
  82
  83 let with_channel filename f =
  84   match catch open_in filename with
  85   | None -> Error.log "cannot open file : %s" filename
  86   | Some ch -> Std.finally (fun () -> close_in_noerr ch) f ch
  87