cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve the failed comparison page

Browse source
This commit is contained in:
Christopher Baines 2020-10-23 16:23:16 +01:00
parent faa32234d8
commit 6c47212c4d
3 changed files with 87 additions and 50 deletions
Download patch file Download diff file Expand all files Collapse all files

46
guix-data-service/web/compare/controller.scm
View file

@ -149,33 +149,35 @@
(define (render-compare mime-types
query-parameters)
(if (any-invalid-query-parameters? query-parameters)
(case (most-appropriate-mime-type
'(application/json text/html)
mime-types)
((application/json)
(render-json
'((error . "invalid query"))))
(else
(letpar& ((base-job
(match (assq-ref query-parameters 'base_commit)
(($ <invalid-query-parameter> value)
(with-thread-postgresql-connection
(lambda (conn)
(select-job-for-commit conn value))))
(_ #f)))
(target-job
(match (assq-ref query-parameters 'target_commit)
(($ <invalid-query-parameter> value)
(with-thread-postgresql-connection
(lambda (conn)
(select-job-for-commit conn value))))
(_ #f))))
(letpar& ((base-job
(match (assq-ref query-parameters 'base_commit)
(($ <invalid-query-parameter> value)
(with-thread-postgresql-connection
(lambda (conn)
(select-job-for-commit conn value))))
(_ #f)))
(target-job
(match (assq-ref query-parameters 'target_commit)
(($ <invalid-query-parameter> value)
(with-thread-postgresql-connection
(lambda (conn)
(select-job-for-commit conn value))))
(_ #f))))
(case (most-appropriate-mime-type
'(application/json text/html)
mime-types)
((application/json)
(peek target-job)
(render-json
`((error . "invalid query")
(base_job . ,base-job)
(target_job . ,target-job))))
(else
(render-html
#:sxml (compare-invalid-parameters
query-parameters
base-job
target-job)))))
(letpar& ((base-revision-id
(with-thread-postgresql-connection
(lambda (conn)

59
guix-data-service/web/compare/html.scm
View file

@ -1028,32 +1028,43 @@
(define target-commit
(assq-ref query-parameters 'target_commit))
(define (description-for-state state)
(cond
((string=? state "queued")
" is queued for processing.")
((string=? state "failed")
" has failed.")
((string=? state "succeeded")
" has succeeded.")))
(layout
#:body
`(,(header)
(div (@ (class "container"))
(h1 "Unknown commit")
,(if (invalid-query-parameter? base-commit)
(if base-job
`(p "Revision "
(a (@ (href
,(string-append "/revision/"
(invalid-query-parameter-value base-commit))))
(strong (samp ,(invalid-query-parameter-value base-commit))))
" is queued for processing.")
`(p "No known revision with commit "
(strong (samp ,(invalid-query-parameter-value base-commit)))
"."))
'())
,(if (invalid-query-parameter? target-commit)
(if target-job
`(p "Revision "
(a (@ (href
,(string-append "/revision/"
(invalid-query-parameter-value target-commit))))
(strong (samp ,(invalid-query-parameter-value target-commit))))
" is queued for processing.")
`(p "No known revision with commit "
(strong (samp ,(invalid-query-parameter-value target-commit)))
"."))
'())))))
,(if (peek "BASE" base-job)
`(p "Revision "
(a (@ (href
,(string-append
"/revision/"
(invalid-query-parameter-value base-commit))))
(strong (samp ,(invalid-query-parameter-value
base-commit))))
,(description-for-state
(assq-ref base-job 'state)))
`(p "No known revision with commit "
(strong (samp ,base-commit))
"."))
,(if target-job
`(p "Revision "
(a (@ (href
,(string-append
"/revision/"
(invalid-query-parameter-value target-commit))))
(strong (samp ,(invalid-query-parameter-value
target-commit))))
,(description-for-state
(assq-ref target-job 'state)))
`(p "No known revision with commit "
(strong (samp ,target-commit))
"."))))))