steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix a couple of minor bugs before major overhaul

db4
Doug Coleman 2008-02-21 15:57:18 -06:00
parent 8f208cbaef
commit d1e5fddbed
7 changed files with 60 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
extra/db/db.factor
View File

@ -23,12 +23,12 @@ HOOK: db-close db ( handle -- )
db-handle db-close
] with-variable ;
TUPLE: statement handle sql slot-names bound? in-params out-params ;
TUPLE: statement handle sql bound? in-params out-params ;
TUPLE: simple-statement ;
TUPLE: prepared-statement ;
HOOK: <simple-statement> db ( str -- statement )
HOOK: <prepared-statement> db ( str slot-names -- statement )
HOOK: <prepared-statement> db ( str -- statement )
GENERIC: prepare-statement ( statement -- )
GENERIC: bind-statement* ( obj statement -- )
GENERIC: reset-statement ( statement -- )

39
extra/db/postgresql/postgresql.factor
View File

@ -4,7 +4,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 math.ranges
combinators sequences.lib classes locals words ;
combinators sequences.lib classes locals words tools.walker ;
IN: db.postgresql
TUPLE: postgresql-db host port pgopts pgtty db user pass ;
@ -65,6 +65,7 @@ M: postgresql-result-set sql-type>factor-type ( obj type -- newobj )
} case ;
M: postgresql-statement insert-statement ( statement -- id )
break
query-results [ 0 row-column ] with-disposal string>number ;
M: postgresql-statement query-results ( query -- result-set )
@ -104,10 +105,13 @@ M: postgresql-db <simple-statement> ( sql -- statement )
{ set-statement-sql } statement construct
<postgresql-statement> ;
M: postgresql-db <prepared-statement> ( pair -- statement )
?first2
{ set-statement-sql set-statement-slot-names }
statement construct <postgresql-statement> ;
M: postgresql-db <prepared-statement> ( triple -- statement )
?first3
{
set-statement-sql
set-statement-in-params
set-statement-out-params
} statement construct <postgresql-statement> ;
M: postgresql-db begin-transaction ( -- )
"BEGIN" sql-command ;
@ -166,6 +170,7 @@ SYMBOL: postgresql-counter
: drop-function-sql ( specs table -- sql )
[
break
"drop function add_" % %
"(" %
remove-id
@ -215,8 +220,8 @@ M: postgresql-db drop-sql ( specs table -- seq )
] postgresql-make ;
M: postgresql-db insert-sql* ( specs table -- sql in-specs out-specs )
over find-primary-key native-id?
[ insert-function-sql ] [ insert-table-sql ] if ;
dup class db-columns find-primary-key native-id?
[ insert-function-sql ] [ insert-table-sql ] if 3array ;
M: postgresql-db update-sql* ( specs table -- sql in-specs out-specs )
[
@ -228,7 +233,7 @@ M: postgresql-db update-sql* ( specs table -- sql in-specs out-specs )
" where " 0%
find-primary-key
dup sql-spec-column-name 0% " = " 0% bind%
] postgresql-make ;
] postgresql-make 3array ;
M: postgresql-db delete-sql* ( specs table -- sql in-specs out-specs )
[
@ -236,7 +241,7 @@ M: postgresql-db delete-sql* ( specs table -- sql in-specs out-specs )
" where " 0%
find-primary-key
dup sql-spec-column-name 0% " = " 0% bind%
] postgresql-make ;
] postgresql-make 3array ;
: select-by-slots-sql ( tuple -- sql in-specs out-specs )
[
@ -251,7 +256,7 @@ M: postgresql-db delete-sql* ( specs table -- sql in-specs out-specs )
[ ", " 0% ]
[ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
";" 0%
] postgresql-make ;
] postgresql-make 3array ;
! : select-with-relations ( tuple -- sql in-specs out-specs )
@ -259,7 +264,7 @@ M: postgresql-db select-sql ( tuple -- sql in-specs out-specs )
select-by-slots-sql ;
M: postgresql-db tuple>params ( specs tuple -- obj )
[ >r dup third swap first r> get-slot-named swap ]
[ >r dup sql-spec-type swap sql-spec-slot-name r> get-slot-named swap ]
curry { } map>assoc ;
M: postgresql-db type-table ( -- hash )
@ -268,6 +273,7 @@ M: postgresql-db type-table ( -- hash )
{ TEXT "text" }
{ VARCHAR "varchar" }
{ INTEGER "integer" }
{ DOUBLE "real" }
{ TIMESTAMP "timestamp" }
} ;
@ -278,12 +284,13 @@ M: postgresql-db create-type-table ( -- hash )
: postgresql-compound ( str n -- newstr )
over {
{ "varchar" [ first number>string join-space ] }
{ "references"
[
{ "default" [ first number>string join-space ] }
{ "varchar" [ first number>string paren append ] }
{ "references" [
first2 >r [ unparse join-space ] keep db-columns r>
swap [ sql-spec-slot-name = ] with find nip sql-spec-column-name paren append
] }
swap [ sql-spec-slot-name = ] with find nip
sql-spec-column-name paren append
] }
[ "no compound found" 3array throw ]
} case ;

1
extra/db/sqlite/lib/lib.factor
View File

@ -79,6 +79,7 @@ IN: db.sqlite.lib
{ VARCHAR [ sqlite-bind-text-by-name ] }
{ DOUBLE [ sqlite-bind-double-by-name ] }
{ TIMESTAMP [ sqlite-bind-double-by-name ] }
{ +native-id+ [ sqlite-bind-int-by-name ] }
! { NULL [ sqlite-bind-null-by-name ] }
[ no-sql-type ]
} case ;

10
extra/db/sqlite/sqlite.factor
View File

@ -4,7 +4,7 @@ USING: alien arrays assocs classes compiler db
hashtables io.files kernel math math.parser namespaces
prettyprint sequences strings tuples alien.c-types
continuations db.sqlite.lib db.sqlite.ffi db.tuples
words combinators.lib db.types combinators ;
words combinators.lib db.types combinators tools.walker ;
IN: db.sqlite
TUPLE: sqlite-db path ;
@ -99,7 +99,7 @@ M: sqlite-db create-sql ( specs table -- sql )
M: sqlite-db drop-sql ( specs table -- sql )
[
"drop table " % % ";" %
"drop table " % % ";" % drop
] "" make ;
M: sqlite-db insert-sql* ( specs table -- sql )
@ -161,9 +161,9 @@ M: sqlite-db select-sql ( tuple -- sql )
M: sqlite-db tuple>params ( specs tuple -- obj )
[
>r [ second ":" swap append ] keep r>
dupd >r first r> get-slot-named swap
third 3array
>r [ sql-spec-column-name ":" swap append ] keep r>
dupd >r sql-spec-slot-name r> get-slot-named swap
sql-spec-type 3array
] curry map ;
M: sqlite-db modifier-table ( -- hashtable )

37
extra/db/tuples/tuples-tests.factor
View File

@ -2,19 +2,18 @@
! See http://factorcode.org/license.txt for BSD license.
USING: io.files kernel tools.test db db.sqlite db.tuples
db.types continuations namespaces db.postgresql math
prettyprint ;
! tools.time ;
prettyprint tools.walker ;
IN: temporary
TUPLE: person the-id the-name the-number real ;
TUPLE: person the-id the-name the-number the-real ;
: <person> ( name age real -- person )
{
set-person-the-name
set-person-the-number
set-person-real
set-person-the-real
} person construct ;
: <assigned-person> ( id name number real -- obj )
: <assigned-person> ( id name number the-real -- obj )
<person> [ set-person-the-id ] keep ;
SYMBOL: the-person
@ -31,8 +30,10 @@ SYMBOL: the-person
[ ] [ the-person get update-tuple ] unit-test
! T{ person f f f 200 f } select-tuples
[ ] [ the-person get delete-tuple ] unit-test
; ! 1 [ ] [ person drop-table ] unit-test ;
[ ] [ person drop-table ] unit-test ;
: test-sqlite ( -- )
"tuples-test.db" resource-path <sqlite-db> [
@ -49,20 +50,20 @@ person "PERSON"
{ "the-id" "ID" +native-id+ }
{ "the-name" "NAME" { VARCHAR 256 } +not-null+ }
{ "the-number" "AGE" INTEGER { +default+ 0 } }
{ "real" "REAL" DOUBLE { +default+ 0.3 } }
{ "the-real" "REAL" DOUBLE { +default+ 0.3 } }
} define-persistent
"billy" 10 3.14 <person> the-person set
test-sqlite
! test-postgresql
! test-sqlite
test-postgresql
! person "PERSON"
! {
! { "the-id" "ID" INTEGER +assigned-id+ }
! { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
! { "the-number" "AGE" INTEGER { +default+ 0 } }
! { "real" "REAL" DOUBLE { +default+ 0.3 } }
! { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
! } define-persistent
! 1 "billy" 20 6.28 <assigned-person> the-person set
@ -95,11 +96,11 @@ annotation "ANNOTATION"
{ "contents" "CONTENTS" TEXT }
} define-persistent
"localhost" "postgres" "" "factor-test" <postgresql-db> [
[ paste drop-table ] [ drop ] recover
[ annotation drop-table ] [ drop ] recover
[ paste drop-table ] [ drop ] recover
[ annotation drop-table ] [ drop ] recover
paste create-table
annotation create-table
] with-db
! "localhost" "postgres" "" "factor-test" <postgresql-db> [
! [ paste drop-table ] [ drop ] recover
! [ annotation drop-table ] [ drop ] recover
! [ paste drop-table ] [ drop ] recover
! [ annotation drop-table ] [ drop ] recover
! [ ] [ paste create-table ] unit-test
! [ ] [ annotation create-table ] unit-test
! ] with-db

6
extra/db/tuples/tuples.factor
View File

@ -3,7 +3,7 @@
USING: arrays assocs classes db kernel namespaces
tuples words sequences slots slots.private math
math.parser io prettyprint db.types continuations
mirrors sequences.lib ;
mirrors sequences.lib tools.walker ;
IN: db.tuples
: db-table ( class -- obj ) "db-table" word-prop ;
@ -33,7 +33,7 @@ TUPLE: no-slot-named ;
dup class primary-key-spec get-slot-named ;
: set-primary-key ( obj tuple -- )
[ class primary-key-spec first ] keep
[ class primary-key-spec sql-spec-slot-name ] keep
set-slot-named ;
: cache-statement ( columns class assoc quot -- statement )
@ -92,7 +92,7 @@ HOOK: tuple>params db ( columns tuple -- obj )
: delete-tuple ( tuple -- )
[ [ primary-key? ] subset ] [ delete-sql ] do-tuple-statement ;
: select-tuple ( tuple -- )
: select-tuples ( tuple -- )
[ select-sql ] keep do-query ;
: persist ( tuple -- )

11
extra/db/types/types.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs db kernel math math.parser
sequences continuations sequences.deep sequences.lib
words namespaces ;
words namespaces tools.walker ;
IN: db.types
TUPLE: sql-spec slot-name column-name type modifiers primary-key ;
@ -12,15 +12,18 @@ SYMBOL: +native-id+
! +assigned-id+ can only be a modifier
SYMBOL: +assigned-id+
: primary-key? ( obj -- ? )
: (primary-key?) ( obj -- ? )
{ +native-id+ +assigned-id+ } member? ;
: primary-key? ( spec -- ? )
sql-spec-primary-key (primary-key?) ;
: normalize-spec ( spec -- )
dup sql-spec-type dup primary-key? [
dup sql-spec-type dup (primary-key?) [
swap set-sql-spec-primary-key
] [
drop dup sql-spec-modifiers [
primary-key?
(primary-key?)
] deep-find
[ swap set-sql-spec-primary-key ] [ drop ] if*
] if ;