src/gen_java.ml

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