database: rewrite query procedures in terms of with-statement.

Most of our queries would fail to finalize their statements properly if sqlite
returned an error during their execution.  This resolves that, and also makes
them somewhat more concise as a side-effect.

This also makes some small changes to improve certain queries where behavior
was strange or overly verbose.

* guix/store/database.scm (call-with-statement): new procedure.
  (with-statement): new macro.
  (last-insert-row-id, path-id, update-or-insert, add-references): rewrite to
  use with-statement.
  (update-or-insert): factor last-insert-row-id out of the end of both
  branches.
  (add-references): remove pointless last-insert-row-id call.

* .dir-locals.el (with-statement): add indenting information.
This commit is contained in:
Caleb Ristvedt 2020-06-01 19:21:43 -05:00
parent 3cd92a855e
commit 5d6e225528
No known key found for this signature in database
GPG key ID: C166AA495F7F189C
2 changed files with 30 additions and 24 deletions

View file

@ -89,6 +89,7 @@
(eval . (put 'with-database 'scheme-indent-function 2))
(eval . (put 'call-with-transaction 'scheme-indent-function 2))
(eval . (put 'with-statement 'scheme-indent-function 3))
(eval . (put 'call-with-container 'scheme-indent-function 1))
(eval . (put 'container-excursion 'scheme-indent-function 1))

View file

@ -141,14 +141,26 @@ (define (sqlite-finalize stmt)
(sqlite-reset stmt)
((@ (sqlite3) sqlite-finalize) stmt))
(define (call-with-statement db sql proc)
(let ((stmt (sqlite-prepare db sql #:cache? #t)))
(dynamic-wind
(const #t)
(lambda ()
(proc stmt))
(lambda ()
(sqlite-finalize stmt)))))
(define-syntax-rule (with-statement db sql stmt exp ...)
"Run EXP... with STMT bound to a prepared statement corresponding to the sql
string SQL for DB."
(call-with-statement db sql
(lambda (stmt) exp ...)))
(define (last-insert-row-id db)
;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'.
;; Work around that.
(let* ((stmt (sqlite-prepare db "SELECT last_insert_rowid();"
#:cache? #t))
(result (sqlite-fold cons '() stmt)))
(sqlite-finalize stmt)
(match result
(with-statement db "SELECT last_insert_rowid();" stmt
(match (sqlite-fold cons '() stmt)
((#(id)) id)
(_ #f))))
@ -158,13 +170,11 @@ (define path-id-sql
(define* (path-id db path)
"If PATH exists in the 'ValidPaths' table, return its numerical
identifier. Otherwise, return #f."
(let ((stmt (sqlite-prepare db path-id-sql #:cache? #t)))
(with-statement db path-id-sql stmt
(sqlite-bind-arguments stmt #:path path)
(let ((result (sqlite-fold cons '() stmt)))
(sqlite-finalize stmt)
(match result
(match (sqlite-fold cons '() stmt)
((#(id) . _) id)
(_ #f)))))
(_ #f))))
(define update-sql
"UPDATE ValidPaths SET hash = :hash, registrationTime = :time, deriver =
@ -181,20 +191,17 @@ (define* (update-or-insert db #:key path deriver hash nar-size time)
of course. Returns the row id of the row that was modified or inserted."
(let ((id (path-id db path)))
(if id
(let ((stmt (sqlite-prepare db update-sql #:cache? #t)))
(with-statement db update-sql stmt
(sqlite-bind-arguments stmt #:id id
#:deriver deriver
#:hash hash #:size nar-size #:time time)
(sqlite-fold cons '() stmt)
(sqlite-finalize stmt)
(last-insert-row-id db))
(let ((stmt (sqlite-prepare db insert-sql #:cache? #t)))
(sqlite-fold cons '() stmt))
(with-statement db insert-sql stmt
(sqlite-bind-arguments stmt
#:path path #:deriver deriver
#:hash hash #:size nar-size #:time time)
(sqlite-fold cons '() stmt) ;execute it
(sqlite-finalize stmt)
(last-insert-row-id db)))))
(sqlite-fold cons '() stmt)))
(last-insert-row-id db)))
(define add-reference-sql
"INSERT OR REPLACE INTO Refs (referrer, reference) VALUES (:referrer, :reference);")
@ -202,15 +209,13 @@ (define add-reference-sql
(define (add-references db referrer references)
"REFERRER is the id of the referring store item, REFERENCES is a list
ids of items referred to."
(let ((stmt (sqlite-prepare db add-reference-sql #:cache? #t)))
(with-statement db add-reference-sql stmt
(for-each (lambda (reference)
(sqlite-reset stmt)
(sqlite-bind-arguments stmt #:referrer referrer
#:reference reference)
(sqlite-fold cons '() stmt) ;execute it
(last-insert-row-id db))
references)
(sqlite-finalize stmt)))
(sqlite-fold cons '() stmt))
references)))
(define* (sqlite-register db #:key path (references '())
deriver hash nar-size time)