inheritance with postgresql

extra/db/db.factor

@@ -11,14 +11,19 @@ TUPLE: db
     update-statements
     delete-statements ;
 
-: <db> ( handle -- obj )
-    H{ } clone H{ } clone H{ } clone
-    db construct-boa ;
+: construct-db ( class -- obj )
+    construct-empty
+        H{ } clone >>insert-statements
+        H{ } clone >>update-statements
+        H{ } clone >>delete-statements ;
 
 GENERIC: make-db* ( seq class -- db )
-GENERIC: db-open ( db -- )
+
+: make-db ( seq class -- db )
+    construct-db make-db* ;
+
+GENERIC: db-open ( db -- db )
 HOOK: db-close db ( handle -- )
-: make-db ( seq class -- db ) construct-empty make-db* ;
 
 : dispose-statements ( seq -- ) [ dispose drop ] assoc-each ;
 
@@ -30,10 +35,12 @@ HOOK: db-close db ( handle -- )
         handle>> db-close
     ] with-variable ;
 
+! TUPLE: sql sql in-params out-params ;
 TUPLE: statement handle sql in-params out-params bind-params bound? ;
-TUPLE: simple-statement ;
-TUPLE: prepared-statement ;
-TUPLE: nonthrowable-statement ;
+TUPLE: simple-statement < statement ;
+TUPLE: prepared-statement < statement ;
+TUPLE: nonthrowable-statement < statement ;
+TUPLE: throwable-statement < statement ;
 : make-nonthrowable ( obj -- obj' )
     dup sequence? [
         [ make-nonthrowable ] map
@@ -41,14 +48,12 @@ TUPLE: nonthrowable-statement ;
         nonthrowable-statement construct-delegate
     ] if ;
 
-MIXIN: throwable-statement
-INSTANCE: statement throwable-statement
-INSTANCE: simple-statement throwable-statement
-INSTANCE: prepared-statement throwable-statement
-
 TUPLE: result-set sql in-params out-params handle n max ;
-: <statement> ( sql in out -- statement )
-    { (>>sql) (>>in-params) (>>out-params) } statement construct ;
+: construct-statement ( sql in out class -- statement )
+    construct-empty
+        swap >>out-params
+        swap >>in-params
+        swap >>sql ;
 
 HOOK: <simple-statement> db ( str in out -- statement )
 HOOK: <prepared-statement> db ( str in out -- statement )
@@ -88,10 +93,17 @@ M: nonthrowable-statement execute-statement ( statement -- )
     dup #rows >>max
     0 >>n drop ;
 
-: <result-set> ( query handle tuple -- result-set )
-    >r >r { sql>> in-params>> out-params>> } get-slots r>
-    { (>>sql) (>>in-params) (>>out-params) (>>handle) } result-set
-    construct r> construct-delegate ;
+: construct-result-set ( query handle class -- result-set )
+    construct-empty
+        swap >>handle
+        >r [ sql>> ] [ in-params>> ] [ out-params>> ] tri r>
+        swap >>out-params
+        swap >>in-params
+        swap >>sql ;
+    
+    ! >r >r { sql>> in-params>> out-params>> } get-slots r>
+    ! { (>>sql) (>>in-params) (>>out-params) (>>handle) } result-set
+    ! construct r> construct-delegate ;
 
 : sql-row ( result-set -- seq )
     dup #columns [ row-column ] with map ;
@@ -110,7 +122,7 @@ M: nonthrowable-statement execute-statement ( statement -- )
     accumulator >r query-each r> { } like ; inline
 
 : with-db ( db seq quot -- )
-    >r make-db dup db-open db r>
+    >r make-db db-open db r>
     [ db get swap [ drop ] swap compose with-disposal ] curry with-variable ;
 
 : default-query ( query -- result-set )

extra/db/postgresql/postgresql.factor

@@ -5,40 +5,39 @@ 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 tools.walker
-namespaces.lib ;
+namespaces.lib accessors ;
 IN: db.postgresql
 
-TUPLE: postgresql-db host port pgopts pgtty db user pass ;
-TUPLE: postgresql-statement ;
-INSTANCE: postgresql-statement throwable-statement
-TUPLE: postgresql-result-set ;
+TUPLE: postgresql-db < db
+    host port pgopts pgtty db user pass ;
+
+TUPLE: postgresql-statement < throwable-statement ;
+
+TUPLE: postgresql-result-set < result-set ;
+
 : <postgresql-statement> ( statement in out -- postgresql-statement )
-    <statement>
-    postgresql-statement construct-delegate ;
+    postgresql-statement construct-statement ;
 
 M: postgresql-db make-db* ( seq tuple -- db )
-    >r first4 r> [
-        {
-            set-postgresql-db-host
-            set-postgresql-db-user
-            set-postgresql-db-pass
-            set-postgresql-db-db
-        } set-slots
-    ] keep ;
+    >r first4 r>
+        swap >>db
+        swap >>pass
+        swap >>user
+        swap >>host ;
 
-M: postgresql-db db-open ( db -- )
-        dup {
-        postgresql-db-host
-        postgresql-db-port
-        postgresql-db-pgopts
-        postgresql-db-pgtty
-        postgresql-db-db
-        postgresql-db-user
-        postgresql-db-pass
-    } get-slots connect-postgres <db> swap set-delegate ;
+M: postgresql-db db-open ( db -- db )
+    dup {
+        [ host>> ]
+        [ port>> ]
+        [ pgopts>> ]
+        [ pgtty>> ]
+        [ db>> ]
+        [ user>> ]
+        [ pass>> ]
+    } cleave connect-postgres >>handle ;
 
 M: postgresql-db dispose ( db -- )
-    db-handle PQfinish ;
+    handle>> PQfinish ;
 
 M: postgresql-statement bind-statement* ( statement -- )
     drop ;
@@ -50,10 +49,10 @@ M: postgresql-statement bind-tuple ( tuple statement -- )
     ] keep set-statement-bind-params ;
 
 M: postgresql-result-set #rows ( result-set -- n )
-    result-set-handle PQntuples ;
+    handle>> PQntuples ;
 
 M: postgresql-result-set #columns ( result-set -- n )
-    result-set-handle PQnfields ;
+    handle>> PQnfields ;
 
 M: postgresql-result-set row-column ( result-set column -- obj )
     >r dup result-set-handle swap result-set-n r> pq-get-string ;
@@ -69,7 +68,7 @@ M: postgresql-statement query-results ( query -- result-set )
     ] [
         dup do-postgresql-statement
     ] if*
-    postgresql-result-set <result-set>
+    postgresql-result-set construct-result-set
     dup init-result-set ;
 
 M: postgresql-result-set advance-row ( result-set -- )
@@ -90,7 +89,7 @@ M: postgresql-result-set dispose ( result-set -- )
 
 M: postgresql-statement prepare-statement ( statement -- )
     [
-        >r db get db-handle "" r>
+        >r db get handle>> "" r>
         dup statement-sql swap statement-in-params
         length f PQprepare postgresql-error
     ] keep set-statement-handle ;