src/gen_java.ml

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