guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[no subject]


From: Mathieu Othacehe
Date: Thu, 11 Mar 2021 13:32:03 -0500 (EST)

branch: master
commit 82b8f825d8bf30b2a9db20d6ab04df400d973150
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Thu Mar 11 19:30:58 2021 +0100

    Turn db-add-specification into db-add-or-update-specification.
---
 bin/cuirass.in           |  2 +-
 src/cuirass/database.scm | 45 +++++++++++++++++++++++++++------------------
 tests/database.scm       | 14 ++++++++++++--
 tests/http.scm           |  2 +-
 4 files changed, 41 insertions(+), 22 deletions(-)

diff --git a/bin/cuirass.in b/bin/cuirass.in
index d3a5ab4..f3209d3 100644
--- a/bin/cuirass.in
+++ b/bin/cuirass.in
@@ -148,7 +148,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" 
"$@"
                  (parameterize (((@@ (fibers internal) current-fiber) #f))
                    (start-notification-thread))
                  (and specfile
-                      (for-each db-add-specification
+                      (for-each db-add-or-update-specification
                                 (read-specifications specfile)))
                  (and paramfile (read-parameters paramfile))
 
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 5525114..cf33076 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -50,7 +50,7 @@
             expect-one-row
             read-sql-file
             db-add-checkout
-            db-add-specification
+            db-add-or-update-specification
             db-remove-specification
             db-get-specification
             db-get-specifications
@@ -394,28 +394,37 @@ RETURNING (specification, revision);"))
         (x x)
         (() #f)))))
 
-(define (db-add-specification spec)
+(define (db-add-or-update-specification spec)
   "Store SPEC in database."
   (with-db-worker-thread db
-    (match (expect-one-row
-            (exec-query/bind db "\
+    (let ((channels (map channel->sexp
+                         (specification-channels spec)))
+          (build-outputs (map build-output->sexp
+                              (specification-build-outputs spec)))
+          (notifications (map notification->sexp
+                              (specification-notifications spec))))
+      (match (expect-one-row
+              (exec-query/bind db "\
 INSERT INTO Specifications (name, build, channels, \
 build_outputs, notifications, priority, systems) \
   VALUES ("
-                             (specification-name spec) ", "
-                             (specification-build spec) ", "
-                             (map channel->sexp
-                                  (specification-channels spec)) ", "
-                             (map build-output->sexp
-                                  (specification-build-outputs spec)) ", "
-                             (map notification->sexp
-                                  (specification-notifications spec)) ", "
-                             (specification-priority spec) ", "
-                             (specification-systems spec) ")
-ON CONFLICT ON CONSTRAINT specifications_pkey DO NOTHING
-RETURNING name;"))
-      ((name) name)
-      (else #f))))
+                               (specification-name spec) ", "
+                               (specification-build spec) ", "
+                               channels ", "
+                               build-outputs ", "
+                               notifications ", "
+                               (specification-priority spec) ", "
+                               (specification-systems spec) ")
+ON CONFLICT(name) DO UPDATE
+SET build = " (specification-build spec) ",
+channels = " channels ",
+build_outputs = " build-outputs ",
+notifications = " notifications ",
+priority = " (specification-priority spec) ",
+systems = " (specification-systems spec)
+"RETURNING name;"))
+        ((name) name)
+        (else #f)))))
 
 (define (db-remove-specification name)
   "Remove the specification matching NAME from the database."
diff --git a/tests/database.scm b/tests/database.scm
index 54dd7c2..c728aaa 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -122,9 +122,19 @@
       (start-notification-thread)
       #t))
 
-  (test-equal "db-add-specification"
+  (test-equal "db-add-or-update-specification"
     "guix"
-    (db-add-specification example-spec))
+    (db-add-or-update-specification example-spec))
+
+  (test-equal "db-add-or-update-specification 2"
+    'core
+    (begin
+      (db-add-or-update-specification
+       (specification
+        (inherit example-spec)
+        (build 'core)))
+      (specification-build
+       (db-get-specification "guix"))))
 
   (test-assert "exec-query"
     (begin
diff --git a/tests/http.scm b/tests/http.scm
index d68babd..5b77cb2 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -178,7 +178,7 @@
                                          #:name 'packages
                                          #:url "dir4"
                                          #:commit "fakesha3"))))
-      (db-add-specification spec)
+      (db-add-or-update-specification spec)
       (db-add-evaluation "guix" checkouts1
                          #:timestamp 1501347493)
       (db-add-evaluation "guix" checkouts2



reply via email to

[Prev in Thread] Current Thread [Next in Thread]