lose the bad codez in sqlite
change the db api to more-rows? and advance-row instead of just advance-row sql-command takes a string or a seq of strings postgresql create-sql handles native/assigned idsdb4
Doug Coleman
parent
d666b62b1b
commit
def53a07d8
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays assocs classes continuations kernel math
|
||||
namespaces sequences sequences.lib tuples words ;
|
||||
namespaces sequences sequences.lib tuples words strings ;
|
||||
IN: db
|
||||
|
||||
TUPLE: db handle insert-statements update-statements delete-statements select-statements ;
|
||||
|
|
@ -37,14 +37,14 @@ GENERIC: prepare-statement ( statement -- )
|
|||
GENERIC: bind-statement* ( obj statement -- )
|
||||
GENERIC: reset-statement ( statement -- )
|
||||
GENERIC: insert-statement ( statement -- id )
|
||||
HOOK: last-id db ( res -- id )
|
||||
|
||||
TUPLE: result-set sql params handle n max ;
|
||||
GENERIC: query-results ( query -- result-set )
|
||||
GENERIC: #rows ( result-set -- n )
|
||||
GENERIC: #columns ( result-set -- n )
|
||||
GENERIC# row-column 1 ( result-set n -- obj )
|
||||
GENERIC: advance-row ( result-set -- ? )
|
||||
GENERIC: advance-row ( result-set -- )
|
||||
GENERIC: more-rows? ( result-set -- ? )
|
||||
|
||||
: execute-statement ( statement -- ) query-results dispose ;
|
||||
|
||||
|
|
@ -56,7 +56,7 @@ GENERIC: advance-row ( result-set -- ? )
|
|||
|
||||
: init-result-set ( result-set -- )
|
||||
dup #rows over set-result-set-max
|
||||
-1 swap set-result-set-n ;
|
||||
0 swap set-result-set-n ;
|
||||
|
||||
: <result-set> ( query handle tuple -- result-set )
|
||||
>r >r { statement-sql statement-params } get-slots r>
|
||||
|
|
@ -70,10 +70,10 @@ GENERIC: advance-row ( result-set -- ? )
|
|||
dup #columns [ row-column ] with map ;
|
||||
|
||||
: query-each ( statement quot -- )
|
||||
over advance-row [
|
||||
2drop
|
||||
over more-rows? [
|
||||
[ call ] 2keep over advance-row query-each
|
||||
] [
|
||||
[ call ] 2keep query-each
|
||||
2drop
|
||||
] if ; inline
|
||||
|
||||
: query-map ( statement quot -- seq )
|
||||
|
|
@ -94,11 +94,6 @@ GENERIC: advance-row ( result-set -- ? )
|
|||
: do-bound-command ( obj query -- )
|
||||
[ bind-statement ] keep execute-statement ;
|
||||
|
||||
: sql-query ( sql -- rows )
|
||||
<simple-statement> [ do-query ] with-disposal ;
|
||||
|
||||
: sql-command ( sql -- )
|
||||
<simple-statement> [ execute-statement ] with-disposal ;
|
||||
|
||||
SYMBOL: in-transaction
|
||||
HOOK: begin-transaction db ( -- )
|
||||
|
|
@ -112,3 +107,13 @@ HOOK: rollback-transaction db ( -- )
|
|||
begin-transaction
|
||||
[ ] [ rollback-transaction ] cleanup commit-transaction
|
||||
] with-variable ;
|
||||
|
||||
: sql-query ( sql -- rows )
|
||||
<simple-statement> [ do-query ] with-disposal ;
|
||||
|
||||
: sql-command ( sql -- )
|
||||
dup string? [
|
||||
<simple-statement> [ execute-statement ] with-disposal
|
||||
] [
|
||||
[ [ sql-command ] each ] with-transaction
|
||||
] if ;
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: arrays assocs alien alien.syntax continuations io
|
||||
kernel math math.parser namespaces prettyprint quotations
|
||||
sequences debugger db db.postgresql.lib db.postgresql.ffi
|
||||
db.tuples db.types tools.annotations ;
|
||||
db.tuples db.types tools.annotations math.ranges ;
|
||||
IN: db.postgresql
|
||||
|
||||
TUPLE: postgresql-db host port pgopts pgtty db user pass ;
|
||||
|
|
@ -52,14 +52,8 @@ M: postgresql-result-set #columns ( result-set -- n )
|
|||
M: postgresql-result-set row-column ( result-set n -- obj )
|
||||
>r dup result-set-handle swap result-set-n r> PQgetvalue ;
|
||||
|
||||
M: postgresql-statement execute-statement ( statement -- obj )
|
||||
query-results dispose ;
|
||||
|
||||
M: postgresql-statement insert-statement ( statement -- id )
|
||||
query-results dispose ;
|
||||
|
||||
: increment-n ( result-set -- n )
|
||||
dup result-set-n 1+ dup rot set-result-set-n ;
|
||||
query-results [ break 0 row-column ] with-disposal ;
|
||||
|
||||
M: postgresql-statement query-results ( query -- result-set )
|
||||
dup statement-params [
|
||||
|
|
@ -71,8 +65,11 @@ M: postgresql-statement query-results ( query -- result-set )
|
|||
postgresql-result-set <result-set>
|
||||
dup init-result-set ;
|
||||
|
||||
M: postgresql-result-set advance-row ( result-set -- ? )
|
||||
dup increment-n swap result-set-max >= ;
|
||||
M: postgresql-result-set advance-row ( result-set -- )
|
||||
dup result-set-n 1+ swap set-result-set-n ;
|
||||
|
||||
M: postgresql-result-set more-rows? ( result-set -- ? )
|
||||
dup result-set-n swap result-set-max < ;
|
||||
|
||||
M: postgresql-statement dispose ( query -- )
|
||||
dup statement-handle PQclear
|
||||
|
|
@ -108,15 +105,6 @@ M: postgresql-db commit-transaction ( -- )
|
|||
M: postgresql-db rollback-transaction ( -- )
|
||||
"ROLLBACK" sql-command ;
|
||||
|
||||
SYMBOL: postgresql-counter
|
||||
|
||||
: make-postgresql-counter ( quot -- )
|
||||
[ postgresql-counter off ] swap compose "" make ;
|
||||
|
||||
: counter% ( -- )
|
||||
CHAR: $ ,
|
||||
postgresql-counter [ inc ] keep get # ;
|
||||
|
||||
: postgresql-type-hash* ( -- assoc )
|
||||
H{
|
||||
{ SERIAL "serial" }
|
||||
|
|
@ -156,16 +144,9 @@ M: postgresql-db >sql-type ( hash obj -- str )
|
|||
] unless
|
||||
] if ;
|
||||
|
||||
M: postgresql-db create-sql ( columns table -- sql )
|
||||
: insert-function ( columns table -- sql )
|
||||
[
|
||||
2dup
|
||||
"create table " % %
|
||||
" (" % [ ", " % ] [
|
||||
dup second % " " %
|
||||
dup third >sql-type* % " " %
|
||||
sql-modifiers " " join %
|
||||
] interleave "); " %
|
||||
|
||||
>r remove-id r>
|
||||
"create function add_" % dup %
|
||||
"(" %
|
||||
over [ "," % ]
|
||||
|
|
@ -179,33 +160,52 @@ M: postgresql-db create-sql ( columns table -- sql )
|
|||
dup [ ", " % ] [ second % ] interleave
|
||||
") " %
|
||||
" values (" %
|
||||
[ ", " % ] [ drop counter% ] interleave
|
||||
length [1,b] [ ", " % ] [ "$" % # ] interleave
|
||||
"); " %
|
||||
|
||||
"select currval(''" % % "_id_seq'');' language sql;" %
|
||||
drop
|
||||
] make-postgresql-counter dup . ;
|
||||
] "" make ;
|
||||
|
||||
M: postgresql-db drop-sql ( columns table -- sql )
|
||||
: drop-function ( columns table -- sql )
|
||||
[
|
||||
dup "drop table " % %
|
||||
"; drop function add_" % %
|
||||
>r remove-id r>
|
||||
"drop function add_" % %
|
||||
"(" %
|
||||
[ "," % ] [ third >sql-type % ] interleave
|
||||
")" %
|
||||
|
||||
] "" make ;
|
||||
|
||||
! \ create-sql reset
|
||||
! \ create-sql watch
|
||||
M: postgresql-db create-sql ( columns table -- seq )
|
||||
[
|
||||
[
|
||||
2dup
|
||||
"create table " % %
|
||||
" (" % [ ", " % ] [
|
||||
dup second % " " %
|
||||
dup third >sql-type* % " " %
|
||||
sql-modifiers " " join %
|
||||
] interleave "); " %
|
||||
] "" make ,
|
||||
|
||||
over native-id? [ insert-function , ] [ 2drop ] if
|
||||
] { } make ;
|
||||
|
||||
M: postgresql-db drop-sql ( columns table -- seq )
|
||||
[
|
||||
[
|
||||
dup "drop table " % % ";" %
|
||||
] "" make ,
|
||||
over native-id? [ drop-function , ] [ 2drop ] if
|
||||
] { } make ;
|
||||
|
||||
M: postgresql-db insert-sql* ( columns table -- sql )
|
||||
[
|
||||
"select add_" % %
|
||||
"(" %
|
||||
[ ", " % ] [ counter% ] interleave
|
||||
length [1,b] [ ", " % ] [ "$" % # ] interleave
|
||||
")" %
|
||||
] make-postgresql-counter ;
|
||||
] "" make ;
|
||||
|
||||
M: postgresql-db update-sql* ( columns table -- sql )
|
||||
[
|
||||
|
|
@ -213,18 +213,19 @@ M: postgresql-db update-sql* ( columns table -- sql )
|
|||
%
|
||||
" set " %
|
||||
dup remove-id
|
||||
[ ", " % ] [ second % " = " % counter% ] interleave
|
||||
dup length [1,b] swap 2array flip
|
||||
[ ", " % ] [ first2 second % " = $" % # ] interleave
|
||||
" where " %
|
||||
[ primary-key? ] find nip second dup % " = " % counter%
|
||||
] make-postgresql-counter ;
|
||||
[ primary-key? ] find nip second dup % " = $" % length 2 + #
|
||||
] "" make ;
|
||||
|
||||
M: postgresql-db delete-sql* ( columns table -- sql )
|
||||
[
|
||||
"delete from " %
|
||||
%
|
||||
" where " %
|
||||
first second dup % " = " % counter%
|
||||
] make-postgresql-counter ;
|
||||
first second % " = $1" %
|
||||
] "" make ;
|
||||
|
||||
M: postgresql-db select-sql* ( columns table -- sql )
|
||||
drop ;
|
||||
|
|
|
|||
|
|
@ -100,13 +100,13 @@ IN: db.sqlite.lib
|
|||
: sqlite-row ( handle -- seq )
|
||||
dup sqlite-#columns [ sqlite-column ] with map ;
|
||||
|
||||
: step-complete? ( step-result -- bool )
|
||||
: sqlite-step-has-more-rows? ( step-result -- bool )
|
||||
dup SQLITE_ROW = [
|
||||
drop f
|
||||
drop t
|
||||
] [
|
||||
dup SQLITE_DONE =
|
||||
[ drop ] [ sqlite-check-result ] if t
|
||||
[ drop ] [ sqlite-check-result ] if f
|
||||
] if ;
|
||||
|
||||
: sqlite-next ( prepared -- ? )
|
||||
sqlite3_step step-complete? ;
|
||||
sqlite3_step sqlite-step-has-more-rows? ;
|
||||
|
|
|
|||
|
|
@ -25,9 +25,7 @@ M: sqlite-db dispose ( db -- ) dispose-db ;
|
|||
TUPLE: sqlite-statement ;
|
||||
C: <sqlite-statement> sqlite-statement
|
||||
|
||||
TUPLE: sqlite-result-set advanced? ;
|
||||
: <sqlite-result-set> ( query -- sqlite-result-set )
|
||||
dup statement-handle sqlite-result-set <result-set> ;
|
||||
TUPLE: sqlite-result-set has-more? ;
|
||||
|
||||
M: sqlite-db <simple-statement> ( str -- obj )
|
||||
<prepared-statement> ;
|
||||
|
|
@ -40,13 +38,7 @@ M: sqlite-db <prepared-statement> ( str -- obj )
|
|||
M: sqlite-statement dispose ( statement -- )
|
||||
statement-handle sqlite-finalize ;
|
||||
|
||||
: maybe-advance-row ( result-set -- result-set )
|
||||
dup sqlite-result-set-advanced? [
|
||||
dup advance-row drop
|
||||
] unless ;
|
||||
|
||||
M: sqlite-result-set dispose ( result-set -- )
|
||||
maybe-advance-row
|
||||
f swap set-result-set-handle ;
|
||||
|
||||
: sqlite-bind ( triples handle -- )
|
||||
|
|
@ -58,8 +50,12 @@ M: sqlite-statement bind-statement* ( triples statement -- )
|
|||
M: sqlite-statement reset-statement ( statement -- )
|
||||
statement-handle sqlite-reset ;
|
||||
|
||||
: last-insert-id ( -- id )
|
||||
db get db-handle sqlite3_last_insert_rowid
|
||||
dup zero? [ "last-id failed" throw ] when ;
|
||||
|
||||
M: sqlite-statement insert-statement ( statement -- id )
|
||||
query-results [ last-id ] with-disposal ;
|
||||
execute-statement last-insert-id ;
|
||||
|
||||
M: sqlite-result-set #columns ( result-set -- n )
|
||||
result-set-handle sqlite-#columns ;
|
||||
|
|
@ -67,12 +63,16 @@ M: sqlite-result-set #columns ( result-set -- n )
|
|||
M: sqlite-result-set row-column ( result-set n -- obj )
|
||||
>r result-set-handle r> sqlite-column ;
|
||||
|
||||
M: sqlite-result-set advance-row ( result-set -- handle ? )
|
||||
M: sqlite-result-set advance-row ( result-set -- )
|
||||
[ result-set-handle sqlite-next ] keep
|
||||
t swap set-sqlite-result-set-advanced? ;
|
||||
set-sqlite-result-set-has-more? ;
|
||||
|
||||
M: sqlite-result-set more-rows? ( result-set -- ? )
|
||||
sqlite-result-set-has-more? ;
|
||||
|
||||
M: sqlite-statement query-results ( query -- result-set )
|
||||
dup statement-handle sqlite-result-set <result-set> ;
|
||||
dup statement-handle sqlite-result-set <result-set>
|
||||
dup advance-row ;
|
||||
|
||||
M: sqlite-db begin-transaction ( -- )
|
||||
"BEGIN" sql-command ;
|
||||
|
|
@ -145,11 +145,6 @@ M: sqlite-db tuple>params ( columns tuple -- obj )
|
|||
dupd >r first r> get-slot-named swap
|
||||
third 3array
|
||||
] curry map ;
|
||||
|
||||
M: sqlite-db last-id ( result-set -- id )
|
||||
maybe-advance-row drop
|
||||
db get db-handle sqlite3_last_insert_rowid
|
||||
dup zero? [ "last-id failed" throw ] when ;
|
||||
|
||||
: sqlite-db-modifiers ( -- hashtable )
|
||||
H{
|
||||
|
|
|
|||
|
|
@ -30,7 +30,8 @@ SYMBOL: the-person
|
|||
|
||||
[ ] [ the-person get update-tuple ] unit-test
|
||||
|
||||
[ ] [ the-person get delete-tuple ] unit-test ;
|
||||
[ ] [ the-person get delete-tuple ] unit-test
|
||||
[ ] [ person drop-table ] unit-test ;
|
||||
|
||||
: test-sqlite ( -- )
|
||||
"tuples-test.db" resource-path <sqlite-db> [
|
||||
|
|
@ -52,8 +53,8 @@ person "PERSON"
|
|||
|
||||
"billy" 10 3.14 <person> the-person set
|
||||
|
||||
test-sqlite
|
||||
! test-postgresql
|
||||
! test-sqlite
|
||||
test-postgresql
|
||||
|
||||
person "PERSON"
|
||||
{
|
||||
|
|
@ -65,5 +66,5 @@ person "PERSON"
|
|||
|
||||
1 "billy" 20 6.28 <assigned-person> the-person set
|
||||
|
||||
test-sqlite
|
||||
! test-sqlite
|
||||
! test-postgresql
|
||||
|
|
|
|||
|
|
@ -38,8 +38,9 @@ TUPLE: no-slot-named ;
|
|||
[ db-table dupd ] swap
|
||||
[ <prepared-statement> ] 3compose cache nip ; inline
|
||||
|
||||
HOOK: create-sql db ( columns table -- sql )
|
||||
HOOK: drop-sql db ( columns table -- sql )
|
||||
HOOK: create-sql db ( columns table -- seq )
|
||||
HOOK: drop-sql db ( columns table -- seq )
|
||||
|
||||
HOOK: insert-sql* db ( columns table -- sql )
|
||||
HOOK: update-sql* db ( columns table -- sql )
|
||||
HOOK: delete-sql* db ( columns table -- sql )
|
||||
|
|
|
|||
|
|
@ -11,6 +11,12 @@ SYMBOL: +assigned-id+
|
|||
: primary-key? ( spec -- ? )
|
||||
[ { +native-id+ +assigned-id+ } member? ] contains? ;
|
||||
|
||||
: contains-id? ( columns id -- ? )
|
||||
swap [ member? ] with contains? ;
|
||||
|
||||
: assigned-id? ( columns -- ? ) +assigned-id+ contains-id? ;
|
||||
: native-id? ( columns -- ? ) +native-id+ contains-id? ;
|
||||
|
||||
! Same concept, SQLite has autoincrement, PostgreSQL has serial
|
||||
SYMBOL: +autoincrement+
|
||||
SYMBOL: +serial+
|
||||
|
|
|
|||
Loading…
Reference in New Issue