05/19: guix: sql.scm: split into generic and store-specific parts.

[guix-commits]

reepca pushed a commit to branch guile-daemon
in repository guix.

commit b27f6fa5bbaf2e4955fdc1b893af031c55fb75fe
Author: Caleb Ristvedt <address@hidden>
Date:   Mon Jun 5 21:31:24 2017 -0500

    guix: sql.scm: split into generic and store-specific parts.
    
    * guix/sql.scm (path-id-sql, path-id, update-sql, insert-sql,
      update-or-insert, add-reference-sql, add-references, sqlite-register):
      removed.
      (sqlite-parameter-index): new procedure.
      (sqlite-parameters): use sqlite-parameter-index, works with parameter 
names
      instead of indexes now.  Updated callers.
    * guix/store/database.scm: new file.
      (path-id-sql, path-id, update-sql, insert-sql, update-or-insert,
      add-reference-sql, add-references, sqlite-register): added.
    * guix/store.scm: use (guix store database) instead of (guix sql).
---
 guix/sql.scm   | 134 ++++++++++++++-------------------------------------------
 guix/store.scm |   2 +-
 2 files changed, 34 insertions(+), 102 deletions(-)

diff --git a/guix/sql.scm b/guix/sql.scm
index d5c7210..6b6f786 100644
--- a/guix/sql.scm
+++ b/guix/sql.scm
@@ -21,7 +21,20 @@
   #:use-module (system foreign)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-9)
-  #:export (sqlite-register))
+  #: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.
@@ -37,16 +50,31 @@
       "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")))))
+
 
-;; Should I go from key->index here or try to change that in guile-sqlite3?
 (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 name1 val1)
+     (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 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."
@@ -141,8 +169,7 @@ placeholder name and the value to use. Returns the number 
of rows."
                    (lambda ()
                      (sqlite-reset statement))))))
 
-(define path-id-sql
-  "SELECT id FROM ValidPaths WHERE path = $path")
+
 
 (define (single-result statement)
   "Gives the first element of the first row returned by statement."
@@ -150,98 +177,3 @@ placeholder name and the value to use. Returns the number 
of rows."
     (if row
         (vector-ref row 0)
         #f)))
-
-(define* (path-id db path)
-  "If the path \"path\" exists in the ValidPaths table, return its
-id. Otherwise, return #f. If you already have a compiled statement for this
-purpose, you can give it as statement."
-  (with-sql-statement
-      db path-id-sql statement
-      (;("$path" path)
-       (1 path))
-      (single-result statement)))
-
-
-(define update-sql
-  "UPDATE ValidPaths SET hash = $hash, registrationTime = $time, deriver =
-$deriver, narSize = $size WHERE id = $id")
-
-(define insert-sql
-  "INSERT INTO ValidPaths (path, hash, registrationTime, deriver, narSize)
-VALUES ($path, $hash, $time, $deriver, $size)")
-
-(define* (update-or-insert #:key db path deriver hash nar-size time)
-  "The classic update-if-exists and insert-if-doesn't feature that sqlite
-doesn't exactly have... they've got something close, but it involves deleting
-and re-inserting instead of updating, which causes problems with foreign keys,
-of course. Returns the row id of the row that was modified or inserted."
-  (let ((id (path-id db path)))
-    (if id
-        (begin
-          (run-sql
-              db update-sql
-              ;; As you may have noticed, sqlite-bind doesn't behave
-              ;; exactly how I was expecting...
-              ;; ("$id" id)
-              ;; ("$deriver" deriver)
-              ;; ("$hash" hash)
-              ;; ("$size" nar-size)
-              ;; ("$time" time)
-              (5 id)
-              (3 deriver)
-              (1 hash)
-              (4 nar-size)
-              (2 time))
-          id)
-        (begin
-          (run-sql
-              db insert-sql
-              ;; ("$path" path)
-              ;; ("$deriver" deriver)
-              ;; ("$hash" hash)
-              ;; ("$size" nar-size)
-              ;; ("$time" time)
-              (1 path)
-              (4 deriver)
-              (2 hash)
-              (5 nar-size)
-              (3 time))
-          (sqlite-last-insert-rowid db)))))
-
-(define add-reference-sql
-  "INSERT OR IGNORE INTO Refs (referrer, reference) SELECT $referrer, id
-FROM ValidPaths WHERE path = $reference")
-
-(define (add-references db referrer references)
-  "referrer is the id of the referring store item, references is a list
-containing store item paths being referred to. Note that all of the store
-items in \"references\" should already be registered."
-  (with-sql-statement
-      db add-reference-sql add-reference-statement ()
-      (for-each (lambda (reference)
-                  (run-statement
-                      db add-reference-statement
-                                        ;("$referrer" referrer)
-                                        ;("$reference" reference)
-                      (1 referrer)
-                      (2 reference)))
-                references)))
-
-;; XXX figure out caching of statement and database objects... later
-(define* (sqlite-register #:key dbpath path references deriver hash nar-size)
-  "Registers this stuff in a database specified by DBPATH. PATH is the string
-path of some store item, REFERENCES is a list of string paths which the store
-item PATH refers to (they need to be already registered!), DERIVER is a string
-path of the derivation that created the store item PATH, HASH is the
-base16-encoded sha256 hash of the store item denoted by PATH (prefixed with
-\"sha256:\") after being converted to nar form, and nar-size is the size in
-bytes of the store item denoted by PATH after being converted to nar form."
-  (with-sql-database
-      dbpath db
-      (let ((id (update-or-insert #:db db
-                                  #:path path
-                                  #:deriver deriver
-                                  #:hash hash
-                                  #:nar-size nar-size
-                                  #:time (current-time))))
-     (add-references db id references))))
diff --git a/guix/store.scm b/guix/store.scm
index adb0382..ca01b2a 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -51,7 +51,7 @@
   #:use-module (ice-9 format)
   #:use-module (web uri)
   #:use-module (sqlite3)
-  #:use-module (guix sql)
+  #:use-module (guix store database)
   #:export (%daemon-socket-uri
             %gc-roots-directory
             %default-substitute-urls