2009-08-05 17:45:22 -04:00
|
|
|
USING: accessors arrays byte-arrays calendar classes
|
|
|
|
classes.tuple classes.tuple.parser combinators db db.queries
|
|
|
|
db.tuples db.types kernel math nmake parser sequences strings
|
|
|
|
strings.parser unicode.case urls words ;
|
2009-06-07 14:33:04 -04:00
|
|
|
IN: persistency
|
|
|
|
|
|
|
|
TUPLE: persistent id ;
|
2009-06-07 18:03:32 -04:00
|
|
|
|
2009-06-16 15:36:01 -04:00
|
|
|
: add-types ( table -- table' ) [ dup array? [ [ first dup >upper ] [ second ] bi 3array ]
|
|
|
|
[ dup >upper FACTOR-BLOB 3array ] if
|
|
|
|
] map { "id" "ID" +db-assigned-id+ } prefix ;
|
2009-06-07 14:33:04 -04:00
|
|
|
|
2009-06-16 15:36:01 -04:00
|
|
|
: remove-types ( table -- table' ) [ dup array? [ first ] when ] map ;
|
|
|
|
|
|
|
|
SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ remove-types define-tuple-class ]
|
2009-07-27 22:44:18 -04:00
|
|
|
[ nip [ dup name>> >upper ] [ add-types ] bi* define-persistent ] 3bi ;
|
2009-06-07 14:33:04 -04:00
|
|
|
|
2009-06-10 17:15:02 -04:00
|
|
|
: define-db ( database class -- ) swap [ [ ensure-table ] with-db ] [ "database" set-word-prop ] 2bi ;
|
2009-06-07 14:33:04 -04:00
|
|
|
|
2009-06-07 19:42:20 -04:00
|
|
|
: query>tuple ( tuple/query -- tuple ) dup query? [ tuple>> ] when ;
|
2011-10-24 20:00:09 -04:00
|
|
|
: w/db ( query quot -- ) [ dup query>tuple class-of "database" word-prop ] dip with-db ; inline
|
2009-06-07 14:33:04 -04:00
|
|
|
: get-tuples ( query -- tuples ) [ select-tuples ] w/db ;
|
|
|
|
: get-tuple ( query -- tuple ) [ select-tuple ] w/db ;
|
|
|
|
: store-tuple ( tuple -- ) [ insert-tuple ] w/db ;
|
|
|
|
: modify-tuple ( tuple -- ) [ update-tuple ] w/db ;
|
2009-08-05 17:45:22 -04:00
|
|
|
: remove-tuples ( tuple -- ) [ delete-tuples ] w/db ;
|
|
|
|
|
|
|
|
TUPLE: pattern value ; C: <pattern> pattern
|
2009-10-28 14:38:27 -04:00
|
|
|
SYNTAX: %" parse-string <pattern> suffix! ;
|
2009-08-05 17:45:22 -04:00
|
|
|
M: pattern where value>> over column-name>> 0% " LIKE " 0% bind# ;
|