Merge pull request #47 from issuu/dte/minor-error-refactoring

Minor refactoring of error handling

README.md

@@ -69,6 +69,7 @@ sig
   module IO_result : sig
     type ('a, 'e) t = ('a, 'e) result IO.t
 
+    val return : 'a -> ('a, 'e) t
     val bind : ('a, 'e) t -> ('a -> ('b, 'e) t) -> ('b, 'e) t
     val ( >>= ) : ('a, 'e) t -> ('a -> ('b, 'e) t) -> ('b, 'e) t
   end
@@ -174,13 +175,69 @@ Type specifications
 -------------------
 
 Serialization of input parameters and deserialization of output parameters
-is done according to provided type specifications.  These have the same
-name as the OCaml type you wish to (de)serialize to and from.  Presently,
-the supported types are `int`, `int32`, `int64`, `bool`, and `string`.
+is done according to provided type specifications.  A type specification
+can either begin with a lowercase or an uppercase letter.  In the former case,
+its name must either be the same as the base OCaml type you wish to (de)serialize
+to and from (presently, the supported types are `int`, `int32`, `int64`,
+`bool`, and `string`), or the special type specification `list` (please see
+the section on *List of values as input parameter* below for more details).
+In the latter case, the syntax extension assumes you are referencing a type
+with custom (de)serialization functions (please see the next section for
+a detailed explanation of this feature).
+
 Note that you will get a runtime error if there is a mismatch between
 the types in your database and the types you specify in your query.
 
 
+Custom types and (de)serialization functions
+--------------------------------------------
+
+The syntax extension has limited support for custom types with user-defined
+(de)serialization functions.  Consider the example below, noting in the particular
+the use of `Suit` as a type specification both for an input and an output parameter:
+
+```ocaml
+module Suit : Ppx_mysql_runtime.SERIALIZABLE = struct
+  type t = Clubs | Diamonds | Hearts | Spades
+
+  let of_mysql = function
+    | "c" -> Ok Clubs
+    | "d" -> Ok Diamonds
+    | "h" -> Ok Hearts
+    | "s" -> Ok Spades
+    | _   -> Error "invalid suit"
+
+  let to_mysql = function
+    | Clubs -> "c"
+    | Diamonds -> "d"
+    | Hearts -> "h"
+    | Spades -> "s"
+end
+
+let get_cards = [%mysql select_all "SELECT @int{id}, @Suit{suit} FROM cards WHERE suit <> %Suit{suit}"]
+```
+
+As you may have guessed, upon encountering a type specification whose first
+letter is uppercase -- `Suit` in this case -- the syntax extension assumes it
+refers to a module name that implements the `Ppx_mysql_runtime.SERIALIZABLE`
+signature listed below:
+
+```ocaml
+module type SERIALIZABLE = sig
+  type t
+
+  val of_mysql : string -> (t, string) result
+
+  val to_mysql : t -> string
+end
+```
+
+Besides defining a type `t`, the module must also implement the deserialization
+function `of_mysql` and the serialization function `to_mysql`. The MySQL wire
+protocol uses strings for serialization, which explains the signatures of these
+functions.
+
+
 Other select queries
 --------------------
 

examples/hello_world_with_async/hello_world_with_async.ml

@@ -24,7 +24,7 @@ module Phone : Ppx_mysql_runtime.SERIALIZABLE with type t = string = struct
   let of_mysql str =
     if String.length str <= 9
     then Ok str
-    else Error (`Deserialization_error "string too long")
+    else Error "string too long"
 
   let to_mysql str = str
 end

examples/hello_world_with_identity/hello_world_with_identity.ml

@@ -20,7 +20,7 @@ module Phone : Ppx_mysql_runtime.SERIALIZABLE with type t = string = struct
   let of_mysql str =
     if String.length str <= 9
     then Ok str
-    else Error (`Deserialization_error "string too long")
+    else Error "string too long"
 
   let to_mysql str = str
 end

examples/hello_world_with_lwt/hello_world_with_lwt.ml

@@ -20,7 +20,7 @@ module Phone : Ppx_mysql_runtime.SERIALIZABLE with type t = string = struct
   let of_mysql str =
     if String.length str <= 9
     then Ok str
-    else Error (`Deserialization_error "string too long")
+    else Error "string too long"
 
   let to_mysql str = str
 end

lib/runtime/ppx_mysql_runtime.ml

@@ -1,16 +1,25 @@
+type deserialization_error =
+  {
+  idx : int;
+  name : string;
+  func : string;
+  value : string;
+  message : string
+  }
+
 type column_error =
   [ `Expected_non_null_column of int * string
-  | `Deserialization_error of int * string * string * string * string ]
+  | `Deserialization_error of deserialization_error ]
 
-type 'a deserializer = string -> ('a, [`Deserialization_error of string]) result
+type 'a deserializer = string -> ('a, string) result
 
 let wrap_failure : (string -> 'a) -> 'a deserializer =
  fun of_string s ->
   match of_string s with
   | v ->
       Ok v
   | exception Failure _ ->
-      Error (`Deserialization_error "cannot parse number")
+      Error "cannot parse number"
 
 let string_of_string str = Ok str
 
@@ -25,11 +34,11 @@ let bool_of_string str =
   | v ->
       Ok (v <> 0)
   | exception Failure _ ->
-      Error (`Deserialization_error "cannot parse boolean")
+      Error "cannot parse boolean"
 
 external identity : 'a -> 'a = "%identity"
 
-let deserialize_non_nullable_column idx name of_string of_string_descr err_accum =
+let deserialize_non_nullable_column idx name of_string func err_accum =
   function
   | None ->
       let err = `Expected_non_null_column (idx, name) in
@@ -38,25 +47,25 @@ let deserialize_non_nullable_column idx name of_string of_string_descr err_accum
     match of_string value with
     | Ok ok ->
         Some ok, err_accum
-    | Error (`Deserialization_error msg) ->
-        let err = `Deserialization_error (idx, name, of_string_descr, value, msg) in
+    | Error message ->
+        let err = `Deserialization_error {idx; name; func; value; message} in
         None, err :: err_accum )
 
-let deserialize_nullable_column idx name of_string of_string_descr err_accum = function
+let deserialize_nullable_column idx name of_string func err_accum = function
   | None ->
       Some None, err_accum
   | Some value -> (
     match of_string value with
     | Ok ok ->
         Some (Some ok), err_accum
-    | Error (`Deserialization_error msg) ->
-        let err = `Deserialization_error (idx, name, of_string_descr, value, msg) in
+    | Error message ->
+        let err = `Deserialization_error {idx; name; func; value; message} in
         None, err :: err_accum )
 
 module type SERIALIZABLE = sig
   type t
 
-  val of_mysql : string -> (t, [`Deserialization_error of string]) result
+  val of_mysql : string -> (t, string) result
 
   val to_mysql : t -> string
 end

lib/runtime/ppx_mysql_runtime.mli

@@ -1,8 +1,17 @@
+type deserialization_error =
+  {
+  idx : int;
+  name : string;
+  func : string;
+  value : string;
+  message : string
+  }
+
 type column_error =
   [ `Expected_non_null_column of int * string
-  | `Deserialization_error of int * string * string * string * string ]
+  | `Deserialization_error of deserialization_error ]
 
-type 'a deserializer = string -> ('a, [`Deserialization_error of string]) result
+type 'a deserializer = string -> ('a, string) result
 
 val string_of_string : string deserializer
 
@@ -37,7 +46,7 @@ val deserialize_nullable_column
 module type SERIALIZABLE = sig
   type t
 
-  val of_mysql : string -> (t, [`Deserialization_error of string]) result
+  val of_mysql : string -> (t, string) result
 
   val to_mysql : t -> string
 end