From: Romain GARBAGE <romain.garbage@inria.fr>
To: guix-devel@gnu.org
Cc: ludovic.courtes@inria.fr, Romain GARBAGE <romain.garbage@inria.fr>
Subject: [PATCH Cuirass] cuirass: Fix handling of SPECIFICATION-NAME.
Date: Mon, 17 Jun 2024 14:44:25 +0200 [thread overview]
Message-ID: <20240617124425.8410-1-romain.garbage@inria.fr> (raw)
Fixes a regression introduced in
1da873b0e23eceb3c239dd6dc6781debf23bec63, where the NAME field of the
SPECIFICATION record type is forced to be a symbol as stated by the
documentation.
* src/cuirass/base.scm: Handle SPECIFICATION-NAME as a symbol.
* src/cuirass/http.scm: Handle SPECIFICATION-NAME as a symbol.
* src/cuirass/templates.scm: Fix template generation.
---
src/cuirass/base.scm | 4 ++--
src/cuirass/http.scm | 6 +++---
src/cuirass/templates.scm | 21 +++++++++++----------
3 files changed, 16 insertions(+), 15 deletions(-)
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 86d2f97..507be5f 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -857,7 +857,7 @@ POLLING-PERIOD seconds."
((_ . actor) actor)))
(loop registry))
(`(update ,spec)
- (let ((name (string->symbol (specification-name spec))))
+ (let ((name (specification-name spec)))
(match (vhash-assq name registry)
(#f
(log-error "cannot update non-existent spec '~s'" name))
@@ -877,7 +877,7 @@ POLLING-PERIOD seconds."
#:polling-period period))
(name (specification-name spec)))
(log-info "registering new jobset '~a'" name)
- (loop (vhash-consq (string->symbol name) monitor
+ (loop (vhash-consq name monitor
registry))))
((_ . monitor)
(log-info "jobset '~a' was already registered"
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 48c506c..092eca1 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -191,7 +191,7 @@ a <checkout> record."
((mastodon? notif)
`((type . mastodon)))))
- `((name . ,(specification-name spec))
+ `((name . ,(symbol->string (specification-name spec)))
(build . ,(match (specification-build spec)
((? symbol? subset)
subset)
@@ -743,7 +743,7 @@ bogus reply is received, return DEFAULT."
(respond-json-with-error 400 "Jobset already exists."))))
;; Accepted or rejected merge requests receive the same treatment.
((or "close" "merge")
- (let ((spec-name (symbol->string (specification-name spec))))
+ (let ((spec-name (specification-name spec)))
(if (db-get-specification spec-name)
(begin
(db-remove-specification spec-name)
@@ -760,7 +760,7 @@ bogus reply is received, return DEFAULT."
;; treated the same way: the jobset is reevaluated.
;; XXX: Copied and adapted from "/jobset/<spec>/hook/evaluate.
("update"
- (let ((spec-name (symbol->string (specification-name spec))))
+ (let ((spec-name (specification-name spec)))
(if (db-get-specification spec-name)
(if (call-bridge `(trigger-jobset ,(specification-name spec))
bridge)
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 54a10c1..d49c868 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -378,8 +378,8 @@ system whose names start with " (code "guile-") ":" (br)
(td
(@ (class "column-name"))
(a (@ (href "/jobset/"
- ,(specification-name spec)))
- ,(specification-name spec)))
+ ,(symbol->string (specification-name spec))))
+ ,(symbol->string (specification-name spec))))
(td
(@ (class "column-build"))
,(match (specification-build spec)
@@ -422,11 +422,11 @@ system whose names start with " (code "guile-") ":" (br)
(style "vertical-align: middle"))
,@(let* ((summary
(and=> (spec->latest-eval-ok
- (specification-name spec))
+ (symbol->string (specification-name spec)))
eval-summary))
(last-eval
(spec->latest-eval
- (specification-name spec)))
+ (symbol->string (specification-name spec))))
(last-eval-status-ok?
(and last-eval
(<= (evaluation-current-status last-eval)
@@ -455,7 +455,7 @@ system whose names start with " (code "guile-") ":" (br)
(else '()))))
(td
(@ (class "column-action"))
- ,@(let* ((name (specification-name spec))
+ ,@(let* ((name (symbol->string (specification-name spec)))
(dashboard-name
(string-append "Dashboard " name)))
`((a (@ (href "/eval/latest/dashboard?spec="
@@ -468,10 +468,10 @@ system whose names start with " (code "guile-") ":" (br)
,(let ((id
(string-append
"specDropdown-"
- (specification-name spec)))
+ (symbol->string (specification-name spec))))
(name
(string-append "Options "
- (specification-name spec))))
+ (symbol->string (specification-name spec)))))
`(div
(@ (id ,id)
(title ,name)
@@ -490,12 +490,12 @@ system whose names start with " (code "guile-") ":" (br)
(li (@ (role "menuitem"))
(a (@ (class "dropdown-item")
(href "/specification/edit/"
- ,(specification-name spec)))
+ ,(symbol->string (specification-name spec))))
" Edit"))
(li (@ (role "menuitem"))
(a (@ (class "dropdown-item")
(href "/admin/specifications/deactivate/"
- ,(specification-name spec)))
+ ,(symbol->string (specification-name spec))))
" Deactivate"))))))))
specs)))))))
@@ -569,7 +569,8 @@ the existing SPEC otherwise."
'("")
rest)))))))
- (let ((name (and spec (specification-name spec)))
+ (let ((name (and spec (symbol->string
+ (specification-name spec))))
(build (and spec (match (specification-build spec)
((? symbol? build) build)
((build _ ...) build))))
--
2.45.1
next reply other threads:[~2024-06-17 12:45 UTC|newest]
Thread overview: 3+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-06-17 12:44 Romain GARBAGE [this message]
2024-06-17 13:42 ` [PATCH Cuirass] cuirass: Fix handling of SPECIFICATION-NAME Ludovic Courtès
2024-06-17 15:02 ` Romain GARBAGE
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20240617124425.8410-1-romain.garbage@inria.fr \
--to=romain.garbage@inria.fr \
--cc=guix-devel@gnu.org \
--cc=ludovic.courtes@inria.fr \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).