src/gen_csharp.ml

   1 (* C# 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 module J = Gen_java
  12 module Values = G.Values
  13
  14 let comment = G.comment
  15 let empty_line = G.empty_line
  16
  17 let comment_doc sl =
  18   output "/**";
  19   output_l (List.map (fun str -> Gen_caml.replace_all ~sub:"*/" ~by:"* /" ~str) sl);
  20   output "*/"
  21
  22 let comment_xml summary params =
  23   let summary = String.nsplit summary "\n" in
  24   let params = List.map (fun (n,s) -> sprintf "<param name=\"%s\">%s</param>" n s) params in
  25   comment_doc ("<summary>" :: summary @ ("</summary>" :: params))
  26
  27 let (start_class,end_class) = J.start_class,J.end_class
  28 let (start_ns,end_ns) = J.start_ "namespace"
  29
  30 let quote = J.quote
  31
  32 module L = struct
  33
  34 let as_api_type = function
  35   | Type.Int -> "Int64"
  36   | Type.Text -> "String"
  37   | Type.Float -> "Float"
  38   | Type.Blob -> "String"
  39   | Type.Bool -> "Boolean"
  40   | Type.Datetime -> "Datetime"
  41   | Type.Any -> "String"
  42
  43 let as_lang_type = as_api_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 "reader.Get%s(%u)"
  54     (attr.domain |> as_api_type)
  55     index
  56
  57 let schema_to_string = G.Values.to_string $ schema_to_values
  58
  59 let output_schema_binder _ schema =
  60   let name = "callback" in
  61   output "public delegate void %s(%s);" name (schema_to_string schema);
  62   empty_line ();
  63   name
  64
  65 let output_schema_binder index schema =
  66   match schema with
  67   | [] -> None
  68   | _ -> Some (output_schema_binder index schema)
  69
  70 let set_param index param =
  71   let (id,t) = param in
  72   let name = default_name "param" index in
  73   output "IDbDataParameter %s = _cmd.CreateParameter();" name;
  74   output "%s.ParameterName = \"@%s\";" name id;
  75   output "%s.DbType = DbType.%s;" name t; (* FIXME? this is ok because api_type = lang_type *)
  76   output "_cmd.Parameters.Add(%s);" name
  77
  78 let output_params_binder params =
  79   List.iteri set_param params;
  80   output "_cmd.Prepare();"
  81
  82 type t = unit
  83
  84 let start () = ()
  85
  86 let func_execute index stmt =
  87     let values = params_to_values stmt.params in
  88     let schema_binder_name = output_schema_binder index stmt.schema in
  89     let is_select = Option.is_some schema_binder_name in
  90     let doc = if is_select then ["result", schema_to_string stmt.schema] else [] in
  91     comment_xml "execute query" doc;
  92     let func_name = if is_select then "execute_reader" else "execute" in
  93     let result = "public " ^ if is_select then "IEnumerable<IDataReader>" else "int" in
  94     G.func result func_name values (fun () ->
  95       output "if (null == _cmd)";
  96       G.open_curly ();
  97       output "_cmd = _conn.CreateCommand();";
  98       output "_cmd.CommandText = sql;";
  99       output_params_binder values;
 100       G.close_curly "";
 101       output "if (null != CommandTimeout) _cmd.CommandTimeout = CommandTimeout.Value;";
 102       List.iteri
 103         (fun i (name,_) -> output "((IDbDataParameter)_cmd.Parameters[%u]).Value = %s;" i name)
 104         values;
 105       begin match schema_binder_name with
 106       | None -> output "return _cmd.ExecuteNonQuery();"
 107       | Some _ ->
 108          output "IDataReader reader = _cmd.ExecuteReader();";
 109          output "while (reader.Read())";
 110          G.open_curly ();
 111          output "yield return reader;";
 112          G.close_curly "";
 113          output "reader.Close();";
 114       end);
 115     if is_select then
 116     begin
 117       empty_line ();
 118       let result = match schema_binder_name with None -> [] | Some name -> ["result",name] in
 119       let all_params = values @ result in
 120       G.func "public int" "execute" all_params (fun () ->
 121          let args = List.mapi (fun index attr -> get_column attr index) stmt.schema in
 122          output "int count = 0;";
 123          output "foreach (var reader in execute_reader(%s))" (Values.inline values);
 124          G.open_curly ();
 125          output "result(%s);" (Values.join args);
 126          output "count++;";
 127          G.close_curly "";
 128          output "return count;"
 129       );
 130       empty_line ();
 131       match stmt.schema with
 132       | [attr] ->
 133         let t = as_lang_type attr.domain in
 134         G.func ("public IEnumerable<" ^ t ^ ">") "rows" values (fun () ->
 135         output "foreach (var reader in execute_reader(%s))" (Values.inline values);
 136         G.open_curly ();
 137         output "yield return %s;" (get_column attr 0);
 138         G.close_curly ""
 139         )
 140       | _ ->
 141       start_class "row";
 142       List.iteri (fun index attr ->
 143         output "public readonly %s %s;"
 144           (as_lang_type attr.domain)
 145           (name_of attr index)
 146       ) stmt.schema;
 147       empty_line ();
 148       G.func "public" "row" ["reader","IDataReader"] (fun () ->
 149         List.iteri (fun i attr -> output "%s = %s;" (name_of attr i) (get_column attr i)) stmt.schema;
 150       );
 151       end_class "row";
 152       G.func "public IEnumerable<row>" "rows" values (fun () ->
 153         output "foreach (var reader in execute_reader(%s))" (Values.inline values);
 154         G.open_curly ();
 155         output "yield return new row(reader);";
 156         G.close_curly ""
 157       )
 158     end
 159 (*
 160     else (* not is_select *)
 161     begin
 162       match stmt.kind with
 163       | Insert _ when List.length values > 1 ->
 164           G.func "public int" "execute<T>" ["v","T"] (fun () ->
 165             output "return execute(%s);" (values |> Values.names |> List.map ((^) "v.") |> Values.join)
 166           )
 167       | _ -> ()
 168     end
 169 *)
 170
 171 let generate_code index stmt =
 172    let name = choose_name stmt.props stmt.kind index in
 173    let sql = quote (get_sql stmt) in
 174    start_class name;
 175     output "IDbCommand _cmd;";
 176     output "IDbConnection _conn;";
 177     output "public int? CommandTimeout;";
 178     output "static string sql = %s;" sql;
 179     empty_line ();
 180     G.func "public" name ["db","IDbConnection"] (fun () ->
 181       output "_cmd = null;";
 182       output "_conn = db;";
 183     );
 184     empty_line ();
 185     func_execute index stmt;
 186    end_class name;
 187    name
 188
 189 let generate_all names =
 190   start_class "all";
 191   output "public readonly IDbConnection db;";
 192   List.iter (fun s -> output "public %s %s;" s s) names;
 193   empty_line ();
 194   G.func "public" "all" ["db","IDbConnection"] (fun () ->
 195     output "this.db = db;";
 196     List.iter (fun name -> output "%s = new %s(db);" name name) names
 197   );
 198   end_class "all"
 199
 200 let generate () name stmts =
 201   params_mode := Some Named; (* only named params allowed *)
 202   let using = ["System";"System.Data";"System.Collections.Generic"] in
 203   List.iter (fun s -> output "using %s;" s) using;
 204   empty_line ();
 205   start_ns name;
 206   let names = List.mapi generate_code stmts in
 207   generate_all names;
 208   end_ns name