Enable calling with-sqlite-cache and not storing the computed value

This allows fetching cached items without populating the cache, for example if
you want to fallback to a fixed value if there's no cached one available.

1 files changed, 34 insertions, 32 deletions

diff --git a/guix-qa-frontpage/database.scm b/guix-qa-frontpage/database.scm
index eaacf90..7c1a052 100644
--- a/guix-qa-frontpage/database.scm
+++ b/guix-qa-frontpage/database.scm
@@ -331,7 +331,8 @@ PRAGMA optimize;")))
           proc
           #:key (args '())
           (version 1)
-          ttl)
+          ttl
+          (store-computed-value? #t))
 
   (define string-key
     (call-with-output-string
@@ -384,40 +385,41 @@ SELECT data, timestamp FROM cache WHERE key = :key AND version = :version"
                   proc
                   #:args args))))
           (lambda vals
-            (database-call-with-transaction
-             database
-             (lambda (db)
-               (let ((cleanup-statement
-                      (sqlite-prepare
-                       db
-                       "
+            (when store-computed-value?
+              (database-call-with-transaction
+               database
+               (lambda (db)
+                 (let ((cleanup-statement
+                        (sqlite-prepare
+                         db
+                         "
 DELETE FROM cache WHERE key = :key"
-                       #:cache? #t))
-                     (insert-statement
-                      (sqlite-prepare
-                       db
-                       "
+                         #:cache? #t))
+                       (insert-statement
+                        (sqlite-prepare
+                         db
+                         "
 INSERT INTO cache (key, version, timestamp, data)
 VALUES (:key, :version, :timestamp, :data)"
-                       #:cache? #t)))
-
-                 (sqlite-bind-arguments
-                  cleanup-statement
-                  #:key string-key)
-                 (sqlite-step cleanup-statement)
-                 (sqlite-reset cleanup-statement)
-
-                 (sqlite-bind-arguments
-                  insert-statement
-                  #:key string-key
-                  #:version version
-                  #:timestamp (time-second (current-time))
-                  #:data (call-with-output-string
-                           (lambda (port)
-                             (write vals port))))
-
-                 (sqlite-step insert-statement)
-                 (sqlite-reset insert-statement))))
+                         #:cache? #t)))
+
+                   (sqlite-bind-arguments
+                    cleanup-statement
+                    #:key string-key)
+                   (sqlite-step cleanup-statement)
+                   (sqlite-reset cleanup-statement)
+
+                   (sqlite-bind-arguments
+                    insert-statement
+                    #:key string-key
+                    #:version version
+                    #:timestamp (time-second (current-time))
+                    #:data (call-with-output-string
+                             (lambda (port)
+                               (write vals port))))
+
+                   (sqlite-step insert-statement)
+                   (sqlite-reset insert-statement)))))
 
             (apply values vals)))
         (apply values cached-values))))