Browse files

[fix] runtime, mongo: Added field encoding/decoding for maps

  • Loading branch information...
1 parent c65e357 commit 764d33d72a317abf7ac6056f6987746c3db118b1 @BourgerieQuentin BourgerieQuentin committed Apr 17, 2012
Showing with 47 additions and 31 deletions.
  1. +20 −11 opabsl/mlbsl/bslMongo.ml
  2. +27 −20 stdlib/apis/mongo/bson.opa
View
31 opabsl/mlbsl/bslMongo.ml
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -427,28 +427,28 @@ let read_mongo conn timeout mailbox k =
let export_reply (b,s,l) = Buf.sub b s l
##register reply_messageLength : Mongo.reply -> int
-let reply_messageLength = Mongo.reply_messageLength
+let reply_messageLength = Mongo.reply_messageLength
##register reply_requestId : Mongo.reply -> int
-let reply_requestId = Mongo.reply_requestId
+let reply_requestId = Mongo.reply_requestId
##register reply_responseTo : Mongo.reply -> int
-let reply_responseTo = Mongo.reply_responseTo
+let reply_responseTo = Mongo.reply_responseTo
##register reply_opCode : Mongo.reply -> int
-let reply_opCode = Mongo.reply_opCode
+let reply_opCode = Mongo.reply_opCode
##register reply_responseFlags : Mongo.reply -> int
-let reply_responseFlags = Mongo.reply_responseFlags
+let reply_responseFlags = Mongo.reply_responseFlags
##register reply_cursorID : Mongo.reply -> Mongo.cursorID
-let reply_cursorID = Mongo.reply_cursorID
+let reply_cursorID = Mongo.reply_cursorID
##register reply_startingFrom : Mongo.reply -> int
-let reply_startingFrom = Mongo.reply_startingFrom
+let reply_startingFrom = Mongo.reply_startingFrom
##register reply_numberReturned : Mongo.reply -> int
-let reply_numberReturned = Mongo.reply_numberReturned
+let reply_numberReturned = Mongo.reply_numberReturned
##register reply_document : Mongo.reply, int -> option(Bson.document)
let reply_document (b,s,l) n =
@@ -472,12 +472,21 @@ let string_of_cursorID cid = Printf.sprintf "%016Lx" cid
let is_null_cursorID cid = ServerLib.wrap_bool (cid = 0L)
##register mongo_buf_requestId : Mongo.mongo_buf -> int
-let mongo_buf_requestId = Mongo.mongo_buf_requestId
+let mongo_buf_requestId = Mongo.mongo_buf_requestId
##register mongo_buf_refresh_requestId : Mongo.mongo_buf -> void
let mongo_buf_refresh_requestId m = Mongo.mongo_buf_refresh_requestId m (nextrid())
##register mongo_buf_responseTo : Mongo.mongo_buf -> int
-let mongo_buf_responseTo = Mongo.mongo_buf_responseTo
+let mongo_buf_responseTo = Mongo.mongo_buf_responseTo
+
+##register encode_field : string -> string
+let encode_field field =
+ Encodings.pc_encode_string
+ (function '.' | '$' -> false | _ -> true)
+ field
+
+##register decode_field : string -> string
+let decode_field = Encodings.pc_decode_string
##endmodule
View
47 stdlib/apis/mongo/bson.opa
@@ -696,7 +696,9 @@ Bson = {{
map_to_bson(key:string, v:'a, kty:OpaType.ty, dty:OpaType.ty): Bson.document =
doc = List.flatten(Map.fold((k, v, acc ->
- (doc = opa_to_document(OpaValue.to_string_with_type(kty, k), v, dty)
+ k = OpaValue.to_string_with_type(kty, k)
+ k = %%BslMongo.Mongo.encode_field%%(k)
+ (doc = opa_to_document(k, v, dty)
((doc +> acc):list(Bson.document)))), @unsafe_cast(v), []))
[H.doc(key,doc)]
@@ -853,24 +855,28 @@ Bson = {{
match (elements, fields) with
| ([element|erest],[field|frest]) ->
name = Bson.key(element)
+ next() =
+ match OpaValue.Record.field_of_name(name) with
+ | {none} -> error("Missing field {name}", (acc, true))
+ | {some=backfield} ->
+ default = Option.map(OpaValue.Record.unsafe_dot(_, backfield), default)
+ val_opt =
+ (match element with
+ | {value={Document=doc} ...} -> bson_to_opa_aux(doc, field.ty, default)
+ | _ -> element_to_opa(element, field.ty, default))
+ match val_opt with
+ | {none} ->
+ error("Failed with field {name}, document {to_pretty(doc)} and type {OpaType.to_pretty(field.ty)}", (acc, true))
+ | {some=value} -> aux(erest,frest,[(backfield,value)|acc])
+ end
+ end
(match String.ordering(field.label,name) with
- | {eq} ->
- match OpaValue.Record.field_of_name(name) with
- | {none} -> error("Missing field {name}", (acc, true))
- | {some=backfield} ->
- default = Option.map(OpaValue.Record.unsafe_dot(_, backfield), default)
- val_opt =
- (match element with
- | {value={Document=doc} ...} -> bson_to_opa_aux(doc, field.ty, default)
- | _ -> element_to_opa(element, field.ty, default))
- match val_opt with
- | {none} ->
- error("Failed with field {name}, document {to_pretty(doc)} and type {OpaType.to_pretty(field.ty)}", (acc, true))
- | {some=value} -> aux(erest,frest,[(backfield,value)|acc])
- end
- end
- | {lt} -> optreg(name, field, frest, [element|erest], acc)
- | {gt} -> (acc, true))
+ | {eq} -> next()
+ | _ ->
+ match String.ordering(field.label, %%BslMongo.Mongo.decode_field%%(name))
+ | {eq} -> next()
+ | {lt} -> optreg(name, field, frest, [element|erest], acc)
+ | {gt} -> (acc, true))
| ([],[]) -> (acc,false)
| ([],[field|frest]) -> optreg("absent field", field, frest, [], acc)
| (_erest,_frest) -> (acc,true)
@@ -1014,12 +1020,13 @@ Bson = {{
| {none} ->
fatal("Failed for map element {element} type {OpaType.to_pretty(dty)}")
| {some=v} ->
- match OpaSerialize.unserialize(element.name, kty) with
+ elname = %%BslMongo.Mongo.decode_field%%(element.name)
+ match OpaSerialize.unserialize(elname, kty) with
| {none} -> fatal("Failed for map key {element.name} type {kty}")
| {some = k} -> Map.add(k, v, im))
, doc, Map.empty)
{some=@unsafe_cast(imap)}
- | element -> error("expected map, got {element}", none)//element_to_opa(element, OpaType.implementation(ty), none))
+ | element -> error("expected map, got {element}", element_to_opa(element, OpaType.implementation(ty), none))
)
| {TyName_args=[]; TyName_ident="Date.date"} ->
(match element with

0 comments on commit 764d33d

Please sign in to comment.