Merge pull request #52 from issuu/dte/future-proof

Make the API future-proof

CHANGES.md

@@ -1,3 +1,9 @@
+1.0
+===
+
+* All statements are now cached
+* First public release
+
 0.5
 ===
 

README.md

@@ -79,13 +79,31 @@ sig
     type stmt
     type stmt_result
     type error
+    type wrapped_dbh
     type wrapped_error = [`Mysql_error of error]
 
-    val create : dbh -> string -> (stmt, [> wrapped_error]) result IO.t
-    val execute_null : stmt -> string option array -> (stmt_result, [> wrapped_error]) result IO.t
-    val fetch : stmt_result -> (string option array option, [> wrapped_error]) result IO.t
-    val close : stmt -> (unit, [> wrapped_error]) result IO.t
-    val with_stmt : dbh -> string -> (stmt -> ('a, ([> wrapped_error] as 'e)) result IO.t) -> ('a, 'e) result IO.t
+    val init : dbh -> wrapped_dbh
+
+    val execute_null :
+      stmt ->
+      string option array ->
+      (stmt_result, [> wrapped_error]) result IO.t
+
+    val fetch :
+      stmt_result ->
+      (string option array option, [> wrapped_error]) result IO.t
+
+    val with_stmt_cached :
+      wrapped_dbh ->
+      string ->
+      (stmt -> ('a, ([> wrapped_error] as 'e)) result IO.t) ->
+      ('a, 'e) result IO.t
+
+    val with_stmt_uncached :
+      wrapped_dbh ->
+      string ->
+      (stmt -> ('a, ([> wrapped_error] as 'e)) result IO.t) ->
+      ('a, 'e) result IO.t
   end
 end
 ```
@@ -136,7 +154,7 @@ neither necessary nor recommended for actual code.  Here's the same
 ```ocaml
 let get_employee dbh employee_id =
     let q :
-        Prepared.dbh ->
+        Prepared.wrapped_dbh ->
         employee_id:int32 ->
         ((int32 * int32 option * string * string option), error) result IO.t =
         [%mysql select_one
@@ -149,7 +167,9 @@ let get_employee dbh employee_id =
 
 Things to note:
 
- - Type `Prepared.dbh` is the type of database handles.
+ - Type `Prepared.wrapped_dbh` is a wrapper around a raw database handle.
+   You can obtain a value of this type by invoking function `Prepared.init`
+   with a raw database handle as argument.
 
  - We denote input parameters using the syntax `%TYPE{name}`, where `TYPE`
    is a type specification (see next section), and `name` is the OCaml named
@@ -250,7 +270,7 @@ other errors may still occur).
 ```ocaml
 let get_supervisor dbh employee_id =
     let q :
-        Prepared.dbh ->
+        Prepared.wrapped_dbh ->
         employee_id:int32 ->
         ((int32 * int32 option * string * string option) option, error) result IO.t =
         [%mysql select_opt
@@ -269,7 +289,7 @@ may occur).
 ```ocaml
 let get_underlings dbh supervisor_id =
     let q :
-        Prepared.dbh ->
+        Prepared.wrapped_dbh ->
         supervisor_id:int32 ->
         ((int32 * int32 option * string * string option) list, error) result IO.t =
         [%mysql select_all
@@ -294,7 +314,7 @@ one does not usually need to worry about the order).
 ```ocaml
 let insert_employee dbh {id; supervisor_id; name; phone} =
     let q :
-        Prepared.dbh ->
+        Prepared.wrapped_dbh ->
         id:int32 ->
         supervisor_id:int32 option ->
         name:string ->
@@ -325,7 +345,7 @@ declaration.
 ```ocaml
 let insert_employees dbh rows =
     let q :
-        Prepared.dbh ->
+        Prepared.wrapped_dbh ->
         (int32 * int32 option * string * string option) list ->
         (unit, error) result IO.t =
         [%mysql execute
@@ -343,7 +363,7 @@ this use case:
 ```ocaml
 let select_employees dbh ids =
     let q :
-        Prepared.dbh ->
+        Prepared.wrapped_dbh ->
         int32 list ->
         name:string ->
         ((int32 * int32 option * string * string option) list, error) result IO.t =
@@ -382,12 +402,12 @@ Special cases
 -------------
 
 Should there be no input parameters, the function generated by the syntax
-extension will take only the database handle as parameter:
+extension will take only the wrapped database handle as parameter:
 
 ```ocaml
 let get_unsupervised dbh =
     let q :
-        Prepared.dbh ->
+        Prepared.wrapped_dbh ->
         ((int32 * int32 option * string * string option) list, error) result IO.t =
         [%mysql select_all
         "SELECT @int32{id}, @int32?{supervisor_id}, @string{name}, @string?{phone}
@@ -403,7 +423,7 @@ SQL statement, the generated function will take it only once:
 ```ocaml
 let is_related dbh id =
     let q :
-        Prepared.dbh ->
+        Prepared.wrapped_dbh ->
         id:int32 ->
         ((int32 * int32 option * string * string option) list, error) result IO.t =
         [%mysql select_all

examples/hello_world_with_async/hello_world_with_async.ml

@@ -119,8 +119,8 @@ let test dbh =
 let main () =
   let open Deferred.Infix in
   let dbh = Mysql.quick_connect ~database:"test" ~user:"root" () in
-  let caching_dbh = Prepared.init dbh in
-  test caching_dbh >>= fun res ->
+  let wrapped_dbh = Prepared.init dbh in
+  test wrapped_dbh >>= fun res ->
   Mysql.disconnect dbh;
   match res with
   | Ok () ->

examples/hello_world_with_async/mysql_with_async.ml

@@ -23,6 +23,8 @@ include Ppx_mysql_runtime.Make_context (struct
 
     let create dbh sql = wrap (Mysql.Prepared.create dbh) sql
 
+    let close stmt = wrap Mysql.Prepared.close stmt
+
     let execute_null stmt args = wrap (Mysql.Prepared.execute_null stmt) args
 
     let fetch stmt_res = wrap Mysql.Prepared.fetch stmt_res

examples/hello_world_with_identity/hello_world_with_identity.ml

@@ -114,8 +114,8 @@ let test dbh =
 
 let main () =
   let dbh = Mysql.quick_connect ~database:"test" ~user:"root" () in
-  let caching_dbh = Prepared.init dbh in
-  let res = test caching_dbh in
+  let wrapped_dbh = Prepared.init dbh in
+  let res = test wrapped_dbh in
   Mysql.disconnect dbh;
   match res with
   | Ok () -> Printf.printf "All went well!\n"

examples/hello_world_with_lwt/hello_world_with_lwt.ml

@@ -114,8 +114,8 @@ let test dbh =
 let main () =
   let open Lwt.Infix in
   let dbh = Mysql.quick_connect ~database:"test" ~user:"root" () in
-  let caching_dbh = Prepared.init dbh in
-  test caching_dbh >>= fun res ->
+  let wrapped_dbh = Prepared.init dbh in
+  test wrapped_dbh >>= fun res ->
   Mysql.disconnect dbh;
   match res with
   | Ok () -> Lwt_io.printf "All went well!\n"

examples/hello_world_with_lwt/mysql_with_lwt.ml

@@ -18,6 +18,8 @@ include Ppx_mysql_runtime.Make_context (struct
 
     let create dbd sql = wrap (Mysql.Prepared.create dbd) sql
 
+    let close stmt = wrap Mysql.Prepared.close stmt
+
     let execute_null stmt args = wrap (Mysql.Prepared.execute_null stmt) args
 
     let fetch stmt_res = wrap Mysql.Prepared.fetch stmt_res

lib/mysql_with_identity/mysql_with_identity.ml

@@ -20,6 +20,8 @@ include Ppx_mysql_runtime.Make_context (struct
 
     let create dbh sql = wrap (Mysql.Prepared.create dbh) sql
 
+    let close stmt = wrap Mysql.Prepared.close stmt
+
     let execute_null stmt args = wrap (Mysql.Prepared.execute_null stmt) args
 
     let fetch stmt_res = wrap Mysql.Prepared.fetch stmt_res

lib/runtime/ppx_mysql_runtime.ml

@@ -81,6 +81,8 @@ module type PPX_MYSQL_CONTEXT_ARG = sig
 
     val create : dbh -> string -> (stmt, error) result IO.t
 
+    val close : stmt -> (unit, error) result IO.t
+
     val execute_null : stmt -> string option array -> (stmt_result, error) result IO.t
 
     val fetch : stmt_result -> (string option array option, error) result IO.t
@@ -117,11 +119,11 @@ module type PPX_MYSQL_CONTEXT = sig
 
     type error
 
-    type wrapped_error = [`Mysql_error of error]
+    type wrapped_dbh
 
-    type caching_dbh
+    type wrapped_error = [`Mysql_error of error]
 
-    val init : dbh -> caching_dbh
+    val init : dbh -> wrapped_dbh
 
     val execute_null
       :  stmt ->
@@ -132,8 +134,14 @@ module type PPX_MYSQL_CONTEXT = sig
       :  stmt_result ->
       (string option array option, [> wrapped_error]) result IO.t
 
-    val with_stmt
-      :  caching_dbh ->
+    val with_stmt_cached
+      :  wrapped_dbh ->
+      string ->
+      (stmt -> ('a, ([> wrapped_error] as 'e)) result IO.t) ->
+      ('a, 'e) result IO.t
+
+    val with_stmt_uncached
+      :  wrapped_dbh ->
       string ->
       (stmt -> ('a, ([> wrapped_error] as 'e)) result IO.t) ->
       ('a, 'e) result IO.t
@@ -173,13 +181,13 @@ module Make_context (M : PPX_MYSQL_CONTEXT_ARG) :
 
     type error = M.Prepared.error
 
-    type wrapped_error = [`Mysql_error of error]
-
-    type caching_dbh = {
+    type wrapped_dbh = {
       dbh : dbh;
-      stmt_cache : (Digest.t, stmt) Hashtbl.t
+      stmt_cache : (string, stmt) Hashtbl.t
     }
 
+    type wrapped_error = [`Mysql_error of error]
+
     let wrap f x =
       IO.bind (f x) @@ function
       | Ok _ as ok -> IO.return ok
@@ -190,20 +198,28 @@ module Make_context (M : PPX_MYSQL_CONTEXT_ARG) :
     let create dbh sql = wrap (M.Prepared.create dbh) sql
 
     let create_or_reuse {dbh; stmt_cache} sql =
-      let digest = Digest.string sql in
-      match Hashtbl.find_opt stmt_cache digest with
+      match Hashtbl.find_opt stmt_cache sql with
       | Some stmt -> IO_result.return stmt
       | None ->
           IO_result.bind (create dbh sql) @@ fun stmt ->
-          Hashtbl.replace stmt_cache digest stmt;
+          Hashtbl.replace stmt_cache sql stmt;
           IO_result.return stmt
 
+    let close stmt = wrap M.Prepared.close stmt
+
     let execute_null stmt args = wrap (M.Prepared.execute_null stmt) args
 
     let fetch stmt_res = wrap M.Prepared.fetch stmt_res
 
-    let with_stmt caching_dbh sql f =
-      IO_result.bind (create_or_reuse caching_dbh sql) @@ fun stmt -> f stmt
+    let with_stmt_cached wrapped_dbh sql f =
+      IO_result.bind (create_or_reuse wrapped_dbh sql) @@ fun stmt -> f stmt
+
+    let with_stmt_uncached {dbh; stmt_cache = _} sql f =
+      IO_result.bind (create dbh sql) @@ fun stmt ->
+      IO.bind (f stmt) @@ fun res ->
+      IO.bind (close stmt) @@ function
+      | Ok () -> IO.return res
+      | Error _ as e -> IO.return e
   end
 end
 

lib/runtime/ppx_mysql_runtime.mli

@@ -70,6 +70,8 @@ module type PPX_MYSQL_CONTEXT_ARG = sig
 
     val create : dbh -> string -> (stmt, error) result IO.t
 
+    val close : stmt -> (unit, error) result IO.t
+
     val execute_null : stmt -> string option array -> (stmt_result, error) result IO.t
 
     val fetch : stmt_result -> (string option array option, error) result IO.t
@@ -106,11 +108,11 @@ module type PPX_MYSQL_CONTEXT = sig
 
     type error
 
-    type wrapped_error = [`Mysql_error of error]
+    type wrapped_dbh
 
-    type caching_dbh
+    type wrapped_error = [`Mysql_error of error]
 
-    val init : dbh -> caching_dbh
+    val init : dbh -> wrapped_dbh
 
     val execute_null
       :  stmt ->
@@ -121,8 +123,14 @@ module type PPX_MYSQL_CONTEXT = sig
       :  stmt_result ->
       (string option array option, [> wrapped_error]) result IO.t
 
-    val with_stmt
-      :  caching_dbh ->
+    val with_stmt_cached
+      :  wrapped_dbh ->
+      string ->
+      (stmt -> ('a, ([> wrapped_error] as 'e)) result IO.t) ->
+      ('a, 'e) result IO.t
+
+    val with_stmt_uncached
+      :  wrapped_dbh ->
       string ->
       (stmt -> ('a, ([> wrapped_error] as 'e)) result IO.t) ->
       ('a, 'e) result IO.t

ppx/ppx_mysql.ml

@@ -285,7 +285,7 @@ let actually_expand ~loc sql_variant query =
       let[@warning "-26"] process_out_params =
         [%e build_out_param_processor ~loc out_params]
       in
-      Prepared.with_stmt [%e dbh_ident] sql (fun stmt ->
+      Prepared.with_stmt_cached [%e dbh_ident] sql (fun stmt ->
           Prepared.execute_null stmt params >>= fun stmt_result -> [%e process_rows] ()
       )]
   in