]> gitweb.factorcode.org Git - factor.git/blob - basis/db/sqlite/lib/lib.factor
core: map-integers -> map-integers-as
[factor.git] / basis / db / sqlite / lib / lib.factor
1 ! Copyright (C) 2008 Chris Double, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types alien.data arrays calendar.format
4 calendar.parser combinators db db.errors db.sqlite.errors
5 db.sqlite.ffi db.types io.backend io.encodings.string
6 io.encodings.utf8 kernel math namespaces present sequences
7 serialize urls ;
8 IN: db.sqlite.lib
9
10 : sqlite-compile-options ( -- seq )
11     0 [
12         [ 1 + ] [ sqlite3_compileoption_get ] bi dup
13     ] [ ] produce 2nip ;
14
15 ERROR: sqlite-error < db-error n string ;
16
17 : sqlite-other-error ( n -- * )
18     dup sqlite-error-messages nth sqlite-error ;
19
20 : sqlite-statement-error ( -- * )
21     db-connection get handle>> sqlite3_errmsg
22     parse-sqlite-sql-error throw ;
23
24 : sqlite-check-result ( n -- )
25     {
26         { SQLITE_OK [ ] }
27         { SQLITE_ERROR [ sqlite-statement-error ] }
28         [ sqlite-other-error ]
29     } case ;
30
31 : sqlite-open ( path -- db )
32     normalize-path
33     { void* } [ sqlite3_open sqlite-check-result ]
34     with-out-parameters ;
35
36 : sqlite-close ( db -- )
37     sqlite3_close sqlite-check-result ;
38
39 : sqlite-prepare ( db sql -- handle )
40     utf8 encode dup length
41     { void* void* }
42     [ sqlite3_prepare_v2 sqlite-check-result ]
43     with-out-parameters drop ;
44
45 : sqlite-bind-parameter-index ( handle name -- index )
46     sqlite3_bind_parameter_index ;
47
48 : parameter-index ( handle name text -- handle name text )
49     [ dupd sqlite-bind-parameter-index ] dip ;
50
51 : sqlite-bind-text ( handle index text -- )
52     utf8 encode dup length SQLITE_TRANSIENT
53     sqlite3_bind_text sqlite-check-result ;
54
55 : sqlite-bind-int ( handle i n -- )
56     sqlite3_bind_int sqlite-check-result ;
57
58 : sqlite-bind-int64 ( handle i n -- )
59     sqlite3_bind_int64 sqlite-check-result ;
60
61 : sqlite-bind-uint64 ( handle i n -- )
62     sqlite3-bind-uint64 sqlite-check-result ;
63
64 : sqlite-bind-double ( handle i x -- )
65     sqlite3_bind_double sqlite-check-result ;
66
67 : sqlite-bind-null ( handle i -- )
68     sqlite3_bind_null sqlite-check-result ;
69
70 : sqlite-bind-blob ( handle i byte-array -- )
71     dup length SQLITE_TRANSIENT
72     sqlite3_bind_blob sqlite-check-result ;
73
74 : sqlite-bind-text-by-name ( handle name text -- )
75     parameter-index sqlite-bind-text ;
76
77 : sqlite-bind-int-by-name ( handle name int -- )
78     parameter-index sqlite-bind-int ;
79
80 : sqlite-bind-int64-by-name ( handle name int64 -- )
81     parameter-index sqlite-bind-int64 ;
82
83 : sqlite-bind-uint64-by-name ( handle name int64 -- )
84     parameter-index sqlite-bind-uint64 ;
85
86 : sqlite-bind-boolean-by-name ( handle name obj -- )
87     >boolean 1 0 ? parameter-index sqlite-bind-int ;
88
89 : sqlite-bind-double-by-name ( handle name double -- )
90     parameter-index sqlite-bind-double ;
91
92 : sqlite-bind-blob-by-name ( handle name blob -- )
93     parameter-index sqlite-bind-blob ;
94
95 : sqlite-bind-null-by-name ( handle name obj -- )
96     parameter-index drop sqlite-bind-null ;
97
98 : (sqlite-bind-type) ( handle key value type -- )
99     dup array? [ first ] when
100     {
101         { INTEGER [ sqlite-bind-int-by-name ] }
102         { BIG-INTEGER [ sqlite-bind-int64-by-name ] }
103         { SIGNED-BIG-INTEGER [ sqlite-bind-int64-by-name ] }
104         { UNSIGNED-BIG-INTEGER [ sqlite-bind-uint64-by-name ] }
105         { BOOLEAN [ sqlite-bind-boolean-by-name ] }
106         { TEXT [ sqlite-bind-text-by-name ] }
107         { VARCHAR [ sqlite-bind-text-by-name ] }
108         { DOUBLE [ sqlite-bind-double-by-name ] }
109         { DATE [ timestamp>ymd sqlite-bind-text-by-name ] }
110         { TIME [ duration>hms sqlite-bind-text-by-name ] }
111         { DATETIME [ timestamp>ymdhms sqlite-bind-text-by-name ] }
112         { TIMESTAMP [ timestamp>ymdhms sqlite-bind-text-by-name ] }
113         { BLOB [ sqlite-bind-blob-by-name ] }
114         { FACTOR-BLOB [ object>bytes sqlite-bind-blob-by-name ] }
115         { URL [ present sqlite-bind-text-by-name ] }
116         { +db-assigned-id+ [ sqlite-bind-int-by-name ] }
117         { +random-id+ [ sqlite-bind-int64-by-name ] }
118         { NULL [ sqlite-bind-null-by-name ] }
119         [ no-sql-type ]
120     } case ;
121
122 : sqlite-bind-type ( handle key value type -- )
123     ! null and empty values need to be set by sqlite-bind-null-by-name
124     over [
125         NULL = [ 2drop NULL NULL ] when
126     ] [
127         drop NULL
128     ] if* (sqlite-bind-type) ;
129
130 : sqlite-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ;
131 : sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ;
132 : sqlite-clear-bindings ( handle -- )
133     sqlite3_clear_bindings sqlite-check-result ;
134 : sqlite-#columns ( query -- int ) sqlite3_column_count ;
135 : sqlite-column ( handle index -- string ) sqlite3_column_text ;
136 : sqlite-column-name ( handle index -- string ) sqlite3_column_name ;
137 : sqlite-column-type ( handle index -- string ) sqlite3_column_type ;
138
139
140 : sqlite3-column-null ( sqlite n obj -- obj/f )
141     [ sqlite3_column_type SQLITE_NULL = f ] dip ? ; inline
142
143 ! sqlite_column_int returns 0 for both a ``0`` and for ``NULL``
144 ! so call sqlite3_column_type if it's 0
145 : sqlite3-column-int ( handle index -- int/f )
146     2dup sqlite3_column_int dup 0 = [ sqlite3-column-null ] [ 2nip ] if ;
147
148 : sqlite3-column-int64 ( handle index -- int/f )
149     2dup sqlite3_column_int64 dup 0 = [ sqlite3-column-null ] [ 2nip ] if ;
150
151 : sqlite3-column-uint64 ( handle index -- int/f )
152     2dup sqlite3_column_uint64 dup 0 = [ sqlite3-column-null ] [ 2nip ] if ;
153
154 : sqlite3-column-double ( handle index -- int/f )
155     2dup sqlite3_column_double dup 0.0 = [ sqlite3-column-null ] [ 2nip ] if ;
156
157 : sqlite-column-blob ( handle index -- byte-array/f )
158     [ sqlite3_column_bytes ] 2keep
159     pick zero? [
160         3drop f
161     ] [
162         sqlite3_column_blob swap memory>byte-array
163     ] if ;
164
165 : sqlite-column-typed ( handle index type -- obj )
166     dup array? [ first ] when
167     {
168         { +db-assigned-id+ [ sqlite3_column_int64  ] }
169         { +random-id+ [ sqlite3-column-uint64 ] }
170         { INTEGER [ sqlite3-column-int ] }
171         { BIG-INTEGER [ sqlite3-column-int64 ] }
172         { SIGNED-BIG-INTEGER [ sqlite3-column-int64 ] }
173         { UNSIGNED-BIG-INTEGER [ sqlite3-column-uint64 ] }
174         { BOOLEAN [ sqlite3-column-int 1 = ] }
175         { DOUBLE [ sqlite3-column-double ] }
176         { TEXT [ sqlite3_column_text ] }
177         { VARCHAR [ sqlite3_column_text ] }
178         { DATE [ sqlite3_column_text dup [ ymd>timestamp ] when ] }
179         { TIME [ sqlite3_column_text dup [ hms>duration ] when ] }
180         { TIMESTAMP [ sqlite3_column_text dup [ ymdhms>timestamp ] when ] }
181         { DATETIME [ sqlite3_column_text dup [ ymdhms>timestamp ] when ] }
182         { BLOB [ sqlite-column-blob ] }
183         { URL [ sqlite3_column_text dup [ >url ] when ] }
184         { FACTOR-BLOB [ sqlite-column-blob dup [ bytes>object ] when ] }
185         [ no-sql-type ]
186     } case ;
187
188 : sqlite-row ( handle -- seq )
189     dup sqlite-#columns [ sqlite-column ] with map-integers ;
190
191 : sqlite-step-has-more-rows? ( prepared -- ? )
192     {
193         { SQLITE_ROW [ t ] }
194         { SQLITE_DONE [ f ] }
195         [ sqlite-check-result f ]
196     } case ;
197
198 : sqlite-next ( prepared -- ? )
199     sqlite3_step sqlite-step-has-more-rows? ;