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

[factor.git] / basis / db / postgresql / postgresql.factor

diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor
old mode 100755 (executable)
new mode 100644 (file)
index 17bb973..08df25c
--- a/basis/db/postgresql/postgresql.factor
+++ b/basis/db/postgresql/postgresql.factor
@@ -10,35 +10,30 @@ USE: tools.walker
 IN: db.postgresql
 
 TUPLE: postgresql-db < db
-    host port pgopts pgtty db user pass ;
+    host port pgopts pgtty database username password ;
+
+: <postgresql-db> ( -- postgresql-db )
+    postgresql-db new-db ;
 
 TUPLE: postgresql-statement < statement ;
 
 TUPLE: postgresql-result-set < result-set ;
 
-M: postgresql-db make-db* ( seq db -- db )
-    >r first4 r>
-        swap >>db
-        swap >>pass
-        swap >>user
-        swap >>host ;
-
 M: postgresql-db db-open ( db -- db )
     dup {
         [ host>> ]
         [ port>> ]
         [ pgopts>> ]
         [ pgtty>> ]
-        [ db>> ]
-        [ user>> ]
-        [ pass>> ]
+        [ database>> ]
+        [ username>> ]
+        [ password>> ]
     } cleave connect-postgres >>handle ;
 
 M: postgresql-db dispose ( db -- )
     handle>> PQfinish ;
 
-M: postgresql-statement bind-statement* ( statement -- )
-    drop ;
+M: postgresql-statement bind-statement* ( statement -- ) drop ;
 
 GENERIC: postgresql-bind-conversion ( tuple object -- low-level-binding )
 
@@ -67,11 +62,11 @@ M: postgresql-result-set #columns ( result-set -- n )
     [ handle>> ] [ n>> ] bi ;
 
 M: postgresql-result-set row-column ( result-set column -- object )
-    >r result-handle-n r> pq-get-string ;
+    [ result-handle-n ] dip pq-get-string ;
 
 M: postgresql-result-set row-column-typed ( result-set column -- object )
     dup pick out-params>> nth type>>
-    >r >r result-handle-n r> r> postgresql-column-typed ;
+    [ result-handle-n ] 2dip postgresql-column-typed ;
 
 M: postgresql-statement query-results ( query -- result-set )
     dup bind-params>> [
@@ -103,7 +98,7 @@ M: postgresql-result-set dispose ( result-set -- )
 
 M: postgresql-statement prepare-statement ( statement -- )
     dup
-    >r db get handle>> f r>
+    [ db get handle>> f ] dip
     [ sql>> ] [ in-params>> ] bi
     length f PQprepare postgresql-error
     >>handle drop ;
@@ -122,22 +117,30 @@ M: postgresql-db bind% ( spec -- )
     bind-name% 1, ;
 
 M: postgresql-db bind# ( spec object -- )
-    >r bind-name% f swap type>> r> <literal-bind> 1, ;
+    [ bind-name% f swap type>> ] dip
+    <literal-bind> 1, ;
 
 : create-table-sql ( class -- statement )
     [
+        dupd
         "create table " 0% 0%
         "(" 0% [ ", " 0% ] [
             dup column-name>> 0%
             " " 0%
             dup type>> lookup-create-type 0%
             modifiers 0%
-        ] interleave ");" 0%
+        ] interleave
+
+        ", " 0%
+        find-primary-key
+        "primary key(" 0%
+        [ "," 0% ] [ column-name>> 0% ] interleave
+        "));" 0%
     ] query-make ;
 
 : create-function-sql ( class -- statement )
     [
-        >r remove-id r>
+        [ remove-id ] dip
         "create function add_" 0% dup 0%
         "(" 0%
         over [ "," 0% ]
@@ -160,8 +163,7 @@ M: postgresql-db bind# ( spec object -- )
 M: postgresql-db create-sql-statement ( class -- seq )
     [
         [ create-table-sql , ] keep
-        dup db-columns find-primary-key db-assigned-id-spec?
-        [ create-function-sql , ] [ drop ] if
+        dup db-assigned? [ create-function-sql , ] [ drop ] if
     ] { } make ;
 
 : drop-function-sql ( class -- statement )
@@ -181,15 +183,14 @@ M: postgresql-db create-sql-statement ( class -- seq )
 M: postgresql-db drop-sql-statement ( class -- seq )
     [
         [ drop-table-sql , ] keep
-        dup db-columns find-primary-key db-assigned-id-spec?
-        [ drop-function-sql , ] [ drop ] if
+        dup db-assigned? [ drop-function-sql , ] [ drop ] if
     ] { } make ;
 
 M: postgresql-db <insert-db-assigned-statement> ( class -- statement )
     [
         "select add_" 0% 0%
         "(" 0%
-        dup find-primary-key 2,
+        dup find-primary-key first 2,
         remove-id
         [ ", " 0% ] [ bind% ] interleave
         ");" 0%
@@ -218,14 +219,23 @@ M: postgresql-db <insert-user-assigned-statement> ( class -- statement )
         ");" 0%
     ] query-make ;
 
-M: postgresql-db insert-tuple* ( tuple statement -- )
+M: postgresql-db insert-tuple-set-key ( tuple statement -- )
     query-modify-tuple ;
 
 M: postgresql-db persistent-table ( -- hashtable )
     H{
-        { +db-assigned-id+ { "integer" "serial primary key" f } }
-        { +user-assigned-id+ { f f "primary key" } }
-        { +random-id+ { "bigint" "bigint primary key" f } }
+        { +db-assigned-id+ { "integer" "serial" f } }
+        { +user-assigned-id+ { f f f } }
+        { +random-id+ { "bigint" "bigint" f } }
+
+        { +foreign-id+ { f f "references" } }
+
+        { +on-delete+ { f f "on delete" } }
+        { +restrict+ { f f "restrict" } }
+        { +cascade+ { f f "cascade" } }
+        { +set-null+ { f f "set null" } }
+        { +set-default+ { f f "set default" } }
+
         { TEXT { "text" "text" f } }
         { VARCHAR { "varchar" "varchar" f } }
         { INTEGER { "integer" "integer" f } }
@@ -240,7 +250,6 @@ M: postgresql-db persistent-table ( -- hashtable )
         { BLOB { "bytea" "bytea" f } }
         { FACTOR-BLOB { "bytea" "bytea" f } }
         { URL { "varchar" "varchar" f } }
-        { +foreign-id+ { f f "references" } }
         { +autoincrement+ { f f "autoincrement" } }
         { +unique+ { f f "unique" } }
         { +default+ { f f "default" } }
@@ -256,10 +265,6 @@ M: postgresql-db compound ( string object -- string' )
     over {
         { "default" [ first number>string join-space ] }
         { "varchar" [ first number>string paren append ] }
-        { "references" [
-                first2 >r [ unparse join-space ] keep db-columns r>
-                swap [ slot-name>> = ] with find nip
-                column-name>> paren append
-            ] }
+        { "references" [ >reference-string ] }
         [ drop no-compound-found ]
     } case ;