extra/persistency/persistency.factor

   1 USING: accessors arrays byte-arrays calendar classes classes.tuple
   2 classes.tuple.parser combinators db db.tuples db.types kernel
   3 math sequences strings unicode.case urls words ;
   4 IN: persistency
   5
   6 TUPLE: persistent id ;
   7
   8 : add-types ( table -- table' ) [ dup array? [ [ first dup >upper ] [ second ] bi 3array ]
   9         [ dup >upper FACTOR-BLOB 3array ] if
  10     ] map { "id" "ID" +db-assigned-id+ } prefix ;
  11
  12 : remove-types ( table -- table' ) [ dup array? [ first ] when ] map ;
  13
  14 SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ remove-types define-tuple-class ]
  15    [ nip [ dup name>> >upper ] [ add-types ] bi* define-persistent ] 3bi ;
  16
  17 : define-db ( database class -- ) swap [ [ ensure-table ] with-db ] [ "database" set-word-prop ] 2bi ;
  18
  19 : query>tuple ( tuple/query -- tuple ) dup query? [ tuple>> ] when ;
  20 : w/db ( query quot -- ) [ dup query>tuple class "database" word-prop ] dip with-db ; inline
  21 : get-tuples ( query -- tuples ) [ select-tuples ] w/db ;
  22 : get-tuple ( query -- tuple ) [ select-tuple ] w/db ;
  23 : store-tuple ( tuple -- ) [ insert-tuple ] w/db ;
  24 : modify-tuple ( tuple -- ) [ update-tuple ] w/db ;
  25 : remove-tuples ( tuple -- ) [ delete-tuples ] w/db ;