57 lines
1.6 KiB
Factor
57 lines
1.6 KiB
Factor
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 ;
|
|
|
|
<PRIVATE
|
|
|
|
: index-type ( type -- name )
|
|
{ { +fieldindex+ [ "field" ] }
|
|
{ +deepindex+ [ "deep" ] }
|
|
{ +compoundindex+ [ "compound" ] } } case ;
|
|
|
|
: index-name ( slot index-spec -- name )
|
|
[ first index-type ] keep
|
|
rest "-" join
|
|
"%s-%s-%s-Idx" sprintf ;
|
|
|
|
: build-index ( element slot -- assoc )
|
|
swap [ <linked-hash> ] 2dip
|
|
[ rest ] keep first ! assoc slot options itype
|
|
{ { +fieldindex+ [ drop [ 1 ] dip pick set-at ] }
|
|
{ +deepindex+ [ first "%s.%s" sprintf [ 1 ] dip pick set-at ] }
|
|
{ +compoundindex+ [
|
|
2over swap [ 1 ] 2dip set-at [ drop ] dip ! assoc options
|
|
over '[ _ [ 1 ] 2dip set-at ] each ] }
|
|
} case ;
|
|
|
|
: build-index-seq ( slot optlist -- index-seq )
|
|
[ V{ } clone ] 2dip pick ! v{} slot optl v{}
|
|
[ swap ] dip ! v{} optl slot v{ }
|
|
'[ _ tuple-index new ! element slot exemplar
|
|
2over swap index-name >>name ! element slot clone
|
|
[ build-index ] dip swap >>spec _ push
|
|
] each ;
|
|
|
|
: is-index-declaration? ( entry -- ? )
|
|
first
|
|
{ { +fieldindex+ [ t ] }
|
|
{ +compoundindex+ [ t ] }
|
|
{ +deepindex+ [ t ] }
|
|
[ drop f ] } case ;
|
|
|
|
PRIVATE>
|
|
|
|
: tuple-index-list ( mdb-collection/class -- seq )
|
|
mdb-slot-map V{ } clone tuck
|
|
'[ [ is-index-declaration? ] filter
|
|
build-index-seq _ push
|
|
] assoc-each flatten ;
|
|
|