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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-02-15 18:22:43 -06:00
parent d9f49dec87 46df9c16d1
commit ee0536e649
11 changed files with 237 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
extra/builder/builder.factor
View File

@ -11,6 +11,26 @@ IN: builder
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOL: builds-dir
: builds ( -- path )
builds-dir get
home "/builds" append
or ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: prepare-build-machine ( -- )
builds make-directory
builds cd
{ "git" "clone" "git://factorcode.org/git/factor.git" } run-process drop ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: builds-check ( -- ) builds exists? not [ prepare-build-machine ] when ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: git-clone ( -- desc ) { "git" "clone" "../factor" } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -19,7 +39,7 @@ VAR: stamp
: enter-build-dir ( -- )
datestamp >stamp
"/builds" cd
builds cd
stamp> make-directory
stamp> cd ;
@ -69,14 +89,22 @@ VAR: stamp
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOL: build-status
: (build) ( -- )
builds-check
build-status off
enter-build-dir
"report" [
"Build machine: " write host-name print
"Build directory: " write cwd print
"CPU: " write cpu print
"OS: " write os print
"Build directory: " write cwd print nl
git-clone [ "git clone failed" print ] run-or-bail
@ -88,7 +116,7 @@ VAR: stamp
make-vm [ "vm compile error" print "../compile-log" cat ] run-or-bail
[ my-arch download-image ] [ "Image download error" print throw ] recover
[ retrieve-image ] [ "Image download error" print throw ] recover
bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail
@ -98,7 +126,7 @@ VAR: stamp
"Boot time: " write "../boot-time" eval-file milli-seconds>time print
"Load time: " write "../load-time" eval-file milli-seconds>time print
"Test time: " write "../test-time" eval-file milli-seconds>time print
"Test time: " write "../test-time" eval-file milli-seconds>time print nl
"Did not pass load-everything: " print "../load-everything-vocabs" cat
"Did not pass test-all: " print "../test-all-vocabs" cat
@ -106,23 +134,32 @@ VAR: stamp
"Benchmarks: " print
"../benchmarks" [ stdio get contents eval ] with-file-in benchmarks.
] with-file-out ;
] with-file-out
build-status on ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOL: builder-from
SYMBOL: builder-recipients
: tag-subject ( str -- str ) { "builder@" host-name* ": " , } bake to-string ;
: build ( -- )
[ (build) ] [ drop ] recover
: subject ( -- str ) build-status get [ "report" ] [ "error" ] if tag-subject ;
: send-builder-email ( -- )
<email>
"ed@factorcode.org" >>from
builder-from get >>from
builder-recipients get >>to
"report" tag-subject >>subject
subject >>subject
"../report" file>string >>body
send ;
: build ( -- )
[ (build) ] [ drop ] recover
[ send-builder-email ] [ drop "not sending mail" . ] recover ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: git-pull ( -- desc )
@ -141,8 +178,9 @@ SYMBOL: builder-recipients
= not ;
: build-loop ( -- )
builds-check
[
"/builds/factor" cd
builds "/factor" append cd
updates-available?
[ build ]
when

7
extra/builder/util/util.factor
View File

@ -69,9 +69,9 @@ TUPLE: process* arguments stdin stdout stderr timeout ;
: milli-seconds>time ( n -- string )
1000 /i 60 /mod >r 60 /mod r> 3array [ pad-00 ] map ":" join ;
: eval-file ( file -- obj ) <file-reader> contents eval ;
: eval-file ( file -- obj ) file-contents eval ;
: cat ( file -- ) <file-reader> contents print ;
: cat ( file -- ) file-contents print ;
: run-or-bail ( desc quot -- )
[ [ try-process ] curry ]
@ -81,3 +81,6 @@ TUPLE: process* arguments stdin stdout stderr timeout ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
USING: bootstrap.image bootstrap.image.download io.streams.null ;
: retrieve-image ( -- ) [ my-arch download-image ] with-null-stream ;

49
extra/db/db.factor
View File

@ -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 ;
@ -36,13 +36,17 @@ HOOK: <prepared-statement> db ( str -- statement )
GENERIC: prepare-statement ( statement -- )
GENERIC: bind-statement* ( obj statement -- )
GENERIC: reset-statement ( statement -- )
GENERIC: execute-statement* ( statement -- result-set )
HOOK: last-id db ( res -- id )
: execute-statement ( statement -- )
execute-statement* dispose ;
GENERIC: insert-statement ( statement -- id )
: execute-statement-last-id ( statement -- id )
execute-statement* [ last-id ] with-disposal ;
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: more-rows? ( result-set -- ? )
: execute-statement ( statement -- ) query-results dispose ;
: bind-statement ( obj statement -- )
dup statement-bound? [ dup reset-statement ] when
@ -50,17 +54,9 @@ HOOK: last-id db ( res -- id )
[ set-statement-params ] keep
t swap set-statement-bound? ;
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 -- ? )
: 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>
@ -74,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 )
@ -98,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 ( -- )
@ -116,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 ;

11
extra/db/postgresql/lib/lib.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays continuations db io kernel math namespaces
quotations sequences db.postgresql.ffi alien alien.c-types ;
quotations sequences db.postgresql.ffi alien alien.c-types
db.types ;
IN: db.postgresql.lib
: postgresql-result-error-message ( res -- str/f )
@ -37,13 +38,9 @@ IN: db.postgresql.lib
>r db get db-handle r>
[ statement-sql ] keep
[ statement-params length f ] keep
statement-params [ second malloc-char-string ] map >c-void*-array
statement-params
[ first number>string* malloc-char-string ] map >c-void*-array
f f 0 PQexecParams
dup postgresql-result-ok? [
dup postgresql-result-error-message swap PQclear throw
] unless ;
: pq-oid-value ( res -- n )
PQoidValue dup InvalidOid = [
"postgresql returned an InvalidOid" throw
] when ;

6
extra/db/postgresql/postgresql-tests.factor
View File

@ -2,7 +2,7 @@
! Set username and password in the 'connect' word.
USING: kernel db.postgresql alien continuations io prettyprint
sequences namespaces tools.test db ;
sequences namespaces tools.test db db.types ;
IN: temporary
IN: scratchpad
@ -40,13 +40,13 @@ IN: temporary
test-db [
"select * from person where name = $1 and country = $2"
<simple-statement> [
{ "Jane" "New Zealand" }
{ { "Jane" TEXT } { "New Zealand" TEXT } }
over do-bound-query
{ { "Jane" "New Zealand" } } =
[ "test fails" throw ] unless
{ "John" "America" }
{ { "John" TEXT } { "America" TEXT } }
swap do-bound-query
] with-disposal
] with-db

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

@ -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 ;
db.tuples db.types tools.annotations math.ranges ;
IN: db.postgresql
TUPLE: postgresql-db host port pgopts pgtty db user pass ;
@ -52,11 +52,11 @@ 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 ;
M: postgresql-result-set row-column ( result-set n -- obj )
>r dup result-set-handle swap result-set-n r> PQgetvalue ;
: increment-n ( result-set -- n )
dup result-set-n 1+ dup rot set-result-set-n ;
M: postgresql-statement insert-statement ( statement -- id )
query-results [ break 0 row-column ] with-disposal ;
M: postgresql-statement query-results ( query -- result-set )
dup statement-params [
@ -68,8 +68,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
@ -105,36 +108,105 @@ M: postgresql-db commit-transaction ( -- )
M: postgresql-db rollback-transaction ( -- )
"ROLLBACK" sql-command ;
: postgresql-type-hash* ( -- assoc )
H{
{ SERIAL "serial" }
} ;
M: postgresql-db create-sql ( columns table -- sql )
: postgresql-type-hash ( -- assoc )
H{
{ INTEGER "integer" }
{ SERIAL "integer" }
{ TEXT "text" }
{ VARCHAR "varchar" }
{ DOUBLE "real" }
} ;
: enquote ( str -- newstr ) "(" swap ")" 3append ;
: postgresql-type ( str n/str -- newstr )
" " swap number>string* enquote 3append ;
: >sql-type* ( obj -- str )
dup pair? [
first2 >r >sql-type* r> postgresql-type
] [
dup postgresql-type-hash* at* [
nip
] [
drop >sql-type
] if
] if ;
M: postgresql-db >sql-type ( hash obj -- str )
dup pair? [
first2 >r >sql-type r> postgresql-type
] [
postgresql-type-hash at* [
no-sql-type
] unless
] if ;
: insert-function ( columns table -- sql )
[
"create table " % %
" (" % [ ", " % ] [
dup second % " " %
dup third >sql-type % " " %
sql-modifiers " " join %
] interleave ")" %
] "" make ;
>r remove-id r>
"create function add_" % dup %
"(" %
over [ "," % ]
[ third dup array? [ first ] when >sql-type % ] interleave
")" %
" returns bigint as '" %
M: postgresql-db drop-sql ( table -- sql )
[
"drop table " % %
] "" make ;
SYMBOL: postgresql-counter
M: postgresql-db insert-sql* ( columns table -- sql )
[
postgresql-counter off
"insert into " %
2dup "insert into " %
%
"(" %
dup [ ", " % ] [ second % ] interleave
") " %
" values (" %
[ ", " % ] [
drop "$" % postgresql-counter [ inc ] keep get #
] interleave
length [1,b] [ ", " % ] [ "$" % # ] interleave
"); " %
"select currval(''" % % "_id_seq'');' language sql;" %
drop
] "" make ;
: drop-function ( columns table -- sql )
[
>r remove-id r>
"drop function add_" % %
"(" %
[ "," % ] [ third >sql-type % ] interleave
")" %
] "" make ;
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_" % %
"(" %
length [1,b] [ ", " % ] [ "$" % # ] interleave
")" %
] "" make ;
@ -144,9 +216,10 @@ M: postgresql-db update-sql* ( columns table -- sql )
%
" set " %
dup remove-id
[ ", " % ] [ second dup % " = :" % % ] interleave
dup length [1,b] swap 2array flip
[ ", " % ] [ first2 second % " = $" % # ] interleave
" where " %
[ primary-key? ] find nip second dup % " = :" % %
[ primary-key? ] find nip second dup % " = $" % length 2 + #
] "" make ;
M: postgresql-db delete-sql* ( columns table -- sql )
@ -154,23 +227,19 @@ M: postgresql-db delete-sql* ( columns table -- sql )
"delete from " %
%
" where " %
first second dup % " = :" % %
first second % " = $1" %
] "" make ;
M: postgresql-db select-sql* ( columns table -- sql )
drop ;
M: postgresql-db tuple>params ( columns tuple -- obj )
[
>r dup first r> get-slot-named swap third
] curry { } map>assoc ;
[ >r dup third swap first r> get-slot-named swap ]
curry { } map>assoc ;
M: postgresql-db last-id ( res -- id )
pq-oid-value ;
: postgresql-db-modifiers ( -- hashtable )
H{
{ +native-id+ "primary key" }
{ +native-id+ "not null primary key" }
{ +assigned-id+ "primary key" }
{ +autoincrement+ "autoincrement" }
{ +unique+ "unique" }
@ -189,18 +258,3 @@ M: postgresql-db sql-modifiers* ( modifiers -- str )
swap at
] if
] with map [ ] subset ;
: postgresql-type-hash ( -- assoc )
H{
{ INTEGER "integer" }
{ TEXT "text" }
{ VARCHAR "text" }
{ DOUBLE "real" }
} ;
M: postgresql-db >sql-type ( obj -- str )
dup pair? [
first >sql-type
] [
postgresql-type-hash at* [ T{ no-sql-type } throw ] unless
] if ;

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

@ -74,10 +74,11 @@ IN: db.sqlite.lib
dup array? [ first ] when
{
{ INTEGER [ sqlite-bind-int-by-name ] }
{ BIG_INTEGER [ sqlite-bind-int-by-name ] }
{ BIG_INTEGER [ sqlite-bind-int64-by-name ] }
{ TEXT [ sqlite-bind-text-by-name ] }
{ VARCHAR [ sqlite-bind-text-by-name ] }
{ DOUBLE [ sqlite-bind-double-by-name ] }
{ SERIAL [ sqlite-bind-int-by-name ] }
! { NULL [ sqlite-bind-null-by-name ] }
[ no-sql-type ]
} case ;
@ -99,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? ;

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

@ -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 ;
M: sqlite-statement execute-statement* ( statement -- obj )
query-results ;
: 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 )
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 ;
@ -93,9 +93,10 @@ M: sqlite-db create-sql ( columns table -- sql )
] interleave ")" %
] "" make ;
M: sqlite-db drop-sql ( table -- sql )
M: sqlite-db drop-sql ( columns table -- sql )
[
"drop table " % %
drop
] "" make ;
M: sqlite-db insert-sql* ( columns table -- sql )
@ -144,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{
@ -175,6 +171,7 @@ M: sqlite-db sql-modifiers* ( modifiers -- str )
: sqlite-type-hash ( -- assoc )
H{
{ INTEGER "integer" }
{ SERIAL "integer" }
{ TEXT "text" }
{ VARCHAR "text" }
{ DOUBLE "real" }
@ -190,4 +187,3 @@ M: sqlite-db >sql-type ( obj -- str )
! HOOK: get-column-value ( n result-set type -- )
! M: sqlite get-column-value { { "TEXT" get-text-column } {
! "INTEGER" get-integer-column } ... } case ;

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

@ -1,8 +1,8 @@
! Copyright (C) 2008 Doug Coleman.
! 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
tools.time ;
db.types continuations namespaces db.postgresql math ;
! tools.time ;
IN: temporary
TUPLE: person the-id the-name the-number real ;
@ -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> [
@ -44,7 +45,7 @@ SYMBOL: the-person
person "PERSON"
{
{ "the-id" "ROWID" INTEGER +native-id+ }
{ "the-id" "ID" SERIAL +native-id+ }
{ "the-name" "NAME" { VARCHAR 256 } +not-null+ }
{ "the-number" "AGE" INTEGER { +default+ 0 } }
{ "real" "REAL" DOUBLE { +default+ 0.3 } }
@ -52,12 +53,12 @@ person "PERSON"
"billy" 10 3.14 <person> the-person set
test-sqlite
! test-postgresql
! test-sqlite
test-postgresql
person "PERSON"
{
{ "the-id" "ROWID" INTEGER +assigned-id+ }
{ "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 } }
@ -65,5 +66,5 @@ person "PERSON"
1 "billy" 20 6.28 <assigned-person> the-person set
test-sqlite
! test-sqlite
! test-postgresql

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

@ -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 ( 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 )
@ -75,12 +76,12 @@ HOOK: tuple>params db ( columns tuple -- obj )
dup db-columns swap db-table create-sql sql-command ;
: drop-table ( class -- )
db-table drop-sql sql-command ;
dup db-columns swap db-table drop-sql sql-command ;
: insert-tuple ( tuple -- )
[
[ maybe-remove-id ] [ insert-sql ]
make-tuple-statement execute-statement-last-id
make-tuple-statement insert-statement
] keep set-primary-key ;
: update-tuple ( tuple -- )

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

@ -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+
@ -22,6 +28,7 @@ SYMBOL: +not-null+
SYMBOL: +has-many+
SYMBOL: SERIAL
SYMBOL: INTEGER
SYMBOL: DOUBLE
SYMBOL: BOOLEAN