guix
/
data-service
mirror of git://git.savannah.gnu.org/guix/data-service.git
2
0
Fork 0
Code Issues Releases Wiki Activity

Improve error handling for comparison pages

This commit is contained in:
Christopher Baines 2019-10-12 21:43:34 +01:00
parent af1ffc2393
commit 2b9c882e5a
2 changed files with 37 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
guix-data-service/web/controller.scm
View File

@ -457,29 +457,6 @@
#:header-link header-link)
#:extra-headers http-headers-for-unchanging-content))))))
(define (render-compare-unknown-commit mime-types
conn
base-commit
base-revision-id
target-commit
target-revision-id)
(case (most-appropriate-mime-type
'(application/json text/html)
mime-types)
((application/json)
(render-json
'((unknown_commit . #t))))
(else
(render-html
#:sxml (compare-unknown-commit base-commit
target-commit
(if base-revision-id #t #f)
(if target-revision-id #t #f)
(select-job-for-commit conn
base-commit)
(select-job-for-commit conn
target-commit))))))
(define (render-compare mime-types
conn
query-parameters)
@ -492,13 +469,17 @@
'((error . "invalid query"))))
(else
(render-html
#:sxml (compare
#:sxml (compare-invalid-parameters
query-parameters
#f
#f
#f
#f
#f))))
(match (assq-ref query-parameters 'base_commit)
(($ <invalid-query-parameter> value)
(select-job-for-commit conn value))
(_ #f))
(match (assq-ref query-parameters 'target_commit)
(($ <invalid-query-parameter> value)
(select-job-for-commit conn value))
(_ #f))))))
(let ((base-revision-id (commit->revision-id
conn
(assq-ref query-parameters 'base_commit)))
@ -641,10 +622,16 @@
'((error . "invalid query"))))
(else
(render-html
#:sxml (compare/packages
#:sxml (compare-invalid-parameters
query-parameters
#f
#f))))
(match (assq-ref query-parameters 'base_commit)
(($ <invalid-query-parameter> value)
(select-job-for-commit conn value))
(_ #f))
(match (assq-ref query-parameters 'target_commit)
(($ <invalid-query-parameter> value)
(select-job-for-commit conn value))
(_ #f))))))
(let ((base-commit (assq-ref query-parameters 'base_commit))
(target-commit (assq-ref query-parameters 'target_commit)))

30
guix-data-service/web/view/html.scm
View File

@ -51,7 +51,7 @@
compare
compare/derivations
compare/packages
compare-unknown-commit
compare-invalid-parameters
error-page))
(define* (header)
@ -2193,28 +2193,34 @@
(style "font-size: 2em; display: block;"))
"Unknown"))))))))))
(define (compare-unknown-commit base-commit target-commit
base-exists? target-exists?
base-job target-job)
(define (compare-invalid-parameters query-parameters
base-job
target-job)
(define base-commit
(assq-ref query-parameters 'base_commit))
(define target-commit
(peek (assq-ref query-parameters 'target_commit)))
(layout
#:body
`(,(header)
(div (@ (class "container"))
(h1 "Unknown commit")
,(if base-exists?
'()
,(if (invalid-query-parameter? base-commit)
`(p "No known revision with commit "
(strong (samp ,base-commit))
(strong (samp ,(invalid-query-parameter-value base-commit)))
,(if (null? base-job)
" and it is not currently queued for processing"
" but it is queued for processing")))
,(if target-exists?
'()
" but it is queued for processing"))
'())
,(if (invalid-query-parameter? target-commit)
`(p "No known revision with commit "
(strong (samp ,target-commit))
(strong (samp ,(invalid-query-parameter-value target-commit)))
,(if (null? target-job)
" and it is not currently queued for processing"
" but it is queued for processing")))))))
" but it is queued for processing"))
'())))))
(define (error-page message)
(layout