Permalink
Browse files

Fix collision on to_string and of_string

  • Loading branch information...
1 parent 11bda94 commit 13f33d399ab3d7a48d0d2a7a07bd7d263c91eb82 @VictorNicollet committed May 21, 2012
Showing with 36 additions and 23 deletions.
  1. +1 −1 src/action_Request.ml
  2. +1 −1 src/action_Response.ml
  3. +2 −2 src/couchDB_cache.ml
  4. +4 −4 src/couchDB_table.ml
  5. +4 −4 src/couchDB_views.ml
  6. +3 −3 src/fmt.ml
  7. +2 −2 src/jsCode.ml
  8. +14 −3 src/json.ml
  9. +4 −2 src/json.mli
  10. +1 −1 src/util.ml
@@ -46,7 +46,7 @@ class ['server,'args] fcgi_request
(try
let field = (cgi # argument "BODY") # value in
match utf8 field with
- | Some field -> Json.of_string field
+ | Some field -> Json.unserialize field
| None -> Json.Null
with _ -> Json.Null))
else
@@ -112,7 +112,7 @@ let process suffix (cgi : Netcgi.cgi) response =
try ignore (List.assoc name acc) ; acc with Not_found -> (name,value) :: acc
) [] full
|> Json.of_assoc
- |> Json.to_string
+ |> Json.serialize
in
ignore (out_channel # output json 0 (String.length json))
end
@@ -110,7 +110,7 @@ let fetch database =
let url = CacheKey.url key in
Util.logreq "GET %s" url ;
try let result = Http_client.Convenience.http_get url in
- try let json = Json.of_string result in
+ try let json = Json.unserialize result in
cache_values [key, Some (cached_of_json json)]
with
| Json.Error error ->
@@ -138,7 +138,7 @@ let fetch database =
"include_docs", "true" ; "keys", keys_str ] ] in
Util.logreq "GET %s" url ;
try let result = Http_client.Convenience.http_get url in
- try let list = Json.of_string result
+ try let list = Json.unserialize result
|> Json.to_object (fun ~opt ~req -> req "rows")
|> Json.to_array in
let docs = BatList.filter_map begin fun json ->
@@ -46,7 +46,7 @@ module Database = functor (Config:ImplTypes.CONFIG) -> struct
if retries <= 0 then Bad exn else query_all_docs ~retries:(retries-1) start limit in
let key k =
- Json.to_string (Json.String k) in
+ Json.serialize (Json.String k) in
let keep = function (x, None) -> None | (x, Some y) -> Some (x,y) in
let args = BatList.filter_map keep [
@@ -66,7 +66,7 @@ module Database = functor (Config:ImplTypes.CONFIG) -> struct
try Util.logreq "GET %s" url ;
let json_str = Http_client.Convenience.http_get url in
try let list =
- Json.of_string json_str
+ Json.unserialize json_str
|> Json.to_object (fun ~opt ~req -> Json.to_array (req "rows"))
|> List.map (Json.to_object (fun ~opt ~req -> Id.of_json (req "id")))
in
@@ -142,13 +142,13 @@ module Database = functor (Config:ImplTypes.CONFIG) -> struct
(* Send the new document to the database now. *)
- let json_str = Json.to_string json in
+ let json_str = Json.serialize json in
let rec retry retries =
try Util.logreq "PUT %s %s" url json_str ;
let response = Http_client.Convenience.http_put url json_str in
try let rev =
- Json.of_string response
+ Json.unserialize response
|> Json.to_object (fun ~opt ~req -> Json.to_string (req "rev"))
in Run.return (`ok (Some rev))
with _ -> Run.return (`ok None)
@@ -80,7 +80,7 @@ module Views = struct
| Some rev -> ( "_rev" , rev ) :: put
in
let json = Json.Object put in
- let json_str = Json.to_string json in
+ let json_str = Json.serialize json in
Util.logreq "PUT %s %s" url json_str ;
let response = Http_client.Convenience.http_put url json_str in
ignore response
@@ -91,7 +91,7 @@ module Views = struct
Util.logreq "GET %s" url ;
let response = Http_client.Convenience.http_get url in
let rev =
- Json.of_string response
+ Json.unserialize response
|> Json.to_object (fun ~opt ~req -> req "_rev")
in aux (Some rev)
in
@@ -124,7 +124,7 @@ let view_query_url
?(group=false)
() =
- let key k = Json.to_string (keyfmt k) in
+ let key k = Json.serialize (keyfmt k) in
let keep = function (x, None) -> None | (x, Some y) -> Some (x,y) in
let args = BatList.filter_map keep [
"include_docs", (if include_docs then Some "true" else None) ;
@@ -160,7 +160,7 @@ let rec process_view_results ?(retries=5) url =
try Util.logreq "GET %s" url ;
let json_str = Http_client.Convenience.http_get url in
try Run.return begin
- Json.of_string json_str
+ Json.unserialize json_str
|> Json.to_object (fun ~opt ~req -> Json.to_array (req "rows"))
end
with Json.Error error as exn ->
View
@@ -55,11 +55,11 @@ end) -> struct
let of_json_safe = protect of_json
let of_json_string_safe str =
- try of_json_safe (Json.of_string str)
+ try of_json_safe (Json.unserialize str)
with _ -> None
let to_json_string t =
- Json.to_string (to_json t)
+ Json.serialize (to_json t)
let fmt = { to_json = to_json ; of_json = of_json_safe }
@@ -75,7 +75,7 @@ end) -> struct
let of_json_safe = protect of_json
let of_json_string_safe str =
- try of_json_safe (Json.of_string str)
+ try of_json_safe (Json.unserialize str)
with _ -> None
end
View
@@ -29,7 +29,7 @@ let script_of_call call =
call.name
^ "("
^ String.concat ", "
- (List.map Json.to_string call.args)
+ (List.map Json.serialize call.args)
^ ")"
let to_script t =
@@ -41,7 +41,7 @@ let event_of_call call =
call.name
^ ".call("
^ String.concat ", "
- ("this" :: List.map Json.to_string call.args)
+ ("this" :: List.map Json.serialize call.args)
^ ")"
let to_event t =
View
@@ -16,7 +16,7 @@ exception Error = Json_type.Error
let of_json x = x
let to_json x = x
-let of_string string =
+let unserialize string =
let lexbuf = Lexing.from_string string in
try Json_lex.value lexbuf
with _ -> let s = String.sub
@@ -26,7 +26,18 @@ let of_string string =
in
raise (Json_lex.unexpected s)
-let to_string json =
+let rec debug = function
+ | Null -> "Null"
+ | Int i -> "Int " ^ string_of_int i
+ | Float f -> "Float " ^ string_of_float f
+ | String s -> "String " ^ Printf.sprintf "%S" s
+ | Bool true -> "Bool true"
+ | Bool false -> "Bool false"
+ | Array l -> "Array [ " ^ String.concat " ; " (List.map debug l) ^ " ]"
+ | Object o -> "Object [ " ^ String.concat " ; "
+ (List.map (fun (k,v) -> Printf.sprintf "%S, %s" k (debug v)) o) ^ " ]"
+
+let serialize json =
let buffer = Buffer.create 1024 in
let rec value = function
| Json_type.String s -> string s
@@ -106,7 +117,7 @@ let of_opt f x = BatOption.default Null (BatOption.map f x)
let of_list f list = Array (List.map f list)
let parse_error what json =
- let string = to_string json in
+ let string = serialize json in
raise (Error (Printf.sprintf "Expected %s, found `%s`" what string))
let to_object f = function
View
@@ -14,8 +14,10 @@ exception Error of string
val to_json : t -> t
val of_json : t -> t
-val of_string : string -> t
-val to_string : t -> string
+val debug : t -> string
+
+val unserialize : string -> t
+val serialize : t -> string
val of_assoc : (string * t) list -> t
val of_int : int -> t
View
@@ -144,7 +144,7 @@ let logreq =
else function format -> Printf.ksprintf ignore format
let logjson js =
- Json.to_string js
+ Json.serialize js
let _uniq_b = ref 0
let _uniq_c = Unix.getpid ()

0 comments on commit 13f33d3

Please sign in to comment.