Browse files

[cleanup] stdlib: Partial tidy of MongoDb.opa, split off collection.opa.

  • Loading branch information...
1 parent cea0ee3 commit 8dc2b1a9fded2a1d83f19b84331411292cc30283 @nrs135 nrs135 committed Nov 8, 2011
Showing with 528 additions and 289 deletions.
  1. +37 −289 stdlib/apis/mongo/MongoDb.opa
  2. +491 −0 stdlib/apis/mongo/collection.opa
View
326 stdlib/apis/mongo/MongoDb.opa
@@ -16,8 +16,6 @@
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*/
-import stdlib.core.{compare}
-
/**
*
* Firstly, as an aside, note that we could very easily implement a MongoDB backend
@@ -127,270 +125,6 @@ import stdlib.core.{compare}
* in the same collection.
**/
-/*
- * Collection {{ ... }}:
- *
- * Implements the collection type presented to the user and also the target
- * for the new db syntax. I would have preferred "Set" to "Collection"
- * because it would have been easier to type but that name is already occupied
- * in the namespace.
- *
- * Essentially, this datatype is simply a "typed" view of the low-level MongoDB
- * driver routines. The currency here is OPA values, not BSON documents hence
- * we need to give a type to the collection.
- *
- * Helper modules are Batch{{}} which allows building a list of documents for
- * batch insert and Fields{{}} which is used to define field select documents.
- *
- **/
-
-@abstract type batch = list(Bson.document)
-
-Batch = {{
- empty = ([]:batch)
- add(b:batch, v:'a): batch = [Bson.opa2doc(v)|b]
- one(v:'a): batch = [Bson.opa2doc(v)]
- add2(b:batch, (v1:'a, v2:'b)): batch = [Bson.opa2doc(v1)|[Bson.opa2doc(v2)|b]]
- two(v1:'a, v2:'b): batch = [Bson.opa2doc(v1)|[Bson.opa2doc(v2)]]
- add3(b:batch, (v1:'a, v2:'b, v3:'c)): batch = [Bson.opa2doc(v1)|[Bson.opa2doc(v2)|[Bson.opa2doc(v3)|b]]]
- three(v1:'a, v2:'b, v3:'c): batch = [Bson.opa2doc(v1)|[Bson.opa2doc(v2)|[Bson.opa2doc(v3)]]]
- list(b:batch, vs:list('a)): batch = List.flatten([List.map(Bson.opa2doc,vs),b])
- of_list(vs:list('a)) = list(empty,vs)
- merge(b1:batch, b2:batch): batch = List.flatten([b1, b2])
-}}
-
-@abstract type fields = Bson.document
-
-Fields = {{
- @private ML = MongoLog
- @private H = Bson.Abbrevs
- empty = ([]:fields)
- add(f:fields, name:string, incexc:Bson.int32): fields = [H.i32(name,incexc)|f]
- one(name:string, incexc:Bson.int32): fields = [H.i32(name,incexc)]
- list(f:fields, fs:list((string,Bson.int32))): fields = List.flatten([List.map(((n,ie) -> H.i32(n,ie)),fs),f])
- of_list(fs:list((string,Bson.int32))) = list(empty,fs)
- merge(f1:fields, f2:fields): fields = List.flatten([f1, f2])
- validate(fields:fields): bool =
- (zeros, ones, others) = List.fold((e, (z, o, g) ->
- if e.name == "_id"
- then (z,o,g)
- else
- match Bson.int_of_element(e) with
- | {some=0} -> (z+1,o,g)
- | {some=1} -> (z,o+1,g)
- | {some=_} | {none} -> (z,o,g+1)),
- fields,(0,0,0))
- if zeros > 0 && ones > 0
- then ML.warning("Fields.validate","Can't mix include and exclude fields {Bson.to_pretty(fields)}",false)
- else if others > 0
- then ML.warning("Fields.validate","Can only use 0 and 1 in fields {Bson.to_pretty(fields)}",false)
- else true
-}}
-
-type collection('a) = {
- db: Mongo.mongodb;
- ty: OpaType.ty; // type of the collection
-}
-
-type view('a,'b) = {
- coll: collection('a);
- vty: OpaType.ty; // type of the view collection
- is_opa: bool; // if true, we assume an OPA type and ignore incomplete documents
-}
-
-type foreign('a,'b,'c,'d,'e) = {
- primary: view('a,'b); // the parent view
- foreign: view('c,'d); // the foreign view
- pkey: string;
- fkey: string;
-}
-
-type collection_cursor('a) = {
- collection: collection('a);
- cursor: Mongo.cursor;
- query: Mongo.select('a);
- ty: OpaType.ty;
- ignore_incomplete: bool;
-}
-
-type group('a) = { retval:list('a); count:int; keys:int; ok:int }
-type group_result('a) = outcome(group('a),Mongo.failure)
-
-Collection = {{
-
- @private H = Bson.Abbrevs
-
- create(db:Mongo.mongodb): collection('value) = { db=MongoConnection.clone(db); ty=@typeval('value); }
-
- destroy(c:collection('value)): void = MongoConnection.close(c.db)
-
- skip(c:collection('value), skip:int): collection('value) = {c with db={ c.db with ~skip }}
- limit(c:collection('value), limit:int): collection('value) = {c with db={ c.db with ~limit }}
- fields(c:collection('value), fields:option(Bson.document)): collection('value) = {c with db={ c.db with ~fields }}
- orderby(c:collection('value), orderby:option(Bson.document)): collection('value) = {c with db={ c.db with ~orderby }}
-
- continueOnError(c:collection('value)): collection('value) =
- {c with db={ c.db with insert_flags=Bitwise.lor(c.db.insert_flags,MongoDriver.ContinueOnErrorBit) }}
- upsert(c:collection('value)): collection('value)
- = {c with db={ c.db with update_flags=Bitwise.lor(c.db.update_flags,MongoDriver.UpsertBit) }}
- multiUpdate(c:collection('value)): collection('value)
- = {c with db={ c.db with update_flags=Bitwise.lor(c.db.update_flags,MongoDriver.MultiUpdateBit) }}
- singleRemove(c:collection('value)): collection('value)
- = {c with db={ c.db with delete_flags=Bitwise.lor(c.db.delete_flags,MongoDriver.SingleRemoveBit) }}
- tailableCursor(c:collection('value)): collection('value)
- = {c with db={ c.db with query_flags=Bitwise.lor(c.db.query_flags,MongoDriver.TailableCursorBit) }}
- slaveOk(c:collection('value)): collection('value)
- = {c with db={ c.db with query_flags=Bitwise.lor(c.db.query_flags,MongoDriver.SlaveOkBit) }}
- oplogReplay(c:collection('value)): collection('value)
- = {c with db={ c.db with query_flags=Bitwise.lor(c.db.query_flags,MongoDriver.OplogReplayBit) }}
- noCursorTimeout(c:collection('value)): collection('value)
- = {c with db={ c.db with query_flags=Bitwise.lor(c.db.query_flags,MongoDriver.NoCursorTimeoutBit) }}
- awaitData(c:collection('value)): collection('value)
- = {c with db={ c.db with query_flags=Bitwise.lor(c.db.query_flags,MongoDriver.AwaitDataBit) }}
- exhaust(c:collection('value)): collection('value)
- = {c with db={ c.db with query_flags=Bitwise.lor(c.db.query_flags,MongoDriver.ExhaustBit) }}
- partial(c:collection('value)): collection('value)
- = {c with db={ c.db with query_flags=Bitwise.lor(c.db.query_flags,MongoDriver.PartialBit) }}
-
- insert(c:collection('value), v:'value): bool =
- ns = c.db.dbname^"."^c.db.collection
- b = Bson.opa_to_bson(v,{some=@typeval('value)})
- MongoDriver.insert(c.db.mongo,c.db.insert_flags,ns,b)
-
- insert_batch(c:collection('value), b:batch): bool =
- ns = c.db.dbname^"."^c.db.collection
- MongoDriver.insert_batch(c.db.mongo,c.db.insert_flags,ns,b)
-
- update(c:collection('value), select:Mongo.select('value), update:Mongo.update('value)): bool =
- ns = c.db.dbname^"."^c.db.collection
- MongoDriver.update(c.db.mongo,c.db.update_flags,ns,select,update)
-
- delete(c:collection('value), select:Mongo.select('value)): bool =
- ns = c.db.dbname^"."^c.db.collection
- MongoDriver.delete(c.db.mongo,c.db.delete_flags,ns,select)
-
- find_one_doc(c:collection('value), select:Mongo.select('value)): Mongo.result =
- ns = c.db.dbname^"."^c.db.collection
- MongoCursor.find_one(c.db.mongo,ns,select,c.db.fields,c.db.orderby)
-
- find_one_unsafe(c:collection('value), select:Mongo.select('value), ignore_incomplete:bool): outcome('result,Mongo.failure) =
- ns = c.db.dbname^"."^c.db.collection
- (match MongoCursor.find_one(c.db.mongo,ns,select,c.db.fields,c.db.orderby) with
- | {success=doc} ->
- (match Bson.b2o_incomplete(doc, @typeval('result), ignore_incomplete) with
- | {found=v} -> {success=(Magic.id(v):'result)}
- | {not_found} -> {failure={Error="Collection.find_one: not found"}}
- | {incomplete} -> {failure={Incomplete}})
- | {~failure} -> {~failure})
-
- find_one(c:collection('value), select:Mongo.select('value)): outcome('value,Mongo.failure) =
- find_one_unsafe(c, select, false)
-
- query_unsafe(c:collection('value), select:Mongo.select('value), ignore_incomplete:bool)
- : outcome(collection_cursor('result),Mongo.failure) =
- ns = c.db.dbname^"."^c.db.collection
- //do println("query_unsafe:\n'value={OpaType.to_pretty(@typeval('value))}\n'result={OpaType.to_pretty(@typeval('result))}")
- match MongoCursor.find(c.db.mongo,ns,select,c.db.fields,c.db.orderby,c.db.limit,c.db.skip,c.db.query_flags) with
- | {success=cursor} ->
- {success={collection=@unsafe_cast(c); ~cursor; query=@unsafe_cast(select); ty=@typeval('result); ~ignore_incomplete}}
- | {~failure} -> {~failure}
-
- query(c:collection('value), select:Mongo.select('value)): outcome(collection_cursor('value),Mongo.failure) =
- query_unsafe(c, select, false)
-
- first(cc:collection_cursor('value)): outcome(collection_cursor('value),Mongo.failure) =
- _ = MongoCursor.reset(cc.cursor)
- query(cc.collection, cc.query)
-
- next(cc:collection_cursor('value)): (collection_cursor('value),outcome('value,Mongo.failure)) =
- cursor = MongoCursor.next(cc.cursor)
- match MongoCursor.check_cursor_error(cursor) with
- | {success=doc} ->
- //do println("next:\n doc={Bson.to_pretty(doc)}\n ty={OpaType.to_pretty(cc.ty)}")
- (match Bson.b2o_incomplete(doc, cc.ty, cc.ignore_incomplete) with
- | {found=v} -> ({cc with ~cursor},{success=(Magic.id(v):'value)})
- | {not_found} -> ({cc with ~cursor},{failure={Error="Collection.next: not found"}})
- | {incomplete} -> ({cc with ~cursor},{failure={Incomplete}}))
- | {~failure} ->
- cursor = MongoCursor.reset(cursor)
- ({cc with ~cursor},{~failure})
-
- has_more(cc:collection_cursor('value)): bool = MongoCursor.valid(cc.cursor)
-
- find_all_unsafe(c:collection('value), select:Mongo.select('value), ignore_incomplete:bool): outcome(list('result),Mongo.failure) =
- //do println("find_all:\n 'value={OpaType.to_pretty(@typeval('value))}\n 'result={OpaType.to_pretty(@typeval('result))}")
- match (query_unsafe(c,select,ignore_incomplete): outcome(collection_cursor('result),Mongo.failure)) with
- | {success=cc} ->
- (cc,l) =
- while((cc,{success=[]}),
- ((cc,l) ->
- match l with
- | {success=l} ->
- (match next(cc) with
- | (cc,{success=v}) ->
- //do println(" v={(v:'result)}")
- ((cc,{success=[Magic.id(v):'result|l]}),has_more(cc))
- | (cc,{failure={Incomplete}}) -> ((cc,{success=l}),has_more(cc))
- | (cc,{~failure}) ->
- //do println(" err(query)={MongoDriver.string_of_failure(failure)}")
- ((cc,{~failure}),false))
- | {~failure} -> ((cc,{~failure}),false)))
- _ = kill(cc)
- l
- | {~failure} -> {~failure}
-
- find_all(c:collection('value), select:Mongo.select('value)): outcome(list('value),Mongo.failure) =
- find_all_unsafe(c, select, false)
-
- count(c:collection('value), query_opt:option(Mongo.select('value))): outcome(int,Mongo.failure) =
- MongoCommands.count(c.db.mongo, c.db.dbname, c.db.collection, (Option.map((s -> s),query_opt)))
-
- distinct(c:collection('value), key:string, query_opt:option(Mongo.select('value))): outcome(list('b),Mongo.failure) =
- match MongoCommands.distinct(c.db.mongo, c.db.dbname, c.db.collection, key, (Option.map((s -> s),query_opt))) with
- | {success=doc} ->
- // possibly: get the type from 'value and get the key type out of there???
- ty = {TyName_args=[@typeval('b)]; TyName_ident="list"}
- (match Bson.bson_to_opa(doc, ty) with
- | {some=v} -> {success=(Magic.id(v):list('b))}
- | {none} -> {failure={Error="Collection.distinct: not found"}})
- | {~failure} -> {~failure}
-
- /**
- * Note that for group to work ints have to match, Int32 will not match Int64!!!
- **/
- group(c:collection('value), key:Bson.document, reduce:string, initial:Bson.document,
- cond_opt:option(Bson.document), finalize_opt:option(string)): Mongo.result =
- MongoCommands.group(c.db.mongo, c.db.dbname, c.db.collection, key, reduce, initial, cond_opt, finalize_opt)
-
- // TODO: use Command types and doc2opa
- analyze_group(res:Mongo.result): group_result('a) =
- match res with
- | {success=doc} ->
- (match Bson.find(doc,"retval") with
- | {some=[{name=k; value={Array=arr}}]} ->
- ty = {TyName_args=[@typeval('a)]; TyName_ident="list"}
- (match Bson.bson_to_opa([H.arr(k,List.rev(arr))], ty) with
- | {some=v} ->
- retval = (Magic.id(v):list('a))
- (match Bson.find_int(doc, "count") with
- | {some=count} ->
- (match Bson.find_int(doc, "keys") with
- | {some=keys} ->
- (match Bson.find_int(doc, "ok") with
- | {some=ok} ->
- {success=~{retval; count; keys; ok}}
- | {none} -> {failure={Error="Collection.analyze_group: ok not found"}})
- | {none} -> {failure={Error="Collection.analyze_group: keys not found"}})
- | {none} -> {failure={Error="Collection.analyze_group: count not found"}})
- | {none} -> {failure={Error="Collection.analyze_group: retval not found"}})
- | _ -> {failure={Error="Collection.analyze_group: no retval value in reply"}})
- | {~failure} -> {~failure}
-
- // TODO: map-reduce
-
- kill(cc:collection_cursor('value)): collection_cursor('value) = { cc with cursor=MongoCursor.reset(cc.cursor) }
-
-}}
/**
* View {{ ... }}:
@@ -400,30 +134,44 @@ Collection = {{
* type-safety at compile time but we do insert runtime type-checks into the
* view, both at creation time and at query time. If you are 100% sure that your
* types are correct, you can eliminate the run-time type-check by simply using
- * the Collection module "unsafe" operations.
+ * the MongoCollection module "unsafe" operations.
*
* The fields are selected by building a [fields] value using the Fields module.
* The result has to be cast to the return type which is derived from the collection
* type with the required fields included/excluded and turned into Bson.register values,
* for example, collection type {a:int; b:string} and field selector {b:1} results in
* the result type: {b:Bson.register(string)}. This is checked at runtime. Once the
* view has been created, you simply substitute the View query functions for the
- * Collection functions.
+ * MongoCollection functions.
*
* Note that we are obliged to turn all the fields into Bson.register types because
* MongoDB will return a record with missing fields for documents which match the query
* but which do not have all of the fields selected.
*
**/
+
+type view('a,'b) = {
+ coll: Mongo.collection('a);
+ vty: OpaType.ty; // type of the view collection
+ is_opa: bool; // if true, we assume an OPA type and ignore incomplete documents
+}
+
+type foreign('a,'b,'c,'d,'e) = {
+ primary: view('a,'b); // the parent view
+ foreign: view('c,'d); // the foreign view
+ pkey: string;
+ fkey: string;
+}
+
View = {{
@private ML = MongoLog
@private make_reg(fld) = {fld with ty={TyName_args=[fld.ty]; TyName_ident="Bson.register"}}
@private
- type_from_fields(pty:OpaType.ty, fields:fields): OpaType.ty =
- if not(Fields.validate(fields))
+ type_from_fields(pty:OpaType.ty, fields:Mongo.fields): OpaType.ty =
+ if not(MongoCollection.Fields.validate(fields))
then ML.fatal("View.type_from_fields","Fields failed to validate",-1)
else
tst =
@@ -442,21 +190,21 @@ View = {{
then ML.fatal(from,"{msg} {OpaType.to_pretty(ty1)} and {OpaType.to_pretty(ty2)}",-1)
else void
- create(c:collection('collection), vfields:fields, is_opa:bool): view('collection,'view) =
- coll = Collection.fields(c, {some=vfields})
+ create(c:Mongo.collection('collection), vfields:Mongo.fields, is_opa:bool): view('collection,'view) =
+ coll = MongoCollection.fields(c, {some=vfields})
pty = @typeval('collection)
- do verify_type_match(pty, coll.ty, "Collection.view","Attempt to create view from non-matching parent type")
+ do verify_type_match(pty, coll.ty, "View.create","Attempt to create view from non-matching parent type")
fvty = type_from_fields(pty, vfields)
vty = if is_opa then fvty else MongoTypeSelect.map_field(fvty, make_reg)
cvty = @typeval('view)
//do println("pty={OpaType.to_pretty(pty)}")
//do println("fvty={OpaType.to_pretty(fvty)}")
//do println("vty={OpaType.to_pretty(vty)}")
//do println("cvty={OpaType.to_pretty(cvty)}")
- do verify_type_match(vty, cvty, "Collection.view","Attempt to create view with incompatible view types")
+ do verify_type_match(vty, cvty, "View.create","Attempt to create view with incompatible view types")
{ ~coll; ~vty; ~is_opa; }
- of_collection(c:collection('collection), is_opa:bool): view('collection,'collection) = { coll=c; vty=c.ty; ~is_opa; }
+ of_collection(c:Mongo.collection('collection), is_opa:bool): view('collection,'collection) = { coll=c; vty=c.ty; ~is_opa; }
@private
runtime_view_type_check(v:view('value,'view), from:string): void =
@@ -466,15 +214,15 @@ View = {{
find_one(v:view('value,'view), select:Mongo.select('value)): outcome('view,Mongo.failure) =
do runtime_view_type_check(v, "View.find_one")
- Collection.find_one_unsafe(v.coll, select, v.is_opa)
+ MongoCollection.find_one_unsafe(v.coll, select, v.is_opa)
- query(v:view('value,'view), select:Mongo.select('value)): outcome(collection_cursor('view),Mongo.failure) =
+ query(v:view('value,'view), select:Mongo.select('value)): outcome(Mongo.collection_cursor('view),Mongo.failure) =
do runtime_view_type_check(v, "View.query")
- Collection.query_unsafe(v.coll, select, v.is_opa)
+ MongoCollection.query_unsafe(v.coll, select, v.is_opa)
find_all(v:view('value,'view), select:Mongo.select('value)): outcome(list('view),Mongo.failure) =
do runtime_view_type_check(v, "View.find_all")
- Collection.find_all_unsafe(v.coll, select, v.is_opa)
+ MongoCollection.find_all_unsafe(v.coll, select, v.is_opa)
}}
@@ -497,15 +245,15 @@ Foreign = {{
{ ~primary; ~foreign; ~pkey; ~fkey }
find_one(f:foreign('ps,'pr,'fs,'fr,'view), select:Mongo.select('ps)): outcome('view,Mongo.failure) =
- match Collection.find_one_doc(f.primary.coll, select) with
+ match MongoCollection.find_one_doc(f.primary.coll, select) with
| {success=pdoc} ->
(match Bson.bson_to_opa(pdoc, @typeval('pr)) with
| {some=pv} ->
pv = (Magic.id(pv):'pr)
(match Bson.dot_element(pdoc,f.pkey) with
| {some=e} ->
//do println("Foreign.find_one: e={Bson.to_pretty([e])}")
- (match Collection.find_one_doc(f.foreign.coll, ([{e with name=f.fkey}]:Mongo.select('fr))) with
+ (match MongoCollection.find_one_doc(f.foreign.coll, ([{e with name=f.fkey}]:Mongo.select('fr))) with
| {success=fdoc} ->
//do println("Foreign.find_one: fdoc={Bson.to_pretty(fdoc)}")
(match Bson.bson_to_opa(fdoc, @typeval('fr)) with
@@ -529,7 +277,7 @@ UtilsDb = {{
* last error is really the last error, using eg. findAndModify).
**/
@private
- safe_(c:collection('value),f:'a->bool,a:'a,msg:string): bool =
+ safe_(c:Mongo.collection('value),f:'a->bool,a:'a,msg:string): bool =
if not(f(a))
then (do println("{msg}: Fatal error message not sent to server") false)
else
@@ -540,10 +288,10 @@ UtilsDb = {{
| {some=err} -> do println("{msg}: {err}") false)
| {~failure} -> do println("{msg}: fatal error {MongoDriver.string_of_failure(failure)}") false)
- safe_insert(c,v) = safe_(c,((c,v) -> Collection.insert(c,v)),(c,v),"Collection.insert")
- safe_insert_batch(c,b) = safe_(c,((c,b) -> Collection.insert_batch(c,b)),(c,b),"Collection.insert_batch")
- safe_update(c,s,v) = safe_(c,((c,s,v) -> Collection.update(c,s,v)),(c,s,v),"Collection.update")
- safe_delete(c,s) = safe_(c,((c,s) -> Collection.delete(c,s)),(c,s),"Collection.delete")
+ safe_insert(c,v) = safe_(c,((c,v) -> MongoCollection.insert(c,v)),(c,v),"Collection.insert")
+ safe_insert_batch(c,b) = safe_(c,((c,b) -> MongoCollection.insert_batch(c,b)),(c,b),"Collection.insert_batch")
+ safe_update(c,s,v) = safe_(c,((c,s,v) -> MongoCollection.update(c,s,v)),(c,s,v),"Collection.update")
+ safe_delete(c,s) = safe_(c,((c,s) -> MongoCollection.delete(c,s)),(c,s),"Collection.delete")
// It's easier to deal with options
find_result_to_opt(result) : option('a) =
@@ -557,11 +305,11 @@ UtilsDb = {{
| {success=v} -> v
| _ -> []
- find(c,r) = find_result_to_opt(Collection.find_one(c,MongoSelect.unsafe_make(r)))
- find_all(c,r) = find_all_result_to_list(Collection.find_all(c,MongoSelect.unsafe_make(r)))
+ find(c,r) = find_result_to_opt(MongoCollection.find_one(c,MongoSelect.unsafe_make(r)))
+ find_all(c,r) = find_all_result_to_list(MongoCollection.find_all(c,MongoSelect.unsafe_make(r)))
// Delete by id by default
- delete(c,id) = Collection.delete(c,MongoSelect.unsafe_make({_id = id}))
+ delete(c,id) = MongoCollection.delete(c,MongoSelect.unsafe_make({_id = id}))
}}
View
491 stdlib/apis/mongo/collection.opa
@@ -0,0 +1,491 @@
+/*
+ Copyright © 2011 MLstate
+
+ This file is part of OPA.
+
+ OPA is free software: you can redistribute it and/or modify it under the
+ terms of the GNU Affero General Public License, version 3, as published by
+ the Free Software Foundation.
+
+ OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+ more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*/
+
+/**
+ * MongoDB binding for OPA.
+ *
+ * @destination public
+ * @stabilization work in progress
+ **/
+
+/**
+ * {1 About this module}
+ *
+ * Module [MongoCollection] is an intermediate-level module providing a layer
+ * of type-safety for the MongoDB driver low-level code.
+ *
+ * It implements the [Mongo.collection] type and it is also the target
+ * for the new db syntax.
+ *
+ * Essentially, this datatype is simply a "typed" view of the low-level MongoDB
+ * driver routines. The currency here is OPA values, not BSON documents hence
+ * we need to give a type to the collection.
+ *
+ * To use this module you need to construct [Mongo.select] and [Mongo.update]
+ * values for queries and updates. These are provided by the [MongoSelect]
+ * and [MongoUpdate] modules, respectively. These provide additional safety
+ * checks over and above the runtime type-checking provided by this module.
+ *
+ * Helper modules are [Batch] which allows building a list of documents for
+ * batch insert and [Fields] which is used to define field select documents.
+ *
+ * {1 Where should I start?}
+ *
+ * {1 What if I need more?}
+ *
+ **/
+
+/**
+ * The [Mongo.batch] type is used to build up lists
+ * of documents for [insert_batch].
+ **/
+@abstract type Mongo.batch('a) = list(Bson.document)
+
+/**
+ * The [Mongo.fields] type is used to create field select
+ * documents. These should be used in conjunction with the
+ * [MongoView] module.
+ **/
+@abstract type Mongo.fields = Bson.document
+
+/**
+ * The main collection type. Just contains the [Mongo.mongodb]
+ * connection object plus the (run-time) type of the collection.
+ * The type is itself parametrised by the collection type but
+ * this has to be cast by the user to the type of the collection.
+ * {b Warning: If this type incorrectly cast then serious problems
+ * will result. SegFaults will be the least of your worries.}
+ **/
+@abstract
+type Mongo.collection('a) = {
+ db: Mongo.mongodb;
+ ty: OpaType.ty; // type of the collection
+}
+
+/**
+ * The type of a cursor associated with a collection.
+ * This is also parametrised and cast as for the parent
+ * collection type. It contains the collection and the cursor plus some
+ * additional information which enables run-time type checks upon
+ * data as it is received from the MongoDB server.
+ **/
+@abstract
+type Mongo.collection_cursor('a) = {
+ collection: Mongo.collection('a);
+ cursor: Mongo.cursor;
+ query: Mongo.select('a);
+ ty: OpaType.ty;
+ ignore_incomplete: bool;
+}
+
+/**
+ * The [Mongo.group_result] type is used by the [MongoCollection.group] command.
+ **/
+type Mongo.group('a) = { retval:list('a); count:int; keys:int; ok:int }
+type Mongo.group_result('a) = outcome(Mongo.group('a),Mongo.failure)
+
+MongoCollection = {{
+
+ @private ML = MongoLog
+ @private H = Bson.Abbrevs
+
+ /**
+ * Module [Batch] allows the management of a list of [Bson.document] values for
+ * the [MongoCollection.insert_batch] command.
+ **/
+ Batch = {{
+ empty() = ([]:Mongo.batch('a))
+ add(b:Mongo.batch('a), v:'a): Mongo.batch('a) = [Bson.opa2doc(v)|b]
+ one(v:'a): Mongo.batch('a) = [Bson.opa2doc(v)]
+ add2(b:Mongo.batch('a), (v1:'a, v2:'a)): Mongo.batch('a) = [Bson.opa2doc(v1)|[Bson.opa2doc(v2)|b]]
+ two(v1:'a, v2:'a): Mongo.batch('a) = [Bson.opa2doc(v1)|[Bson.opa2doc(v2)]]
+ add3(b:Mongo.batch('a), (v1:'a, v2:'a, v3:'a)): Mongo.batch('a) = [Bson.opa2doc(v1)|[Bson.opa2doc(v2)|[Bson.opa2doc(v3)|b]]]
+ three(v1:'a, v2:'a, v3:'a): Mongo.batch('a) = [Bson.opa2doc(v1)|[Bson.opa2doc(v2)|[Bson.opa2doc(v3)]]]
+ list(b:Mongo.batch('a), vs:list('a)): Mongo.batch('a) = List.flatten([List.map(Bson.opa2doc,vs),b])
+ of_list(vs:list('a)): Mongo.batch('a) = list(empty(),vs)
+ merge(b1:Mongo.batch('a), b2:Mongo.batch('a)): Mongo.batch('a) = List.flatten([b1, b2])
+ }}
+
+ /**
+ * Module [Fields] allows the construction and verification of field select documents.
+ *
+ * In [Bson.document] format, the field select is just a list of field names (possibly
+ * in "dot" format) of value "0" or "1" for exclusion or inclusion of the field. Note that
+ * you can't mix included and excluded fields.
+ *
+ * The [Mongo.fields] type is just a synonym for [Bson.document] but the [validate]
+ * function here encapsulates the restrictions indicated above.
+ **/
+ Fields = {{
+ empty = ([]:Mongo.fields)
+ add(f:Mongo.fields, name:string, incexc:Bson.int32): Mongo.fields = [H.i32(name,incexc)|f]
+ one(name:string, incexc:Bson.int32): Mongo.fields = [H.i32(name,incexc)]
+ list(f:Mongo.fields, fs:list((string,Bson.int32))): Mongo.fields = List.flatten([List.map(((n,ie) -> H.i32(n,ie)),fs),f])
+ of_list(fs:list((string,Bson.int32))) = list(empty,fs)
+ merge(f1:Mongo.fields, f2:Mongo.fields): Mongo.fields = List.flatten([f1, f2])
+ validate(fields:Mongo.fields): bool =
+ (zeros, ones, others) = List.fold((e, (z, o, g) ->
+ if e.name == "_id"
+ then (z,o,g)
+ else
+ match Bson.int_of_element(e) with
+ | {some=0} -> (z+1,o,g)
+ | {some=1} -> (z,o+1,g)
+ | {some=_} | {none} -> (z,o,g+1)),
+ fields,(0,0,0))
+ if zeros > 0 && ones > 0
+ then ML.warning("Fields.validate","Can't mix include and exclude fields {Bson.to_pretty(fields)}",false)
+ else if others > 0
+ then ML.warning("Fields.validate","Can only use 0 and 1 in fields {Bson.to_pretty(fields)}",false)
+ else true
+ }}
+
+ /**
+ * Create a collection from a [Mongo.mongodb] connection. The type of the connection
+ * is remembered here and used to check the types of values returned from the MongoDB server.
+ * Note, however, that we clone the connection so that we will be using the same connection
+ * to the server as the parent connection. For concurrent access to collections you should
+ * have a fresh connection for each thread.
+ **/
+ create(db:Mongo.mongodb): Mongo.collection('value) = { db=MongoConnection.clone(db); ty=@typeval('value); }
+
+ /**
+ * Destroy a collection. Actually just close the cloned connection.
+ **/
+ destroy(c:Mongo.collection('value)): void = MongoConnection.close(c.db)
+
+ /**
+ * We adopt a functional view of the collection so that we can set various
+ * parameters in separate copies of the connection. This allows both globally
+ * setting these parameters by setting them when the collection is created or
+ * locally by updating them when a collection operation is performed.
+ **/
+
+ /** Set the "skip" number in the collection. **/
+ skip(c:Mongo.collection('value), skip:int): Mongo.collection('value) =
+ {c with db={ c.db with ~skip }}
+
+ /** Set the "limit" number in the collection. **/
+ limit(c:Mongo.collection('value), limit:int): Mongo.collection('value) =
+ {c with db={ c.db with ~limit }}
+
+ /** Set the "fields" parameter in the collection. This is a low-level field select
+ * document, care should be taken with it's use since you need to cast the
+ * collection type manually to match the fields which will be returned.
+ * Use the [MongoView] module for greater type safety.
+ **/
+ fields(c:Mongo.collection('value), fields:option(Bson.document)): Mongo.collection('value) =
+ {c with db={ c.db with ~fields }}
+
+ /** Set the "orderby" document in the collection. **/
+ orderby(c:Mongo.collection('value), orderby:option(Bson.document)): Mongo.collection('value) =
+ {c with db={ c.db with ~orderby }}
+
+ /** Set the "continueOnError" flag for all [insert] calls. **/
+ continueOnError(c:Mongo.collection('value)): Mongo.collection('value) =
+ {c with db={ c.db with insert_flags=Bitwise.lor(c.db.insert_flags,MongoDriver.ContinueOnErrorBit) }}
+
+ /** Set the "Upsert" flag for all [update] calls. **/
+ upsert(c:Mongo.collection('value)): Mongo.collection('value)
+ = {c with db={ c.db with update_flags=Bitwise.lor(c.db.update_flags,MongoDriver.UpsertBit) }}
+
+ /** Set the "multiUpdate" flag for all [update] calls. **/
+ multiUpdate(c:Mongo.collection('value)): Mongo.collection('value)
+ = {c with db={ c.db with update_flags=Bitwise.lor(c.db.update_flags,MongoDriver.MultiUpdateBit) }}
+
+ /** Set the "singleRemove" flag for all [delete] calls. **/
+ singleRemove(c:Mongo.collection('value)): Mongo.collection('value)
+ = {c with db={ c.db with delete_flags=Bitwise.lor(c.db.delete_flags,MongoDriver.SingleRemoveBit) }}
+
+ /** Set the "tailableCursor" flag for all [query] calls. **/
+ tailableCursor(c:Mongo.collection('value)): Mongo.collection('value)
+ = {c with db={ c.db with query_flags=Bitwise.lor(c.db.query_flags,MongoDriver.TailableCursorBit) }}
+
+ /** Set the "slaveOk" flag for all [query] calls. **/
+ slaveOk(c:Mongo.collection('value)): Mongo.collection('value)
+ = {c with db={ c.db with query_flags=Bitwise.lor(c.db.query_flags,MongoDriver.SlaveOkBit) }}
+
+ /** Set the "oplogReplay" flag for all [query] calls. **/
+ oplogReplay(c:Mongo.collection('value)): Mongo.collection('value)
+ = {c with db={ c.db with query_flags=Bitwise.lor(c.db.query_flags,MongoDriver.OplogReplayBit) }}
+
+ /** Set the "noCursorTimeout" flag for all [query] calls. **/
+ noCursorTimeout(c:Mongo.collection('value)): Mongo.collection('value)
+ = {c with db={ c.db with query_flags=Bitwise.lor(c.db.query_flags,MongoDriver.NoCursorTimeoutBit) }}
+
+ /** Set the "awaitData" flag for all [query] calls. **/
+ awaitData(c:Mongo.collection('value)): Mongo.collection('value)
+ = {c with db={ c.db with query_flags=Bitwise.lor(c.db.query_flags,MongoDriver.AwaitDataBit) }}
+
+ /** Set the "exhaust" flag for all [query] calls. **/
+ exhaust(c:Mongo.collection('value)): Mongo.collection('value)
+ = {c with db={ c.db with query_flags=Bitwise.lor(c.db.query_flags,MongoDriver.ExhaustBit) }}
+
+ /** Set the "partial" flag for all [query] calls. **/
+ partial(c:Mongo.collection('value)): Mongo.collection('value)
+ = {c with db={ c.db with query_flags=Bitwise.lor(c.db.query_flags,MongoDriver.PartialBit) }}
+
+ /**
+ * Insert an OPA value into a collection.
+ **/
+ insert(c:Mongo.collection('value), v:'value): bool =
+ ns = c.db.dbname^"."^c.db.collection
+ b = Bson.opa_to_bson(v,{some=@typeval('value)})
+ MongoDriver.insert(c.db.mongo,c.db.insert_flags,ns,b)
+
+ /**
+ * Batch insert, you need to build the batch using the [Batch] module.
+ **/
+ insert_batch(c:Mongo.collection('value), b:Mongo.batch('value)): bool =
+ ns = c.db.dbname^"."^c.db.collection
+ MongoDriver.insert_batch(c.db.mongo,c.db.insert_flags,ns,b)
+
+ /**
+ * Update a value in a collection.
+ *
+ * Example: [update(c, select, update)]
+ *
+ * The [select] and [update] parameters should be built by the [MongoSelect]
+ * and [MongoUpdate] modules and cast to the type of the collection.
+ * Doing it this way allows a run-time type check to be performed on
+ * the [select] and [update] values. Suitability for either select or update
+ * is also enforced.
+ **/
+ update(c:Mongo.collection('value), select:Mongo.select('value), update:Mongo.update('value)): bool =
+ ns = c.db.dbname^"."^c.db.collection
+ MongoDriver.update(c.db.mongo,c.db.update_flags,ns,select,update)
+
+ /**
+ * Delete values in a collection according to a select value.
+ **/
+ delete(c:Mongo.collection('value), select:Mongo.select('value)): bool =
+ ns = c.db.dbname^"."^c.db.collection
+ MongoDriver.delete(c.db.mongo,c.db.delete_flags,ns,select)
+
+ /**
+ * Return the [Bson.document] representation of a single value selected from
+ * a collection. This might facilitate more efficient handling of values
+ * rather than converting to an OPA type.
+ **/
+ find_one_doc(c:Mongo.collection('value), select:Mongo.select('value)): Mongo.result =
+ ns = c.db.dbname^"."^c.db.collection
+ MongoCursor.find_one(c.db.mongo,ns,select,c.db.fields,c.db.orderby)
+
+ /**
+ * Find a single collection value according to a select value but allow the type
+ * of the value to be different from the collection type.
+ *
+ * This effectively short-circuits the static type-check on the return value
+ * but is essential for cases where the return type is different, for example
+ * the "$explain" data and [View.view] operations.
+ *
+ * Example: [find_one_unsafe(c, select, ignore_incomplete)]
+ *
+ * @param [ignore_incomplete] if [true] will cause any documents selected
+ * which do not have all of the fields defined in the result type to be
+ * filtered out. Since this finds a single value, if it has missing fields
+ * it will be flagged as not found.
+ * @return The return outcome [failure] type includes the [\{Incomplete\}]
+ * value. If [ignore_incomplete] is [false] and fields are missing, then
+ * this specific failure is returned.
+ **/
+ find_one_unsafe(c:Mongo.collection('value), select:Mongo.select('value), ignore_incomplete:bool)
+ : outcome('result,Mongo.failure) =
+ ns = c.db.dbname^"."^c.db.collection
+ (match MongoCursor.find_one(c.db.mongo,ns,select,c.db.fields,c.db.orderby) with
+ | {success=doc} ->
+ (match Bson.b2o_incomplete(doc, @typeval('result), ignore_incomplete) with
+ | {found=v} -> {success=(Magic.id(v):'result)}
+ | {not_found} -> {failure={Error="MongoCollection.find_one: not found"}}
+ | {incomplete} -> {failure={Incomplete}})
+ | {~failure} -> {~failure})
+
+ /**
+ * A safer version of [find_one_unsafe]. The return type must match the collection type
+ * and [ignore_incomplete] will always be [false].
+ **/
+ find_one(c:Mongo.collection('value), select:Mongo.select('value)): outcome('value,Mongo.failure) =
+ find_one_unsafe(c, select, false)
+
+ /**
+ * Perform a fully-parametrised query (from the parameters in the collection) and cast any
+ * returned values to the return type specified here.
+ *
+ * @param [ignore_incomplete] as for [find_one_unsafe].
+ * @return A [Mongo.collection_cursor] type which retains all of the parameters
+ * used in the query. The [MongoCollection.next] function will always return
+ * values according to the parameters at this query call.
+ **/
+ query_unsafe(c:Mongo.collection('value), select:Mongo.select('value), ignore_incomplete:bool)
+ : outcome(Mongo.collection_cursor('result),Mongo.failure) =
+ ns = c.db.dbname^"."^c.db.collection
+ match MongoCursor.find(c.db.mongo,ns,select,c.db.fields,c.db.orderby,c.db.limit,c.db.skip,c.db.query_flags) with
+ | {success=cursor} ->
+ {success={collection=@unsafe_cast(c); ~cursor; query=@unsafe_cast(select); ty=@typeval('result); ~ignore_incomplete}}
+ | {~failure} -> {~failure}
+
+ /**
+ * The safer version of "query_unsafe".
+ **/
+ query(c:Mongo.collection('value), select:Mongo.select('value)): outcome(Mongo.collection_cursor('value),Mongo.failure) =
+ query_unsafe(c, select, false)
+
+ /**
+ * Reset the cursor and re-issue the original query.
+ **/
+ first(cc:Mongo.collection_cursor('value)): outcome(Mongo.collection_cursor('value),Mongo.failure) =
+ _ = MongoCursor.reset(cc.cursor)
+ query(cc.collection, cc.query)
+
+ /**
+ * Return the next value from a [Mongo.collection_cursor].
+ * The values are always returned according to the original [query] or [query_unsafe] call.
+ *
+ * {b Warning: [Mongo.collection_cursor] values are functional values, you have to retain the
+ * modified cursor if you want the cursor to correctly track the MongoDB server cursor.}
+ **/
+ next(cc:Mongo.collection_cursor('value)): (Mongo.collection_cursor('value),outcome('value,Mongo.failure)) =
+ cursor = MongoCursor.next(cc.cursor)
+ match MongoCursor.check_cursor_error(cursor) with
+ | {success=doc} ->
+ (match Bson.b2o_incomplete(doc, cc.ty, cc.ignore_incomplete) with
+ | {found=v} -> ({cc with ~cursor},{success=(Magic.id(v):'value)})
+ | {not_found} -> ({cc with ~cursor},{failure={Error="MongoCollection.next: not found"}})
+ | {incomplete} -> ({cc with ~cursor},{failure={Incomplete}}))
+ | {~failure} ->
+ cursor = MongoCursor.reset(cursor)
+ ({cc with ~cursor},{~failure})
+
+ /**
+ * Test if there is more data in a cursor.
+ **/
+ has_more(cc:Mongo.collection_cursor('value)): bool = MongoCursor.valid(cc.cursor)
+
+ /**
+ * Create a [Mongo.collection_cursor], scan in all the selected values according to
+ * the select provided here and return a list of valid values according to the result
+ * type. Incomplete values are filtered out according to [ignore_incomplete]. The
+ * cursor is killed once the operation is complete. Remember you can use the "skip"
+ * and "limit" functions to control which values are returned out of the list of possible
+ * values.
+ **/
+ find_all_unsafe(c:Mongo.collection('value), select:Mongo.select('value), ignore_incomplete:bool)
+ : outcome(list('result),Mongo.failure) =
+ match (query_unsafe(c,select,ignore_incomplete): outcome(Mongo.collection_cursor('result),Mongo.failure)) with
+ | {success=cc} ->
+ (cc,l) =
+ while((cc,{success=[]}),
+ ((cc,l) ->
+ match l with
+ | {success=l} ->
+ (match next(cc) with
+ | (cc,{success=v}) -> ((cc,{success=[Magic.id(v):'result|l]}),has_more(cc))
+ | (cc,{failure={Incomplete}}) -> ((cc,{success=l}),has_more(cc))
+ | (cc,{~failure}) -> ((cc,{~failure}),false))
+ | {~failure} -> ((cc,{~failure}),false)))
+ _ = kill(cc)
+ l
+ | {~failure} -> {~failure}
+
+ /**
+ * Safer version of [find_all_unsafe].
+ **/
+ find_all(c:Mongo.collection('value), select:Mongo.select('value)): outcome(list('value),Mongo.failure) =
+ find_all_unsafe(c, select, false)
+
+ /**
+ * Count the number of documents matching the given optional select value (\{none\} means
+ * count all documents.
+ **/
+ count(c:Mongo.collection('value), select_opt:option(Mongo.select('value))): outcome(int,Mongo.failure) =
+ MongoCommands.count(c.db.mongo, c.db.dbname, c.db.collection, (Option.map((s -> s),select_opt)))
+
+ /**
+ * List the distinct values matching the optional select.
+ * Example: [distinct(c, key, select_opt)]
+ * @return The return type must be cast to a list of the type of the field indicated
+ * by the [key] parameter.
+ **/
+ distinct(c:Mongo.collection('value), key:string, select_opt:option(Mongo.select('value))): outcome(list('b),Mongo.failure) =
+ match MongoCommands.distinct(c.db.mongo, c.db.dbname, c.db.collection, key, (Option.map((s -> s),select_opt))) with
+ | {success=doc} ->
+ // possibly: get the type from 'value and get the key type out of there???
+ ty = {TyName_args=[@typeval('b)]; TyName_ident="list"}
+ (match Bson.bson_to_opa(doc, ty) with
+ | {some=v} -> {success=(Magic.id(v):list('b))}
+ | {none} -> {failure={Error="MongoCollection.distinct: not found"}})
+ | {~failure} -> {~failure}
+
+ /**
+ * Perform a MongoDB "group" operation.
+ * Here we just perform the group command and return the resulting [Mongo.result] value.
+ * Use the [analyze_group] function to extract the results, unless you wish to scan
+ * the result as a [Bson.document] value.
+ *
+ * Example: [group(c, key, reduce, initial, cond_opt, finalize_opt)]
+ *
+ * The parameters are as for the MongoDB documentation, for example, [reduce] is a
+ * Javascript function as a string, converted to BSON Code for the function call.
+ * Don't forget to escape the curly brackets in the Javascript strings.
+ *
+ * Note that for group to work ints have to match, Int32 will not match Int64!!!
+ **/
+ group(c:Mongo.collection('value), key:Bson.document, reduce:string, initial:Bson.document,
+ cond_opt:option(Bson.document), finalize_opt:option(string)): Mongo.result =
+ MongoCommands.group(c.db.mongo, c.db.dbname, c.db.collection, key, reduce, initial, cond_opt, finalize_opt)
+
+ /**
+ * Analyze the result of a [group] call. The result is returned as a [Mongo.group_result]
+ * value but this time, you have to cast the type parameter to the type of the field of the [key],
+ * but with the field [\{count:float\}] added.
+ **/
+ // TODO: use Command types and doc2opa
+ analyze_group(res:Mongo.result): Mongo.group_result('a) =
+ match res with
+ | {success=doc} ->
+ (match Bson.find(doc,"retval") with
+ | {some=[{name=k; value={Array=arr}}]} ->
+ ty = {TyName_args=[@typeval('a)]; TyName_ident="list"}
+ (match Bson.bson_to_opa([H.arr(k,List.rev(arr))], ty) with
+ | {some=v} ->
+ retval = (Magic.id(v):list('a))
+ (match Bson.find_int(doc, "count") with
+ | {some=count} ->
+ (match Bson.find_int(doc, "keys") with
+ | {some=keys} ->
+ (match Bson.find_int(doc, "ok") with
+ | {some=ok} ->
+ {success=~{retval; count; keys; ok}}
+ | {none} -> {failure={Error="MongoCollection.analyze_group: ok not found"}})
+ | {none} -> {failure={Error="MongoCollection.analyze_group: keys not found"}})
+ | {none} -> {failure={Error="MongoCollection.analyze_group: count not found"}})
+ | {none} -> {failure={Error="MongoCollection.analyze_group: retval not found"}})
+ | _ -> {failure={Error="MongoCollection.analyze_group: no retval value in reply"}})
+ | {~failure} -> {~failure}
+
+ // TODO: map-reduce
+
+ /**
+ * Kill a [Mongo.collection_cursor] value.
+ **/
+ kill(cc:Mongo.collection_cursor('value)): Mongo.collection_cursor('value) =
+ { cc with cursor=MongoCursor.reset(cc.cursor) }
+
+}}
+
+// End of file collection.opa

0 comments on commit 8dc2b1a

Please sign in to comment.