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 start_ cls =
  18    let f1 name =
  19    output "public %s %s" cls name;
  20    G.open_curly ()
  21    in
  22    let f2 name =
  23    G.close_curly " // %s %s" cls name;
  24    empty_line ()
  25    in
  26    f1,f2
  27
  28 let (start_class,end_class) = start_ "class"
  29 let (start_intf,end_intf) = start_ "interface"
  30
  31 let as_java_type = function
  32   | Type.Int -> "int"
  33   | Type.Text -> "String"
  34   | Type.Float -> "float"
  35   | Type.Blob -> "Blob"
  36   | Type.Bool -> "boolean"
  37   | Type.Datetime -> "Timestamp"
  38
  39 let get_column attr index =
  40   sprintf "res.get%s(%u)"
  41     (attr.RA.domain >> as_java_type >> String.capitalize)
  42     (index + 1)
  43
  44 let param_type_to_string t = t >> Option.default Type.Text >> as_java_type
  45
  46 let set_param index param =
  47   let (id,t) = param in
  48   output "pstmt.set%s(%u, %s);"
  49     (t >> param_type_to_string >> String.capitalize)
  50     (index+1)
  51     (param_name_to_string id index)
  52
  53 let schema_to_values = List.mapi (fun i attr -> name_of attr i, attr.RA.domain >> as_java_type)
  54
  55 let output_schema_binder index schema =
  56   let name = default_name "output" index in
  57   start_intf name;
  58
  59   output "public void callback(%s);" (G.Values.to_string (schema_to_values schema));
  60
  61   end_intf name;
  62   name
  63
  64 let output_schema_binder index schema =
  65   match schema with
  66   | [] -> None
  67   | _ -> Some (output_schema_binder index schema)
  68
  69 let params_to_values = List.mapi (fun i (n,t) -> param_name_to_string n i, t >> param_type_to_string)
  70 let params_to_values = List.unique & params_to_values
  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 >> output_value_defs;
  79   end_class name
  80
  81 let output_params_binder index params =
  82 (*
  83   let name = default_name "params" index in
  84   start_class name;
  85 *)
  86 (*
  87   let values = params_to_values params in
  88   values >> make_const_values >> output_value_defs;
  89   empty_line ();
  90   output "%s(%s)" name (values >> make_const_values >> G.Values.to_string);
  91   output_value_inits values;
  92   G.open_curly ();
  93   G.close_curly "";
  94   empty_line ();
  95   output "void set_params(typename Traits::statement stmt)";
  96   G.open_curly ();
  97 *)
  98   List.iteri set_param params;
  99   ()
 100 (*
 101   G.close_curly "";
 102   empty_line ();
 103   end_class name;
 104   name
 105 *)
 106
 107 type t = unit
 108
 109 let start () = ()
 110
 111 let generate_code () index schema params kind props =
 112    let schema_binder_name = output_schema_binder index schema in
 113    let values = params_to_values params in
 114    let result = match schema_binder_name with None -> [] | Some name -> ["result",name] in
 115    let all_params = G.Values.to_string
 116      (["db","Connection"] @ result @ values)
 117    in
 118    let name = choose_name props kind index in
 119    let sql = G.quote (get_sql props kind params) in
 120    output "public static int %s(%s) throws SQLException" name all_params;
 121    G.open_curly ();
 122    output "PreparedStatement pstmt = db.prepareStatement(%s);" sql;
 123    output_params_binder index params;
 124    begin match schema_binder_name with
 125    | None -> output "return pstmt.executeUpdate();"
 126    | Some name ->
 127       output "ResultSet res = pstmt.executeQuery();";
 128       let args = List.mapi (fun index attr -> get_column attr index) schema in
 129       let args = String.concat "," args in
 130       output "int count = 0;";
 131       output "while (res.next())";
 132       G.open_curly ();
 133       output "result.callback(%s);" args;
 134       output "count++;";
 135       G.close_curly "";
 136       output "return count;"
 137    end;
 138    G.close_curly "";
 139    empty_line ()
 140
 141 let start_output () name =
 142   output "import java.sql.*;";
 143   empty_line ();
 144   start_class name
 145
 146 let finish_output () name = end_class name
 147