Re: Cuirass news

[Danny Milosavljevic]

Hi Ludo,

> Yes, I was unhappy with that, glad you fixed it.  :-)

I've now forked guile-sqlite3 and put the stuff that makes sense for a
low-level binding there (not sqlite-exec - that would still be in guix-cuirass).

These are:
- stmts hash-table is now in guile-sqlite3's <db>.
- sqlite-finalize adapted to update <db>'s stmts list
- sqlite-finalize* variant which doesn't update <db>'s stmts list
(because the updating by value is slow)
- sqlite-prepare* macro which stores and reuses existing <stmt>s.
- sqlite-bind-args convenience function which just binds all the parameters
in sequence.
- SQLITE_CONSTRAINT and SQLITE_CONSTRAINT_PRIMARYKEY, moved from guix-cuirass

https://notabug.org/dannym/guile-sqlite3

If that's OK I'll replace the reference in guix-master, or we could do a
pull request to the civodul repository.

diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm
index 50b7170ee..069009336 100644
--- a/gnu/packages/guile.scm
+++ b/gnu/packages/guile.scm
@@ -1114,7 +1114,7 @@ Guile's foreign function interface.")
   (deprecated-package "guile2.2-gdbm-ffi" guile-gdbm-ffi))
 
 (define-public guile-sqlite3
-  (let ((commit "3ac2ee190937a236eb374230606bdce0cfac2992"))
+  (let ((commit "12348a0f58821e10ec571c8595064fc31964a307"))
     (package
       (name "guile-sqlite3")
       (version (string-append "0.0-1." (string-take commit 7)))
@@ -1130,7 +1130,7 @@ Guile's foreign function interface.")
                       (commit commit)))
                 (sha256
                  (base32
-                  "011yy4435c2z6cmyfcjdailj6gsnl9cv84kp971nijskpk09lbk3"))
+                  "1qisy7pf3amfzipkk38b7jylzdvl6951wkn6bazs8i2kzc90y48f"))
                 (file-name (string-append name "-" version "-checkout"))
                 (modules '((guix build utils)))
                 (snippet


> We don’t need mutexes: a given <db> is only ever used from one thread at
> a time.

Oh okay, then we can even disable the mutexes on the sqlite side
(there's a NOMUTEX flag on sqlite-open).

> I’m not sure what ‘sqlsym’ is.  Apparently it’s a symbol derived from
> the SQL statement, right?  I don’t think it’s necessary.

Yes, the idea is to prevent it from having to do string comparison/hashing
to find an existing stmt.  It's interned at macro-expansion time - so at
runtime it shouldn't traverse the sql text after the stmt is created.

> Instead you can simply make that hash table a regular (non-weak) hash
> table that maps strings (SQL text) to prepared statements.  You’d also
> need to use ‘hash-set!’ and ‘hash-ref’ instead of ‘hashq-set!’ and
> ‘hash-ref’ since strings should be compared with ‘equal?’, not ‘eq?’.

That's what I tried to avoid, having it compare 80 character strings
every time I want to reuse a prepared statement. :-)

What I wanted more is something like a new thread-local variable being
declared every time a new SQL statement is used, otherwise the existing
variable being used.

In the analogy, the variable would be named like the SQL text and reused
if the text is the same.

It's like manually having

(let ((select-*-from-a (stmt "select * from a"))
      (select-*-from-b (stmt "select * from b")))
  ... your program)

> However, could the hash table grow indefinitely if there are always new
> statements prepared?

That's why the macro has a special case only for string literals.

If it's a non-literal string, it will not hash it and it will not reuse
the prepared statement either.

>   (for-each (match-lambda
>               ((i arg)
>                (sqlite-bind stmt (1+ i) arg)))
>             (iota (length args))
>             args)

Nice!

> I think we can turn ‘sqlite-exec’ back into a procedure.  The only
> reason to make it a macro was to have -Wformat support, as noted in the
> comment.

The reason is now different ;-)

> Could you prepare an updated patch to address these and to remove the
> mutex?

Removed mutex.

If possible, let's put guile-sqlite3 stuff there - otherwise there will be 
xtra records around (I've pushed those to my fork already).

Corresponding changes for guix-cuirass, starting from
commit 4558d1c86914e2427fc99afbe00c28cb716dbd3d:

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 5ca3ad3..b3b1674 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -46,35 +46,38 @@
             db-get-builds
             read-sql-file
             read-quoted-string
-            sqlite-exec
+            sqlite-exec ; for tests only
             ;; Parameters.
             %package-database
             %package-schema-file
             ;; Macros.
             with-database))
 
-(define (%sqlite-exec db sql)
-  (let* ((stmt (sqlite-prepare db sql))
-         (res  (let loop ((res '()))
-                 (let ((row (sqlite-step stmt)))
-                   (if (not row)
-                       (reverse! res)
-                       (loop (cons row res)))))))
-    (sqlite-finalize stmt)
-    res))
+(define (sqlite-fetch-all stmt)
+  (reverse! (sqlite-fold cons '() stmt)))
 
 (define-syntax sqlite-exec
-  ;; Note: Making it a macro so -Wformat can do its job.
   (lambda (s)
-    "Wrap 'sqlite-prepare', 'sqlite-step', and 'sqlite-finalize'.  Send to 
given
-SQL statement to DB.  FMT and ARGS are passed to 'format'."
     (syntax-case s ()
-      ((_ db fmt args ...)
-       #'(%sqlite-exec db (format #f fmt args ...)))
-      (id
-       (identifier? #'id)
-       #'(lambda (db fmt . args)
-           (%sqlite-exec db (apply format #f fmt args)))))))
+     ((_ db sqltext arg ...) (string? (syntax->datum #'sqltext))
+      #`(let* ((stmt (sqlite-prepare* db sqltext arg ...)))
+          (sqlite-fetch-all stmt)))
+     ((_ db sqltext) (string? (syntax->datum #'sqltext))
+      #`(let* ((stmt (sqlite-prepare* db sqltext)))
+          (sqlite-fetch-all stmt)))
+     ((_ db sqltext arg ...)
+      #`(let ((stmt (sqlite-prepare db sqltext)))
+          (sqlite-bind-args stmt (list arg ...))
+          (let ((result (sqlite-fetch-all stmt)))
+            (sqlite-finalize* stmt)
+            result)))
+     (id (identifier? #'id)
+      #'(lambda (db sqltext . args)
+          (let ((stmt (sqlite-prepare db sqltext)))
+            (sqlite-bind-args stmt args)
+            (let ((result (sqlite-fetch-all stmt)))
+              (sqlite-finalize* stmt)
+              result)))))))
 
 (define %package-database
   ;; Define to the database file name of this package.
@@ -144,9 +147,11 @@ database object."
   (apply sqlite-exec db "\
 INSERT OR IGNORE INTO Specifications (repo_name, url, load_path, file, \
                   proc, arguments, branch, tag, revision, no_compile_p) \
-  VALUES ('~A', '~A', '~A', '~A', '~S', '~S', '~A', '~A', '~A', ~A);"
+  VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?);"
          (append
-          (assq-refs spec '(#:name #:url #:load-path #:file #:proc 
#:arguments))
+          (assq-refs spec '(#:name #:url #:load-path #:file))
+          (map symbol->string (assq-refs spec '(#:proc)))
+          (map object->string (assq-refs spec '(#:arguments)))
           (assq-refs spec '(#:branch #:tag #:commit) "NULL")
           (list (if (assq-ref spec #:no-compile?) "1" "0"))))
   (last-insert-rowid db))
@@ -175,20 +180,21 @@ INSERT OR IGNORE INTO Specifications (repo_name, url, 
load_path, file, \
   "Store a derivation result in database DB and return its ID."
   (sqlite-exec db "\
 INSERT OR IGNORE INTO Derivations (derivation, job_name, system, nix_name, 
evaluation)\
-  VALUES ('~A', '~A', '~A', '~A', '~A');"
+  VALUES (?, ?, ?, ?, ?);"
                (assq-ref job #:derivation)
                (assq-ref job #:job-name)
                (assq-ref job #:system)
                (assq-ref job #:nix-name)
-               (assq-ref job #:eval-id)))
+               (assq-ref job #:eval-id))
+  (last-insert-rowid db))
 
 (define (db-get-derivation db id)
   "Retrieve a job in database DB which corresponds to ID."
-  (car (sqlite-exec db "SELECT * FROM Derivations WHERE derivation='~A';" id)))
+  (car (sqlite-exec db "SELECT * FROM Derivations WHERE derivation=?;" id)))
 
 (define (db-add-evaluation db eval)
   (sqlite-exec db "\
-INSERT INTO Evaluations (specification, revision) VALUES ('~A', '~A');"
+INSERT INTO Evaluations (specification, revision) VALUES (?, ?);"
                (assq-ref eval #:specification)
                (assq-ref eval #:revision))
   (last-insert-rowid db))
@@ -235,7 +241,7 @@ in the OUTPUTS table."
   (let* ((build-exec
           (sqlite-exec db "\
 INSERT INTO Builds (derivation, evaluation, log, status, timestamp, starttime, 
stoptime)\
-  VALUES ('~A', '~A', '~A', '~A', '~A', '~A', '~A');"
+  VALUES (?, ?, ?, ?, ?, ?, ?);"
                        (assq-ref build #:derivation)
                        (assq-ref build #:eval-id)
                        (assq-ref build #:log)
@@ -249,7 +255,7 @@ INSERT INTO Builds (derivation, evaluation, log, status, 
timestamp, starttime, s
                 (match output
                   ((name . path)
                    (sqlite-exec db "\
-INSERT INTO Outputs (build, name, path) VALUES ('~A', '~A', '~A');"
+INSERT INTO Outputs (build, name, path) VALUES (?, ?, ?);"
                                 build-id name path))))
               (assq-ref build #:outputs))
     build-id))
@@ -262,17 +268,17 @@ log file for DRV."
     (time-second (current-time time-utc)))
 
   (if (= status (build-status started))
-      (sqlite-exec db "UPDATE Builds SET starttime='~A', status='~A' \
-WHERE derivation='~A';"
+      (sqlite-exec db "UPDATE Builds SET starttime=?, status=? \
+WHERE derivation=?;"
                    now status drv)
-      (sqlite-exec db "UPDATE Builds SET stoptime='~A', \
-status='~A'address@hidden, log='~A'~] WHERE derivation='~A';"
-                   now status log-file drv)))
+      (if log-file
+          (sqlite-exec db "UPDATE Builds SET stoptime=?, status=?, log=? WHERE 
derivation=?;" now status log-file drv)
+          (sqlite-exec db "UPDATE Builds SET stoptime=?, status=? WHERE 
derivation=?;" now status drv))))
 
 (define (db-get-outputs db build-id)
   "Retrieve the OUTPUTS of the build identified by BUILD-ID in DB database."
   (let loop ((rows
-              (sqlite-exec db "SELECT name, path FROM Outputs WHERE 
build='~A';"
+              (sqlite-exec db "SELECT name, path FROM Outputs WHERE build=?;"
                            build-id))
              (outputs '()))
     (match rows
@@ -313,7 +319,7 @@ INNER JOIN Specifications ON Evaluations.specification = 
Specifications.repo_nam
 (define (db-get-build db id)
   "Retrieve a build in database DB which corresponds to ID."
   (let ((res (sqlite-exec db (string-append db-build-request
-                                            " WHERE Builds.id='~A';") id)))
+                                            " WHERE Builds.id=?;") id)))
     (match res
       ((build)
        (db-format-build db build))
@@ -393,7 +399,7 @@ FILTERS is an assoc list which possible keys are 'project | 
'jobset | 'job |
 
 (define (db-get-stamp db spec)
   "Return a stamp corresponding to specification SPEC in database DB."
-  (let ((res (sqlite-exec db "SELECT * FROM Stamps WHERE specification='~A';"
+  (let ((res (sqlite-exec db "SELECT * FROM Stamps WHERE specification=?;"
                           (assq-ref spec #:name))))
     (match res
       (() "")
@@ -403,10 +409,10 @@ FILTERS is an assoc list which possible keys are 'project 
| 'jobset | 'job |
   "Associate stamp COMMIT to specification SPEC in database DB."
   (if (string-null? (db-get-stamp db spec))
       (sqlite-exec db "\
-INSERT INTO Stamps (specification, stamp) VALUES ('~A', '~A');"
+INSERT INTO Stamps (specification, stamp) VALUES (?, ?);"
                    (assq-ref spec #:name)
                    commit)
       (sqlite-exec db "\
-UPDATE Stamps SET stamp='~A' WHERE specification='~A';"
+UPDATE Stamps SET stamp=? WHERE specification=?;"
                    commit
                    (assq-ref spec #:name))))