gen_java.ml

   1 (* Java code generation *)
   2
   3 open ExtList
   4 open ExtString
   5 open Operators
   6 open Printf
   7
   8 open Stmt
   9 open Gen
  10 open Sql
  11
  12 module G = Gen_cxx
  13
  14 let comment = G.comment
  15 let empty_line = G.empty_line
  16
  17 let quote = String.replace_chars (function '\n' -> "\" +\n\"" | '\r' -> "" | '"' -> "\\\"" | c -> String.make 1 c)
  18 let quote s = "\"" ^ quote s ^ "\""
  19
  20 let start_ cls =
  21    let f1 name =
  22    output "%s %s" cls name;
  23    G.open_curly ()
  24    in
  25    let f2 name =
  26    G.close_curly " // %s %s" cls name;
  27    empty_line ()
  28    in
  29    f1,f2
  30
  31 let (start_class,end_class) = start_ "public class"
  32 let (start_intf,end_intf) = start_ "public static interface"
  33
  34 let as_java_type = function
  35   | Type.Int -> "int"
  36   | Type.Text -> "String"
  37   | Type.Float -> "float"
  38   | Type.Blob -> "Blob"
  39   | Type.Bool -> "boolean"
  40   | Type.Datetime -> "Timestamp"
  41
  42 let get_column attr index =
  43   sprintf "res.get%s(%u)"
  44     (attr.RA.domain >> as_java_type >> String.capitalize)
  45     (index + 1)
  46
  47 let param_type_to_string t = t >> Option.default Type.Text >> as_java_type
  48
  49 let schema_to_values = List.mapi (fun i attr -> name_of attr i, attr.RA.domain >> as_java_type)
  50
  51 let output_schema_binder name index schema =
  52   let name = sprintf "%s_callback" name in
  53   start_intf name;
  54   output "public void callback(%s);" (G.Values.to_string (schema_to_values schema));
  55   end_intf name;
  56   name
  57
  58 let output_schema_binder name index schema =
  59   match schema with
  60   | [] -> None
  61   | _ -> Some (output_schema_binder name index schema)
  62
  63 let params_to_values = List.mapi (fun i (n,t) -> param_name_to_string n i, t >> param_type_to_string)
  64 let params_to_values = List.unique & params_to_values
  65
  66 let output_value_defs vals =
  67   vals >> List.iter (fun (name,t) -> output "%s %s;" t name)
  68
  69 let output_schema_data index schema =
  70   let name = default_name "data" index in
  71   start_class name;
  72   schema >> schema_to_values >> output_value_defs;
  73   end_class name
  74
  75 let set_param name index param =
  76   let (id,t) = param in
  77   output "pstmt_%s.set%s(%u, %s);"
  78     name
  79     (t >> param_type_to_string >> String.capitalize)
  80     (index+1)
  81     (param_name_to_string id index)
  82
  83 let output_params_binder name index params = List.iteri (set_param name) params
  84
  85 type t = unit
  86
  87 let start () = ()
  88
  89 let generate_code index stmt =
  90    let values = params_to_values stmt.params in
  91    let name = choose_name stmt.props stmt.kind index in
  92    let sql = quote (get_sql stmt) in
  93    output "PreparedStatement pstmt_%s;" name;
  94    empty_line ();
  95    let schema_binder_name = output_schema_binder name index stmt.schema in
  96    let result = match schema_binder_name with None -> [] | Some name -> ["result",name] in
  97    let all_params = values @ result in
  98    G.func "public int" name all_params ~tail:"throws SQLException" (fun () ->
  99       output "if (null == pstmt_%s)" name;
 100       output "  pstmt_%s = db.prepareStatement(%s);" name sql;
 101       output_params_binder name index stmt.params;
 102       begin match schema_binder_name with
 103       | None -> output "return pstmt_%s.executeUpdate();" name
 104       | Some _ ->
 105          output "ResultSet res = pstmt_%s.executeQuery();" name;
 106          let args = List.mapi (fun index attr -> get_column attr index) stmt.schema in
 107          let args = String.concat "," args in
 108          output "int count = 0;";
 109          output "while (res.next())";
 110          G.open_curly ();
 111          output "result.callback(%s);" args;
 112          output "count++;";
 113          G.close_curly "";
 114          output "return count;"
 115       end);
 116     empty_line ()
 117
 118 let generate () name stmts =
 119   params_mode := Some Unnamed; (* allow only unnamed params *)
 120   output "import java.sql.*;";
 121   empty_line ();
 122   start_class name;
 123   output "Connection db;";
 124   empty_line ();
 125   G.func "public" name ["aDb","Connection"] (fun () ->
 126     output "db = aDb;";
 127   );
 128   empty_line ();
 129   Enum.iteri generate_code stmts;
 130   end_class name
 131