Merge pull request #103 from maxtori/destruct-error

simplify and widen the destruct error result

Author: maxtori

Makefile

@@ -2,17 +2,17 @@
 all: build
 
 build:
-	dune build src
+	@dune build src
 
 dev:
-	dune build
+	@dune build
 
 install:
-	dune install
+	@dune install
 
 clean:
-	dune clean
+	@dune clean
 
 doc:
-	dune build @doc
-	rsync -ru _build/default/_doc/_html/* docs/
+	@dune build @doc
+	@rsync -ru _build/default/_doc/_html/* docs/

src/encoding/ezEncoding.ml

@@ -20,26 +20,11 @@ let destruct encoding buf =
       field buf ;
     raise DestructError
 
-type destruct_error = [
-  | `cannot_destruct of string * string
-  | `unexpected_field of string ]
+type destruct_error = [ `destruct_exn of exn ]
 
 let destruct_res encoding s =
   try Ok (Json_encoding.destruct encoding (Ezjsonm.from_string s))
-  with
-  | Cannot_destruct (path, exn)  ->
-    Json_query.print_path_as_json_path ~wildcards:true Format.str_formatter path;
-    Error (`cannot_destruct ((Format.flush_str_formatter ()), Printexc.to_string exn))
-  | Unexpected_field field ->
-    Error (`unexpected_field field)
-
-let error_to_string ?from e =
-  let from = match from with None -> "" | Some s -> " in\n" ^s in
-  match e with
-  | `cannot_destruct (path, exn) ->
-    Printf.sprintf "Cannot destruct: %s from %s%s" path exn from
-  | `unexpected_field field ->
-    Printf.sprintf "Unexpected_field: %s%s" field from
+  with exn -> Error (`destruct_exn exn)
 
 let construct ?compact encoding data =
   Ezjsonm.to_string ?minify:compact (Json_encoding.construct encoding data)

src/encoding/ezEncoding.mli

@@ -1,14 +1,11 @@
 
 exception DestructError
 
-type destruct_error = [
-  | `cannot_destruct of string * string
-  | `unexpected_field of string ]
+type destruct_error = [ `destruct_exn of exn ]
 
 val destruct :  'a Json_encoding.encoding -> string -> 'a
 val destruct_res :  'a Json_encoding.encoding -> string -> ('a, [> destruct_error]) result
 val construct : ?compact:bool -> 'a Json_encoding.encoding -> 'a -> string
-val error_to_string : ?from:string -> [< destruct_error ] -> string
 
 module Ezjsonm : sig
   val from_string : string -> Json_repr.ezjsonm

src/request/ezRequest.ml

@@ -12,9 +12,9 @@ let before_hook = ref (fun () -> ())
 let decode_result ?error io f res =
   match IO.from_string io f res with
   | Ok () -> ()
-  | Error e -> match error with
+  | Error (`destruct_exn exn) -> match error with
     | None -> ()
-    | Some error -> error (-3) (Some (EzEncoding.error_to_string ~from:res e))
+    | Some error -> error (-3) (Some (Printexc.to_string exn))
 
 let any_get = ref (fun ?meth:_m ?headers:_ ?msg:_ _url f ->
     f (Error (-2,Some "No http client loaded")))

src/request/ezRequest_lwt.ml

@@ -71,9 +71,9 @@ module Make(S : Interface) : S = struct
       | Ok res ->
         match IO.from_string io (fun x -> x) res with
         | Ok s -> Ok s
-        | Error e -> Error (UnknownError {
+        | Error (`destruct_exn exn) -> Error (UnknownError {
             code = -3;
-            msg = Some (EzEncoding.error_to_string ~from:res e) })
+            msg = Some (Printexc.to_string exn) })
 
     let handle_result service res =
       let err_encodings = Service.error service.s in

src/server/answer.ml

@@ -19,17 +19,10 @@ let cannot_parse (descr, msg, path) =
 
 let method_not_allowed () = return ~code:405 ""
 
-let cannot_destruct (path, exn) =
+let destruct_exception exn =
   let body = EzEncoding.construct Json_encoding.any_ezjson_value @@
-    `O [ "error", `String "Cannot destruct JSON";
-         "path", `String path;
-         "msg", `String exn ] in
-  return ~code:400 ~headers body
-
-let unexpected_field f =
-  let body = EzEncoding.construct Json_encoding.any_ezjson_value @@
-    `O [ "error", `String "Unexpected field in JSON";
-         "field", `String f ] in
+    `O [ "error", `String "Destruct exception";
+         "exception", `String (Printexc.to_string exn) ] in
   return ~code:400 ~headers body
 
 let unsupported_media_type c =

src/server/ezAPIServerUtils.ml

@@ -123,8 +123,7 @@ let handle ?meth ?content_type ?ws s r path body =
     | Ok (`http h) ->
       begin
         h body >>= function
-        | Error (`cannot_destruct a) -> Answer.cannot_destruct a
-        | Error (`unexpected_field f) -> Answer.unexpected_field f
+        | Error (`destruct_exn exn) -> Answer.destruct_exception exn
         | Error (`unsupported c) -> Answer.unsupported_media_type c
         | Error (`handler_error s) ->
           EzDebug.printf "In %s: error %s" (String.concat "/" path) s;

src/websocket/js/ezWs.ml

@@ -65,7 +65,7 @@ let connect0 ?msg ?protocols ?error ~react base service =
     let send i = a.send (EzAPI.IO.to_string input i) in
     match EzAPI.IO.res_from_string output (res_encoding errors) (react {send; close=a.close}) s with
     | Ok r -> r
-    | Error e -> Lwt.return_error (EzEncoding.error_to_string e) in
+    | Error (`destruct_exn exn) -> Lwt.return_error (Printexc.to_string exn) in
   connect ?msg ?protocols ?error ~react url >|= function
   | Error e -> Error e
   | Ok r ->

src/websocket/unix/ezWs.ml

@@ -82,7 +82,7 @@ let connect0 ?msg ?protocols ?error ~react base service =
     let action = {send; close = action.close} in
     match EzAPI.IO.res_from_string output (res_encoding errors) (react action) s with
     | Ok r -> r
-    | Error e -> Lwt.return_error (EzEncoding.error_to_string e) in
+    | Error (`destruct_exn exn) -> Lwt.return_error (Printexc.to_string exn) in
   connect ?msg ?protocols ?error ~react url >|= function
   | Error e -> Error e
   | Ok r ->