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

extra/db/errors/errors.factor

@@ -0,0 +1,11 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel ;
+IN: db.errors
+
+ERROR: db-error ;
+ERROR: sql-error ;
+
+
+ERROR: table-exists ;
+ERROR: bad-schema ;

extra/db/queries/queries.factor

@@ -1,9 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel math namespaces sequences random
-strings
+strings math.parser math.intervals combinators
-math.bitfields.lib namespaces.lib db db.tuples db.types
+math.bitfields.lib namespaces.lib db db.tuples db.types ;
-math.intervals ;
 IN: db.queries
 
 GENERIC: where ( specs obj -- )
@@ -15,7 +14,7 @@ GENERIC: where ( specs obj -- )
 
 : query-make ( class quot -- )
     >r sql-props r>
-    [ 0 sql-counter rot with-variable ";" 0% ] { "" { } { } } nmake
+    [ 0 sql-counter rot with-variable ] { "" { } { } } nmake
     <simple-statement> maybe-make-retryable ; inline
 
 M: db begin-transaction ( -- ) "BEGIN" sql-command ;
@@ -127,3 +126,35 @@ M: db <select-by-slots-statement> ( tuple class -- statement )
         " from " 0% 0%
         where-clause
     ] query-make ;
+
+: do-group ( tuple groups -- )
+    [
+        ", " join " group by " prepend append
+    ] curry change-sql drop ;
+
+: do-order ( tuple order -- )
+    [
+        ", " join " order by " prepend append
+    ] curry change-sql drop ;
+
+: do-offset ( tuple n -- )
+    [
+        number>string " offset " prepend append
+    ] curry change-sql drop ;
+
+: do-limit ( tuple n -- )
+    [
+        number>string " limit " prepend append
+    ] curry change-sql drop ;
+
+: make-advanced-statement ( tuple advanced -- )
+    {
+        [ group>> [ do-group ] [ drop ] if* ]
+        [ order>> [ do-order ] [ drop ] if* ]
+        [ limit>> [ do-limit ] [ drop ] if* ]
+        [ offset>> [ do-offset ] [ drop ] if* ]
+    } 2cleave ;
+
+M: db <advanced-select-statement> ( tuple class advanced -- tuple )
+    >r <select-by-slots-statement> r>
+    dupd make-advanced-statement ;

extra/db/sqlite/lib/lib.factor

@@ -4,24 +4,25 @@ USING: alien.c-types arrays assocs kernel math math.parser
 namespaces sequences db.sqlite.ffi db combinators
 continuations db.types calendar.format serialize
 io.streams.byte-array byte-arrays io.encodings.binary
-io.backend ;
+io.backend db.errors ;
 IN: db.sqlite.lib
 
-: sqlite-error ( n -- * )
+ERROR: sqlite-error < db-error n string ;
-    sqlite-error-messages nth throw ;
+ERROR: sqlite-sql-error < sql-error n string ;
 
-: sqlite-statement-error-string ( -- str )
+: throw-sqlite-error ( n -- * )
-    db get db-handle sqlite3_errmsg ;
+    dup sqlite-error-messages nth sqlite-error ;
 
 : sqlite-statement-error ( -- * )
-    sqlite-statement-error-string throw ;
+    SQLITE_ERROR
+    db get db-handle sqlite3_errmsg sqlite-sql-error ;
 
 : sqlite-check-result ( n -- )
     {
-        { [ dup SQLITE_OK = ] [ drop ] }
+        { SQLITE_OK [ ] }
-        { [ dup SQLITE_ERROR = ] [ sqlite-statement-error ] }
+        { SQLITE_ERROR [ sqlite-statement-error ] }
-        [ sqlite-error ]
+        [ throw-sqlite-error ]
-    } cond ;
+    } case ;
 
 : sqlite-open ( path -- db )
     normalize-path

extra/db/tuples/tuples.factor

@@ -42,6 +42,8 @@ HOOK: <insert-user-assigned-statement> db ( class -- obj )
 HOOK: <update-tuple-statement> db ( class -- obj )
 HOOK: <delete-tuples-statement> db ( tuple class -- obj )
 HOOK: <select-by-slots-statement> db ( tuple class -- tuple )
+TUPLE: advanced-statement group order offset limit ;
+HOOK: <advanced-select-statement> db ( tuple class advanced -- tuple )
 
 HOOK: insert-tuple* db ( tuple statement -- )
 
@@ -75,7 +77,7 @@ M: retryable execute-statement* ( statement type -- )
     ] curry 10 retry drop ;
 
 : resulting-tuple ( row out-params -- tuple )
-    dup first class>> new [
+    dup peek class>> new [
         [
             >r slot-name>> r> set-slot-named
         ] curry 2each