From 5b4466161c3ced391d2453738865a694361c8a45 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 7 Jun 2009 13:33:04 -0500
Subject: [PATCH] persistency vocab completely hides db for storage

---
 extra/persistency/persistency.factor | 35 ++++++++++++++++++++++++++++
 1 file changed, 35 insertions(+)
 create mode 100644 extra/persistency/persistency.factor

diff --git a/extra/persistency/persistency.factor b/extra/persistency/persistency.factor
new file mode 100644
index 0000000000..9a4b99c457
--- /dev/null
+++ b/extra/persistency/persistency.factor
@@ -0,0 +1,35 @@
+USING: accessors arrays byte-arrays calendar classes classes.tuple
+classes.tuple.parser combinators db db.tuples db.types kernel
+math prettyprint sequences strings unicode.case urls words
+tools.continuations ;
+IN: persistency
+
+TUPLE: persistent id ;
+UNION: bool word POSTPONE: f ;
+PREDICATE: short-string < string length 100 <= ;
+: db-ize ( class -- db-class ) {
+   { bool [ BOOLEAN ] }
+   { string [ TEXT ] }
+   { short-string [ { VARCHAR 100 } ] }
+   { float [ DOUBLE ] }
+   { timestamp [ TIMESTAMP ] }
+   { fixnum [ INTEGER ] }
+   { byte-array [ BLOB ] }
+   { url [ URL ] }
+   [ drop FACTOR-BLOB ]
+} case ;
+
+: add-types ( table -- table' ) [ [ first dup >upper ] [ second db-ize ] bi 3array ] map
+{ "id" "ID" +db-assigned-id+ } prefix ;
+
+SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ define-tuple-class ]
+   [ nip [ dup unparse >upper ] [ add-types ] bi* define-persistent ] 3bi ;
+
+: define-db ( database class -- ) swap [ [ recreate-table ] with-db ] [ "database" set-word-prop ] 2bi ;
+
+: w/db ( query quot -- ) [ dup class "database" word-prop ] dip with-db ; inline
+: 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 ;
+: remove-tuples ( tuple -- ) [ delete-tuples ] w/db ;