[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