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.

.dir-locals.el

@@ -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))

guix/store/database.scm

@@ -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();"
+  (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)
       (_ #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)))
+    (match (sqlite-fold cons '() stmt)
-      (sqlite-finalize stmt)
+      ((#(id) . _) id)
-      (match result
+      (_ #f))))
-        ((#(id) . _) id)
-        (_ #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-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
                                  #:path path #:deriver deriver
                                  #: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
   "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
+                (sqlite-fold cons '() stmt))
-                (last-insert-row-id db))
+              references)))
-              references)
-    (sqlite-finalize stmt)))
 
 (define* (sqlite-register db #:key path (references '())
                           deriver hash nar-size time)