[bug#69292] [PATCH 5/6] store: database: Refactor sqlite-register.

[Christopher Baines <mail@cbaines.net>]

The update-or-insert procedure name was unhelpfully generic, and these changes
should improve the code readability.

* guix/store/database.scm (update-or-insert): Remove procedure and inline
functionality in to sqlite-register.

Change-Id: Ifab0cdb7972d095460cc1f79b8b2f0e9b958059c
---
 guix/store/database.scm | 132 ++++++++++++++++++++--------------------
 1 file changed, 66 insertions(+), 66 deletions(-)

diff --git a/guix/store/database.scm b/guix/store/database.scm
index 8d8b7346e0..0b570eabcd 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -194,54 +194,15 @@ (define* (path-id db path)
       (#(id) id)
       (#f #f))))
 
-(define-inlinable (assert-integer proc in-range? key number)
-  (unless (integer? number)
-    (throw 'wrong-type-arg proc
-           "Wrong type argument ~A: ~S" (list key number)
-           (list number)))
-  (unless (in-range? number)
-    (throw 'out-of-range proc
-           "Integer ~A out of range: ~S" (list key number)
-           (list number))))
-
-(define* (update-or-insert db #:key 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."
-
-  ;; Make sure NAR-SIZE is valid.
-  (assert-integer "update-or-insert" positive? #:nar-size nar-size)
-  (assert-integer "update-or-insert" (cut >= <> 0) #:time time)
-
-  (let ((id (path-id db path)))
-    (if id
-        (let ((stmt (sqlite-prepare
-                     db
-                     "
-UPDATE ValidPaths
-SET hash = :hash,
-    registrationTime = :time,
-    deriver = :deriver,
-    narSize = :size
-WHERE id = :id"
-                     #:cache? #t)))
-          (sqlite-bind-arguments stmt #:id id
-                                 #:deriver deriver
-                                 #:hash hash #:size nar-size #:time time)
-          (sqlite-step-and-reset stmt)
-          id)
-        (let ((stmt (sqlite-prepare
-                     db
-                     "
-INSERT INTO ValidPaths (path, hash, registrationTime, deriver, narSize)
-VALUES (:path, :hash, :time, :deriver, :size)"
-                     #:cache? #t)))
-          (sqlite-bind-arguments stmt
-                                 #:path path #:deriver deriver
-                                 #:hash hash #:size nar-size #:time time)
-          (sqlite-step-and-reset stmt)
-          (last-insert-row-id db)))))
+(define (timestamp)
+  "Return a timestamp, either the current time of SOURCE_DATE_EPOCH."
+  (match (getenv "SOURCE_DATE_EPOCH")
+    (#f
+     (current-time time-utc))
+    ((= string->number seconds)
+     (if seconds
+         (make-time time-utc 0 seconds)
+         (current-time time-utc)))))
 
 (define (add-references db referrer references)
   "REFERRER is the id of the referring store item, REFERENCES is a list
@@ -258,15 +219,15 @@ (define (add-references db referrer references)
                 (sqlite-step-and-reset stmt))
               references)))
 
-(define (timestamp)
-  "Return a timestamp, either the current time of SOURCE_DATE_EPOCH."
-  (match (getenv "SOURCE_DATE_EPOCH")
-    (#f
-     (current-time time-utc))
-    ((= string->number seconds)
-     (if seconds
-         (make-time time-utc 0 seconds)
-         (current-time time-utc)))))
+(define-inlinable (assert-integer proc in-range? key number)
+  (unless (integer? number)
+    (throw 'wrong-type-arg proc
+           "Wrong type argument ~A: ~S" (list key number)
+           (list number)))
+  (unless (in-range? number)
+    (throw 'out-of-range proc
+           "Integer ~A out of range: ~S" (list key number)
+           (list number))))
 
 (define* (sqlite-register db #:key path (references '())
                           deriver hash nar-size
@@ -279,15 +240,54 @@ (define* (sqlite-register db #:key path (references '())
 the database or #f, meaning \"right now\".
 
 Every store item in REFERENCES must already be registered."
-  (let ((id (update-or-insert db #:path path
-                              #:deriver deriver
-                              #:hash hash
-                              #:nar-size nar-size
-                              #:time (time-second time))))
-    ;; Call 'path-id' on each of REFERENCES.  This ensures we get a
-    ;; "non-NULL constraint" failure if one of REFERENCES is unregistered.
-    (add-references db id
-                    (map (cut path-id db <>) references))))
+
+  (define registration-time
+    (time-second time))
+
+  ;; Make sure NAR-SIZE is valid.
+  (assert-integer "sqlite-register" positive? #:nar-size nar-size)
+  (assert-integer "sqlite-register" (cut >= <> 0) #:time registration-time)
+
+  (define id
+    (let ((existing-id (path-id db path)))
+      (if existing-id
+          (let ((stmt (sqlite-prepare
+                       db
+                       "
+UPDATE ValidPaths
+SET hash = :hash,
+    registrationTime = :time,
+    deriver = :deriver,
+    narSize = :size
+WHERE id = :id"
+                       #:cache? #t)))
+            (sqlite-bind-arguments stmt
+                                   #:id existing-id
+                                   #:deriver deriver
+                                   #:hash hash
+                                   #:size nar-size
+                                   #:time registration-time)
+            (sqlite-step-and-reset stmt)
+            existing-id)
+          (let ((stmt (sqlite-prepare
+                       db
+                       "
+INSERT INTO ValidPaths (path, hash, registrationTime, deriver, narSize)
+VALUES (:path, :hash, :time, :deriver, :size)"
+                       #:cache? #t)))
+            (sqlite-bind-arguments stmt
+                                   #:path path
+                                   #:deriver deriver
+                                   #:hash hash
+                                   #:size nar-size
+                                   #:time registration-time)
+            (sqlite-step-and-reset stmt)
+            (last-insert-row-id db)))))
+
+  ;; Call 'path-id' on each of REFERENCES.  This ensures we get a
+  ;; "non-NULL constraint" failure if one of REFERENCES is unregistered.
+  (add-references db id
+                  (map (cut path-id db <>) references)))
 
 \f
 ;;;
-- 
2.41.0