1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
| | ;;; Copyright © 2017 Caleb Ristvedt <caleb.ristvedt@cune.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix sql)
#:use-module (sqlite3)
#:use-module (system foreign)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-9)
#:export (sqlite-last-insert-rowid
sql-parameters
with-sql-statement
with-sql-database
run-sql
run-statement
single-result)
#:re-export (sqlite-step
sqlite-fold
sqlite-fold-right
sqlite-map
sqlite-prepare
sqlite-reset
sqlite-finalize))
;; Miscellaneous SQL stuff, currently just setup for sqlite-register. Mostly
;; macros.
;; This really belongs in guile-sqlite3, as can be seen from the @@s.
(define sqlite-last-insert-rowid
(let ((last-rowid (pointer->procedure
int
(dynamic-func "sqlite3_last_insert_rowid"
(@@ (sqlite3) libsqlite3))
(list '*))))
(lambda (db)
"Gives the row id of the last inserted row in DB."
(last-rowid ((@@ (sqlite3) db-pointer) db)))))
(define sqlite-parameter-index
(let ((param-index (pointer->procedure
int
(dynamic-func "sqlite3_bind_parameter_index"
(@@ (sqlite3) libsqlite3))
(list '* '*))))
(lambda (statement key)
"Gives the index of an sqlite parameter for a certain statement with a
certain (string) name."
(param-index ((@@ (sqlite3) stmt-pointer) statement)
(string->pointer key "utf-8")))))
(define-syntax sql-parameters
(syntax-rules ()
"Converts key-value pairs into sqlite bindings for a specific statement."
((sql-parameters statement (name1 val1) (name2 val2) (name3 val3) ...)
(begin (sqlite-bind statement
(sqlite-parameter-index statement name1)
val1)
(sql-parameters statement (name2 val2) (name3 val3) ...)))
((sql-parameters statement (name value))
(sqlite-bind statement
(sqlite-parameter-index statement name)
value))))
(define* (step-all statement #:optional (callback noop))
"Step until statement is completed. Return number of rows."
;; Where "number of rows" is assumed to be number of steps taken, excluding
;; the last one.
(let maybe-step ((ret (sqlite-step statement))
(count 0))
(if ret
(maybe-step (sqlite-step statement) (+ count 1))
count)))
;; I get the feeling schemers have probably already got this "with" business
;; much more automated than this...
(define-syntax with-sql-statement
(syntax-rules ()
"Automatically prepares statements and then finalizes statements once the
scope of this macro is left. Also with built-in sqlite parameter binding via
key-value pairs."
((with-sql-statement db sql statement-var
((name1 val1) (name2 val2) ...)
exps ...)
(let ((statement-var (sqlite-prepare db sql)))
(dynamic-wind noop
(lambda ()
(sql-parameters statement-var
(name1 val1)
(name2 val2) ...)
exps ...)
(lambda ()
(sqlite-finalize statement-var)))))
((with-sql-statement db sql statement-var () exps ...)
(let ((statement-var (sqlite-prepare db sql)))
(dynamic-wind noop
(lambda ()
exps ...)
(lambda ()
(sqlite-finalize statement-var)))))))
(define-syntax with-sql-database
(syntax-rules ()
"Automatically closes the database once the scope of this macro is left."
((with-sql-database location db-var exps ...)
(let ((db-var (sqlite-open location)))
(dynamic-wind noop
(lambda ()
exps ...)
(lambda ()
(sqlite-close db-var)))))))
(define-syntax run-sql
(syntax-rules ()
"For one-off queries that don't get repeated on the same
database. Everything after database and sql source should be 2-element lists
containing the sql placeholder name and the value to use. Returns the number
of rows."
((run-sql db sql (name1 val1) (name2 val2) ...)
(let ((statement (sqlite-prepare db sql)))
(dynamic-wind noop
(lambda ()
(sql-parameters statement
(name1 val1)
(name2 val2) ...)
(step-all statement))
(lambda ()
(sqlite-finalize statement)))))
((run-sql db sql)
(let ((statement (sqlite-prepare db sql)))
(dynamic-wind noop
(lambda ()
(step-all statement))
(lambda ()
(sqlite-finalize statement)))))))
(define-syntax run-statement
(syntax-rules ()
"For compiled statements that may be run multiple times. Everything after
database and sql source should be 2-element lists containing the sql
placeholder name and the value to use. Returns the number of rows."
((run-sql db statement (name1 val1) (name2 val2) ...)
(dynamic-wind noop
(lambda ()
(sql-parameters statement
(name1 val1)
(name2 val2) ...)
(step-all statement))
(lambda ()
(sqlite-reset statement))))
((run-sql db statement)
(dynamic-wind noop
(lambda ()
(step-all statement))
(lambda ()
(sqlite-reset statement))))))
(define (single-result statement)
"Gives the first element of the first row returned by statement."
(let ((row (sqlite-step statement)))
(if row
(vector-ref row 0)
#f)))
|