diff --git a/bson/constants/constants.factor b/bson/constants/constants.factor index aa852bbff8..5148413b61 100644 --- a/bson/constants/constants.factor +++ b/bson/constants/constants.factor @@ -2,10 +2,8 @@ USING: accessors constructors kernel strings uuid ; IN: bson.constants -TUPLE: objid id ; - : ( -- objid ) - objid new uuid1 >>id ; inline + uuid1 ; inline TUPLE: oid { a initial: 0 } { b initial: 0 } ; diff --git a/bson/reader/reader.factor b/bson/reader/reader.factor index 595ca59544..94728b2622 100644 --- a/bson/reader/reader.factor +++ b/bson/reader/reader.factor @@ -186,11 +186,6 @@ M: bson-binary-custom element-binary-read ( size type -- dbref ) read-cstring read-cstring objref boa ; -M: bson-binary-uuid element-binary-read ( size type -- object ) - 2drop - read-cstring - objid boa ; - M: bson-binary-bytes element-binary-read ( size type -- bytes ) drop read ; diff --git a/bson/writer/writer.factor b/bson/writer/writer.factor index 441bc182de..2b1fc54537 100644 --- a/bson/writer/writer.factor +++ b/bson/writer/writer.factor @@ -77,7 +77,6 @@ M: timestamp bson-type? ( timestamp -- type ) drop T_Date ; M: mdbregexp bson-type? ( regexp -- type ) drop T_Regexp ; M: oid bson-type? ( word -- type ) drop T_OID ; -M: objid bson-type? ( objid -- type ) drop T_Binary ; M: objref bson-type? ( objref -- type ) drop T_Binary ; M: quotation bson-type? ( quotation -- type ) drop T_Binary ; M: byte-array bson-type? ( byte-array -- type ) drop T_Binary ; @@ -126,16 +125,11 @@ M: quotation bson-write ( quotation -- ) M: oid bson-write ( oid -- ) [ a>> write-longlong ] [ b>> write-int32 ] bi ; -M: objid bson-write ( oid -- ) - id>> [ binary ] dip '[ _ write-cstring ] with-byte-writer - [ length write-int32 ] keep - T_Binary_UUID write-byte write ; - M: objref bson-write ( objref -- ) [ binary ] dip '[ _ [ ns>> write-cstring ] - [ objid>> id>> write-cstring ] bi ] with-byte-writer + [ objid>> write-cstring ] bi ] with-byte-writer [ length write-int32 ] keep T_Binary_Custom write-byte write ; diff --git a/mongodb/driver/driver.factor b/mongodb/driver/driver.factor index 1853beb81f..e15fe9b679 100644 --- a/mongodb/driver/driver.factor +++ b/mongodb/driver/driver.factor @@ -195,6 +195,7 @@ MEMO: reserved-namespace? ( name -- ? ) PRIVATE> MEMO: ensure-collection ( collection -- fq-collection ) + dup mdb-collection? [ name>> ] when "." split1 over mdb name>> = [ nip ] [ drop ] if [ ] [ reserved-namespace? ] bi diff --git a/mongodb/tuple/collection/collection.factor b/mongodb/tuple/collection/collection.factor index e5dedf1967..d75e143b7b 100644 --- a/mongodb/tuple/collection/collection.factor +++ b/mongodb/tuple/collection/collection.factor @@ -1,10 +1,16 @@ USING: accessors arrays assocs bson.constants classes classes.tuple -continuations fry kernel mongodb.driver sequences +combinators continuations fry kernel mongodb.driver sequences strings vectors words ; +IN: mongodb.tuple + +SINGLETONS: +transient+ +load+ ; + IN: mongodb.tuple.collection +FROM: mongodb.tuple => +transient+ +load+ ; + MIXIN: mdb-persistent SLOT: _id @@ -14,7 +20,7 @@ TUPLE: mdb-tuple-collection < mdb-collection { classes } ; GENERIC: tuple-collection ( object -- mdb-collection ) -GENERIC: mdb-slot-list ( tuple -- string ) +GENERIC: mdb-slot-map ( tuple -- string ) over all-slots [ name>> ] map [ MDB_OID_FIELD ] dip member? [ ] [ MDB_ADDON_SLOTS prepend ] if ; inline -: set-slot-options ( class options -- ) - '[ MDB_SLOTDEF_LIST _ optl>map set-word-prop ] keep +: set-slot-map ( class options -- ) + '[ _ optl>map MDB_SLOTDEF_LIST set-word-prop ] keep dup tuple-collection link-collection ; inline M: tuple-class tuple-collection ( tuple -- mdb-collection ) @@ -69,22 +75,44 @@ M: tuple-class tuple-collection ( tuple -- mdb-collection ) M: mdb-persistent tuple-collection ( tuple -- mdb-collection ) class (mdb-collection) ; -M: mdb-persistent mdb-slot-list ( tuple -- string ) - class (mdb-slot-list) ; +M: mdb-persistent mdb-slot-map ( tuple -- string ) + class (mdb-slot-map) ; -M: tuple-class mdb-slot-list ( class -- assoc ) - (mdb-slot-list) ; +M: tuple-class mdb-slot-map ( class -- assoc ) + (mdb-slot-map) ; -M: mdb-collection mdb-slot-list ( collection -- assoc ) - classes>> [ mdb-slot-list ] map assoc-combine ; +M: mdb-collection mdb-slot-map ( collection -- assoc ) + classes>> [ mdb-slot-map ] map assoc-combine ; + + ( name -- mdb-tuple-collection ) +PRIVATE> + +GENERIC: ( name -- mdb-tuple-collection ) +M: string ( name -- mdb-tuple-collection ) collection-map [ ] [ key? ] 2bi [ at ] [ [ mdb-tuple-collection new dup ] 2dip [ [ >>name ] keep ] dip set-at ] if ; inline +M: mdb-tuple-collection ( mdb-tuple-collection -- mdb-tuple-collection ) ; +M: mdb-collection ( mdb-collection -- mdb-tuple-collection ) + [ name>> ] keep + { + [ capped>> >>capped ] + [ size>> >>size ] + [ max>> >>max ] + } cleave ; +: transient-slot? ( tuple slot -- ? ) + +transient+ slot-option? ; + +: load-slot? ( tuple slot -- ? ) + +load+ slot-option? ; diff --git a/mongodb/tuple/index/index.factor b/mongodb/tuple/index/index.factor index 466c36f719..270fecfd38 100644 --- a/mongodb/tuple/index/index.factor +++ b/mongodb/tuple/index/index.factor @@ -1,11 +1,15 @@ USING: kernel fry accessors formatting linked-assocs assocs sequences sequences.deep mongodb.tuple.collection combinators mongodb.tuple.collection ; +IN: mongodb.tuple + +SINGLETONS: +fieldindex+ +compoundindex+ +deepindex+ ; + IN: mongodb.tuple.index -TUPLE: tuple-index name spec ; +FROM: mongodb.tuple => +fieldindex+ +compoundindex+ +deepindex+ ; -SYMBOLS: +transient+ +load+ +fieldindex+ +compoundindex+ +deepindex+ ; +TUPLE: tuple-index name spec ; : tuple-index-list ( mdb-collection/class -- seq ) - mdb-slot-list V{ } clone tuck + mdb-slot-map V{ } clone tuck '[ [ is-index-declaration? ] filter build-index-seq _ push ] assoc-each flatten ; diff --git a/mongodb/tuple/persistent/persistent.factor b/mongodb/tuple/persistent/persistent.factor index 5dfb418c0d..6d5e1837a7 100644 --- a/mongodb/tuple/persistent/persistent.factor +++ b/mongodb/tuple/persistent/persistent.factor @@ -11,7 +11,6 @@ GENERIC: tuple>assoc ( tuple -- assoc ) GENERIC: tuple>selector ( tuple -- selector ) DEFER: assoc>tuple -DEFER: mdb-persistent? > ] bi ] - [ dup data-tuple? _ [ ] if ] if _ set-at ] [ drop ] if* + [ dup data-tuple? _ [ ] if ] if swap _ set-at ] [ 2drop ] if ] assoc-each ; -: prepare-assoc ( tuple -- assoc mirror assoc ) - H{ } clone tuck ; inline +: prepare-assoc ( tuple -- assoc mirror tuple assoc ) + H{ } clone swap [ ] keep pick ; inline : ensure-mdb-info ( tuple -- tuple ) dup _id>> [ >>_id ] unless diff --git a/mongodb/tuple/state/state.factor b/mongodb/tuple/state/state.factor index 1d6dde3654..e0e045e31d 100644 --- a/mongodb/tuple/state/state.factor +++ b/mongodb/tuple/state/state.factor @@ -28,17 +28,17 @@ PRIVATE> dup _mfd>> [ ] [ H{ } clone [ >>_mfd ] keep ] if* nip ; inline : dirty? ( tuple -- ? ) - MDB_DIRTY_FLAG tuple-meta at ; + MDB_DIRTY_FLAG tuple-meta at ; : set-dirty ( tuple -- ) - t MDB_DIRTY_FLAG tuple-meta set-at ; + [ t MDB_DIRTY_FLAG ] dip tuple-meta set-at ; : persistent? ( tuple -- ? ) - MDB_PERSISTENT_FLAG tuple-meta at ; + MDB_PERSISTENT_FLAG tuple-meta at ; : set-persistent ( tuple -- ) - t MDB_PERSISTENT_FLAG tuple-meta set-at ; + [ t MDB_PERSISTENT_FLAG ] dip tuple-meta set-at ; : needs-store? ( tuple -- ? ) - [ persistent? not ] [ dirty? ] bi or ; + [ persistent? not ] [ dirty? ] bi or ; diff --git a/mongodb/tuple/tuple.factor b/mongodb/tuple/tuple.factor index 9b4f462f2e..089a3ec121 100644 --- a/mongodb/tuple/tuple.factor +++ b/mongodb/tuple/tuple.factor @@ -1,28 +1,26 @@ -USING: accessors assocs classes classes.mixin classes.tuple vectors math -classes.tuple.parser formatting generalizations kernel sequences fry combinators -linked-assocs sequences.deep mongodb.driver continuations memoize bson.constants -prettyprint strings compiler.units slots tools.walker words arrays ; +USING: accessors assocs classes.mixin classes.tuple +classes.tuple.parser compiler.units fry kernel mongodb.driver +mongodb.msg mongodb.tuple.collection mongodb.tuple.index +mongodb.tuple.persistent mongodb.tuple.state sequences strings ; IN: mongodb.tuple -USING: mongodb.tuple.state mongodb.tuple.persistent mongodb.tuple.collection -mongodb.tuple.index mongodb.msg ; - SYNTAX: MDBTUPLE: parse-tuple-definition mdb-check-slots define-tuple-class ; : define-persistent ( class collection options -- ) + [ ] dip [ [ dup ] dip link-collection ] dip ! cl options [ dup '[ _ mdb-persistent add-mixin-instance ] with-compilation-unit ] dip - set-slot-options ; + set-slot-map ; : ensure-table ( class -- ) tuple-collection [ create-collection ] [ [ tuple-index-list ] keep - '[ _ swap [ name>> ] [ spec>> ] bi ensure-index ] each + '[ _ name>> swap [ name>> ] [ spec>> ] bi ensure-index ] each ] bi ; : ensure-tables ( classes -- ) @@ -31,7 +29,7 @@ SYNTAX: MDBTUPLE: : drop-table ( class -- ) tuple-collection [ [ tuple-index-list ] keep - '[ _ swap name>> drop-index ] each ] + '[ _ name>> swap name>> drop-index ] each ] [ name>> drop-collection ] bi ; : recreate-table ( class -- ) @@ -41,19 +39,19 @@ SYNTAX: MDBTUPLE: > id-selector ; + _id>> id-selector ; : (save-tuples) ( collection assoc -- ) swap '[ [ _ ] 2dip [ id-selector ] dip - update ] assoc-each ; inline + >upsert update ] assoc-each ; inline PRIVATE> : save-tuple ( tuple -- ) - tuple>assoc [ (save-tuples) ] assoc-each ; + tuple>storable [ (save-tuples) ] assoc-each ; : update-tuple ( tuple -- ) save-tuple ;