re-add delete-tuple

make all unit tests pass for assigned-id

extra/db/postgresql/postgresql.factor

@@ -161,7 +161,7 @@ M: postgresql-db create-sql-statement ( class -- seq )
     [
         [ create-table-sql , ] keep
         dup db-columns find-primary-key native-id?
-        [ create-function-sql , ] [ 2drop ] if
+        [ create-function-sql , ] [ drop ] if
     ] { } make ;
 
 : drop-function-sql ( class -- statement )
@@ -176,13 +176,13 @@ M: postgresql-db create-sql-statement ( class -- seq )
 : drop-table-sql ( table -- statement )
     [
         "drop table " 0% 0% ";" 0% drop
-    ] postgresql-make dup . ;
+    ] postgresql-make ;
 
 M: postgresql-db drop-sql-statement ( class -- seq )
     [
         [ drop-table-sql , ] keep
         dup db-columns find-primary-key native-id?
-        [ drop-function-sql , ] [ 2drop ] if
+        [ drop-function-sql , ] [ drop ] if
     ] { } make ;
 
 M: postgresql-db <insert-native-statement> ( class -- statement )

extra/db/tuples/tuples-tests.factor

@@ -16,29 +16,30 @@ TUPLE: person the-id the-name the-number the-real ;
 : <assigned-person> ( id name number the-real -- obj )
     <person> [ set-person-the-id ] keep ;
 
-SYMBOL: the-person
+SYMBOL: the-person1
+SYMBOL: the-person2
 
 : test-tuples ( -- )
     [ person drop-table ] [ drop ] recover
     [ ] [ person create-table ] unit-test
     
-    [  ] [ the-person get insert-tuple ] unit-test
+    [  ] [ the-person1 get insert-tuple ] unit-test
 
-    [ 1 ] [ the-person get person-the-id ] unit-test
+    [ 1 ] [ the-person1 get person-the-id ] unit-test
 
-    200 the-person get set-person-the-number
+    200 the-person1 get set-person-the-number
 
-    [ ] [ the-person get update-tuple ] unit-test
+    [ ] [ the-person1 get update-tuple ] unit-test
 
     [ T{ person f 1 "billy" 200 3.14 } ]
     [ T{ person f 1 } select-tuple ] unit-test
 
-    ! [ ] [ the-person get delete-tuple ] unit-test
+    [ ] [ the-person1 get delete-tuple ] unit-test
-    ! [ ] [ person drop-table ] unit-test
+    [ f ] [ T{ person f 1 } select-tuple ] unit-test
-    ;
+    [ ] [ person drop-table ] unit-test ;
 
 : test-sqlite ( -- )
-    "tuples-test.db" resource-path <sqlite-db> [
+    "tuples-test.db" resource-path sqlite-db [
         test-tuples
     ] with-db ;
 
@@ -55,23 +56,24 @@ person "PERSON"
     { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
 } define-persistent
 
-"billy" 10 3.14 <person> the-person set
+"billy" 10 3.14 <person> the-person1 set
+"johnny" 10 3.14 <person> the-person2 set
 
 ! test-sqlite
 test-postgresql
 
-! person "PERSON"
+person "PERSON"
-! {
+{
-    ! { "the-id" "ID" INTEGER +assigned-id+ }
+    { "the-id" "ID" INTEGER +assigned-id+ }
-    ! { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
+    { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
-    ! { "the-number" "AGE" INTEGER { +default+ 0 } }
+    { "the-number" "AGE" INTEGER { +default+ 0 } }
-    ! { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
+    { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
-! } define-persistent
+} define-persistent
 
-! 1 "billy" 20 6.28 <assigned-person> the-person set
+1 "billy" 10 3.14 <assigned-person> the-person1 set
 
 ! test-sqlite
-! test-postgresql
+test-postgresql
 
 TUPLE: paste n summary author channel mode contents timestamp annotations ;
 TUPLE: annotation n paste-id summary author mode contents ;
@@ -98,11 +100,12 @@ annotation "ANNOTATION"
     { "contents" "CONTENTS" TEXT }
 } define-persistent
 
-! "localhost" "postgres" "" "factor-test" <postgresql-db> [
+{ "localhost" "postgres" "" "factor-test" } postgresql-db [
-    ! [ paste drop-table ] [ drop ] recover
+    [ paste drop-table ] [ drop ] recover
-    ! [ annotation drop-table ] [ drop ] recover
+    [ annotation drop-table ] [ drop ] recover
-    ! [ paste drop-table ] [ drop ] recover
+    [ paste drop-table ] [ drop ] recover
-    ! [ annotation drop-table ] [ drop ] recover
+    [ annotation drop-table ] [ drop ] recover
-    ! [ ] [ paste create-table ] unit-test
+    [ ] [ paste create-table ] unit-test
-    ! [ ] [ annotation create-table ] unit-test
+    [ ] [ annotation create-table ] unit-test
-! ] with-db
+] with-db
+

extra/db/tuples/tuples.factor

@@ -92,7 +92,13 @@ HOOK: insert-tuple* db ( tuple statement -- )
     <update-tuples-statement> execute-statement ;
 
 : persist ( tuple -- )
-    dup class db-columns find-primary-key ;
+    dup class db-columns find-primary-key
+    sql-spec-slot-name over get-slot-named
+    [ update-tuple ] [ insert-tuple ] if ;
+
+: delete-tuple ( tuple -- )
+    dup class <delete-tuple-statement>
+    [ bind-tuple ] keep execute-statement ;
 
 
 : setup-select ( tuple -- statement )
@@ -100,4 +106,4 @@ HOOK: insert-tuple* db ( tuple statement -- )
     [ bind-tuple ] keep ;
 
 : select-tuples ( tuple -- tuple ) setup-select query-tuples ;
-: select-tuple ( tuple -- tuple ) select-tuples first ;
+: select-tuple ( tuple -- tuple/f ) select-tuples ?first ;