Merge pull request #31 from issuu/dte/more-useful-error-messages

More useful error messages

lib/runtime/ppx_mysql_runtime.ml

@@ -183,23 +183,12 @@ module Stdlib = struct
   let ( = ) = ( = )
 end
 
-exception Deserialization_error of string * string
-
-let wrap_deserializer f x =
-  try f x with Failure msg -> raise (Deserialization_error (msg, x))
-
-
 let identity x = x
 
-let int_of_string_exn = wrap_deserializer int_of_string
+let int_of_string = int_of_string
 
-let int32_of_string_exn = wrap_deserializer Int32.of_string
+let int32_of_string = Int32.of_string
 
-let int64_of_string_exn = wrap_deserializer Int64.of_string
+let int64_of_string = Int64.of_string
 
-let bool_of_string_exn str =
-  match int_of_string str <> 0 with
-  | v ->
-      v
-  | exception Failure _ ->
-      raise (Deserialization_error ("Ppx_mysql_runtime.bool_of_string_exn", str))
+let bool_of_string str = int_of_string str <> 0

lib/runtime/ppx_mysql_runtime.mli

@@ -116,14 +116,12 @@ module Stdlib : sig
   val ( = ) : 'a -> 'a -> bool
 end
 
-exception Deserialization_error of string * string
-
 val identity : 'a -> 'a
 
-val int_of_string_exn : string -> int
+val int_of_string : string -> int
 
-val int32_of_string_exn : string -> int32
+val int32_of_string : string -> int32
 
-val int64_of_string_exn : string -> int64
+val int64_of_string : string -> int64
 
-val bool_of_string_exn : string -> bool
+val bool_of_string : string -> bool

ppx/ppx_mysql.ml

@@ -48,38 +48,54 @@ let build_out_param_processor ~loc out_params =
         ~loc
         (Loc.make ~loc (Ldot (Lident of_string_mod, of_string_fun)))
     in
+    let param_name = Buildef.estring ~loc Query.(param.name) in
+    let of_string_desc =
+      Buildef.estring ~loc @@ Printf.sprintf "%s.%s" of_string_mod of_string_fun
+    in
     let arg = [%expr Ppx_mysql_runtime.Stdlib.Array.get row [%e Buildef.eint ~loc i]] in
-    let appl = [%expr (Ppx_mysql_runtime.Stdlib.Option.map [%e of_string]) [%e arg]] in
+    let appl =
+      [%expr
+        let deserialize value =
+          try [%e of_string] value with Failure _ ->
+            raise (Deserialization_error ([%e param_name], [%e of_string_desc], value))
+        in
+        Ppx_mysql_runtime.Stdlib.Option.map deserialize [%e arg]]
+    in
     match param.opt with
     | true ->
         appl
-    | false ->
-        [%expr Ppx_mysql_runtime.Stdlib.Option.get [%e appl]]
+    | false -> (
+        [%expr
+          try Ppx_mysql_runtime.Stdlib.Option.get [%e appl] with Invalid_argument _ ->
+            raise (Expected_non_null_column [%e param_name])] )
   in
   let ret_expr =
     match out_params with
     | [] ->
         [%expr ()]
     | [x] ->
         make_elem 0 x
-    | _ :: _ ->
+    | _ :: _ :: _ ->
         Buildef.pexp_tuple ~loc @@ List.mapi make_elem out_params
   in
   let len_expected = Buildef.eint ~loc (List.length out_params) in
   [%expr
     fun row ->
+      (let exception Deserialization_error of string * string * string in
+      (let exception Expected_non_null_column of string in
       let ( = ) = Ppx_mysql_runtime.Stdlib.( = ) in
       let len_row = Ppx_mysql_runtime.Stdlib.Array.length row in
       if len_row = [%e len_expected]
       then
         try Ppx_mysql_runtime.Stdlib.Result.Ok [%e ret_expr] with
-        | Ppx_mysql_runtime.Deserialization_error (f, v) ->
-            Ppx_mysql_runtime.Stdlib.Result.Error (`Deserialization_error (f, v))
-        | Invalid_argument _ ->
-            Ppx_mysql_runtime.Stdlib.Result.Error `Expected_non_null_column
+        | Deserialization_error (col, f, v) ->
+          Ppx_mysql_runtime.Stdlib.Result.Error (`Column_errors [(col, `Deserialization_error (f, v))])
+        | Expected_non_null_column col ->
+          Ppx_mysql_runtime.Stdlib.Result.Error (`Column_errors [(col, `Expected_non_null_value)])
       else
         Ppx_mysql_runtime.Stdlib.Result.Error
-          (`Unexpected_number_of_rows (len_row, [%e len_expected]))]
+          (`Unexpected_number_of_columns (len_row, [%e len_expected]))) [@warning "-38"]) 
+      [@warning "-38"]]
 
 
 let expand ~loc ~path:_ (sql_variant : string) (query : string) =
@@ -199,7 +215,9 @@ let expand ~loc ~path:_ (sql_variant : string) (query : string) =
            (Location.Error.createf ~loc "Error in 'mysql' extension: %s" msg))
 
 
-let pattern = Ast_pattern.(pexp_apply (pexp_ident (lident __)) (pair nolabel (estring __) ^:: nil))
+let pattern =
+  Ast_pattern.(pexp_apply (pexp_ident (lident __)) (pair nolabel (estring __) ^:: nil))
+
 
 let name = "mysql"
 

ppx/query.mll

@@ -22,10 +22,10 @@ type parse_error =
 let build_param spec opt name =
   let open Result in
   begin match spec with
-  | "int" -> Ok ("int", ("Ppx_mysql_runtime", "int_of_string_exn"), ("Pervasives", "string_of_int"))
-  | "int32" -> Ok ("int32", ("Ppx_mysql_runtime", "int32_of_string_exn"), ("Int32", "to_string"))
-  | "int64" -> Ok ("int64", ("Ppx_mysql_runtime", "int64_of_string_exn"), ("Int64", "to_string"))
-  | "bool" -> Ok ("bool", ("Ppx_mysql_runtime", "bool_of_string_exn"), ("Pervasives", "string_of_bool"))
+  | "int" -> Ok ("int", ("Ppx_mysql_runtime", "int_of_string"), ("Pervasives", "string_of_int"))
+  | "int32" -> Ok ("int32", ("Ppx_mysql_runtime", "int32_of_string"), ("Int32", "to_string"))
+  | "int64" -> Ok ("int64", ("Ppx_mysql_runtime", "int64_of_string"), ("Int64", "to_string"))
+  | "bool" -> Ok ("bool", ("Ppx_mysql_runtime", "bool_of_string"), ("Pervasives", "string_of_bool"))
   | "string" -> Ok ("string", ("Ppx_mysql_runtime", "identity"), ("Ppx_mysql_runtime", "identity"))
   | spec -> Error (`Unknown_type_spec spec)
   end >>= fun (typ, of_string, to_string) ->