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
