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 'with-database 'scheme-indent-function 2))
(eval . (put 'call-with-transaction '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 'call-with-container 'scheme-indent-function 1))
(eval . (put 'container-excursion '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) (sqlite-reset stmt)
((@ (sqlite3) sqlite-finalize) 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) (define (last-insert-row-id db)
;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'. ;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'.
;; Work around that. ;; Work around that.
(let* ((stmt (sqlite-prepare db "SELECT last_insert_rowid();" (with-statement db "SELECT last_insert_rowid();" stmt
#:cache? #t)) (match (sqlite-fold cons '() stmt)
(result (sqlite-fold cons '() stmt)))
(sqlite-finalize stmt)
(match result
((#(id)) id) ((#(id)) id)
(_ #f)))) (_ #f))))
@ -158,13 +170,11 @@ (define path-id-sql
(define* (path-id db path) (define* (path-id db path)
"If PATH exists in the 'ValidPaths' table, return its numerical "If PATH exists in the 'ValidPaths' table, return its numerical
identifier. Otherwise, return #f." 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) (sqlite-bind-arguments stmt #:path path)
(let ((result (sqlite-fold cons '() stmt))) (match (sqlite-fold cons '() stmt)
(sqlite-finalize stmt)
(match result
((#(id) . _) id) ((#(id) . _) id)
(_ #f))))) (_ #f))))
(define update-sql (define update-sql
"UPDATE ValidPaths SET hash = :hash, registrationTime = :time, deriver = "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." of course. Returns the row id of the row that was modified or inserted."
(let ((id (path-id db path))) (let ((id (path-id db path)))
(if id (if id
(let ((stmt (sqlite-prepare db update-sql #:cache? #t))) (with-statement db update-sql stmt
(sqlite-bind-arguments stmt #:id id (sqlite-bind-arguments stmt #:id id
#:deriver deriver #:deriver deriver
#:hash hash #:size nar-size #:time time) #:hash hash #:size nar-size #:time time)
(sqlite-fold cons '() stmt) (sqlite-fold cons '() stmt))
(sqlite-finalize stmt) (with-statement db insert-sql stmt
(last-insert-row-id db))
(let ((stmt (sqlite-prepare db insert-sql #:cache? #t)))
(sqlite-bind-arguments stmt (sqlite-bind-arguments stmt
#:path path #:deriver deriver #:path path #:deriver deriver
#:hash hash #:size nar-size #:time time) #:hash hash #:size nar-size #:time time)
(sqlite-fold cons '() stmt) ;execute it (sqlite-fold cons '() stmt)))
(sqlite-finalize stmt) (last-insert-row-id db)))
(last-insert-row-id db)))))
(define add-reference-sql (define add-reference-sql
"INSERT OR REPLACE INTO Refs (referrer, reference) VALUES (:referrer, :reference);") "INSERT OR REPLACE INTO Refs (referrer, reference) VALUES (:referrer, :reference);")
@ -202,15 +209,13 @@ (define add-reference-sql
(define (add-references db referrer references) (define (add-references db referrer references)
"REFERRER is the id of the referring store item, REFERENCES is a list "REFERRER is the id of the referring store item, REFERENCES is a list
ids of items referred to." 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) (for-each (lambda (reference)
(sqlite-reset stmt) (sqlite-reset stmt)
(sqlite-bind-arguments stmt #:referrer referrer (sqlite-bind-arguments stmt #:referrer referrer
#:reference reference) #:reference reference)
(sqlite-fold cons '() stmt) ;execute it (sqlite-fold cons '() stmt))
(last-insert-row-id db)) references)))
references)
(sqlite-finalize stmt)))
(define* (sqlite-register db #:key path (references '()) (define* (sqlite-register db #:key path (references '())
deriver hash nar-size time) deriver hash nar-size time)