1 ! Copyright (C) 2005, 2008 Chris Double, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien arrays assocs classes compiler db hashtables
4 io.files kernel math math.parser namespaces prettyprint
5 sequences strings classes.tuple alien.c-types continuations
6 db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators
7 math.intervals io nmake accessors vectors math.ranges random
8 math.bitwise db.queries destructors ;
11 TUPLE: sqlite-db < db path ;
13 M: sqlite-db make-db* ( path db -- db )
16 M: sqlite-db db-open ( db -- db )
17 dup path>> sqlite-open >>handle ;
19 M: sqlite-db db-close ( handle -- ) sqlite-close ;
20 M: sqlite-db dispose ( db -- ) db-dispose ;
22 TUPLE: sqlite-statement < statement ;
24 TUPLE: sqlite-result-set < result-set has-more? ;
26 M: sqlite-db <simple-statement> ( str in out -- obj )
27 <prepared-statement> ;
29 M: sqlite-db <prepared-statement> ( str in out -- obj )
30 sqlite-statement construct-statement ;
32 : sqlite-maybe-prepare ( statement -- statement )
34 db get handle>> over sql>> sqlite-prepare
38 M: sqlite-statement dispose ( statement -- )
40 [ [ sqlite3_reset drop ] keep sqlite-finalize ] when* ;
42 M: sqlite-result-set dispose ( result-set -- )
45 : reset-statement ( statement -- )
46 sqlite-maybe-prepare handle>> sqlite-reset ;
48 : reset-bindings ( statement -- )
50 handle>> [ sqlite3_reset drop ] [ sqlite3_clear_bindings drop ] bi ;
52 M: sqlite-statement low-level-bind ( statement -- )
53 [ bind-params>> ] [ handle>> ] bi
54 [ swap [ key>> ] [ value>> ] [ type>> ] tri sqlite-bind-type ] curry each ;
56 M: sqlite-statement bind-statement* ( statement -- )
58 dup bound?>> [ dup reset-bindings ] when
61 GENERIC: sqlite-bind-conversion ( tuple obj -- array )
63 TUPLE: sqlite-low-level-binding < low-level-binding key type ;
64 : <sqlite-low-level-binding> ( key value type -- obj )
65 sqlite-low-level-binding new
70 M: sql-spec sqlite-bind-conversion ( tuple spec -- array )
71 [ column-name>> ":" prepend ]
72 [ slot-name>> rot get-slot-named ]
73 [ type>> ] tri <sqlite-low-level-binding> ;
75 M: literal-bind sqlite-bind-conversion ( tuple literal-bind -- array )
76 nip [ key>> ] [ value>> ] [ type>> ] tri
77 <sqlite-low-level-binding> ;
79 M: generator-bind sqlite-bind-conversion ( tuple generate-bind -- array )
81 [ generator-singleton>> eval-generator tuck ] [ slot-name>> ] bi
83 >r [ key>> ] [ type>> ] bi r> swap <sqlite-low-level-binding> ;
85 M: sqlite-statement bind-tuple ( tuple statement -- )
87 in-params>> [ sqlite-bind-conversion ] with map
88 ] keep bind-statement ;
90 : last-insert-id ( -- id )
91 db get handle>> sqlite3_last_insert_rowid
92 dup zero? [ "last-id failed" throw ] when ;
94 M: sqlite-db insert-tuple* ( tuple statement -- )
95 execute-statement last-insert-id swap set-primary-key ;
97 M: sqlite-result-set #columns ( result-set -- n )
98 handle>> sqlite-#columns ;
100 M: sqlite-result-set row-column ( result-set n -- obj )
101 [ handle>> ] [ sqlite-column ] bi* ;
103 M: sqlite-result-set row-column-typed ( result-set n -- obj )
104 dup pick out-params>> nth type>>
105 >r >r handle>> r> r> sqlite-column-typed ;
107 M: sqlite-result-set advance-row ( result-set -- )
108 dup handle>> sqlite-next >>has-more? drop ;
110 M: sqlite-result-set more-rows? ( result-set -- ? )
113 M: sqlite-statement query-results ( query -- result-set )
115 dup handle>> sqlite-result-set construct-result-set
118 M: sqlite-db create-sql-statement ( class -- statement )
120 "create table " 0% 0%
124 dup type>> lookup-create-type 0%
129 M: sqlite-db drop-sql-statement ( class -- statement )
130 [ "drop table " 0% 0% ";" 0% drop ] query-make ;
132 M: sqlite-db <insert-db-assigned-statement> ( tuple -- statement )
136 remove-db-assigned-id
137 dup [ ", " 0% ] [ column-name>> 0% ] interleave
140 dup type>> +random-id+ = [
143 column-name>> ":" prepend dup 0%
145 ] [ type>> ] tri <generator-bind> 1,
153 M: sqlite-db <insert-user-assigned-statement> ( tuple -- statement )
154 <insert-db-assigned-statement> ;
156 M: sqlite-db bind# ( spec obj -- )
158 [ column-name>> ":" swap next-sql-counter 3append dup 0% ]
160 r> <literal-bind> 1, ;
162 M: sqlite-db bind% ( spec -- )
163 dup 1, column-name>> ":" prepend 0% ;
165 M: sqlite-db persistent-table ( -- assoc )
167 { +db-assigned-id+ { "integer primary key" "integer primary key" "primary key" } }
168 { +user-assigned-id+ { f f "primary key" } }
169 { +random-id+ { "integer primary key" "integer primary key" "primary key" } }
170 { INTEGER { "integer" "integer" "primary key" } }
171 { BIG-INTEGER { "bigint" "bigint" } }
172 { SIGNED-BIG-INTEGER { "bigint" "bigint" } }
173 { UNSIGNED-BIG-INTEGER { "bigint" "bigint" } }
174 { TEXT { "text" "text" } }
175 { VARCHAR { "text" "text" } }
176 { DATE { "date" "date" } }
177 { TIME { "time" "time" } }
178 { DATETIME { "datetime" "datetime" } }
179 { TIMESTAMP { "timestamp" "timestamp" } }
180 { DOUBLE { "real" "real" } }
181 { BLOB { "blob" "blob" } }
182 { FACTOR-BLOB { "blob" "blob" } }
183 { URL { "text" "text" } }
184 { +autoincrement+ { f f "autoincrement" } }
185 { +unique+ { f f "unique" } }
186 { +default+ { f f "default" } }
187 { +null+ { f f "null" } }
188 { +not-null+ { f f "not null" } }
189 { system-random-generator { f f f } }
190 { secure-random-generator { f f f } }
191 { random-generator { f f f } }
194 M: sqlite-db compound ( str seq -- str' )
196 { "default" [ first number>string join-space ] }