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

Handle query parameter errors on the fix derivation page

Browse source
This commit is contained in:
Christopher Baines 2025-11-05 08:42:39 +00:00
parent 0113843a72
commit eb75964e76
2 changed files with 183 additions and 180 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -628,7 +628,7 @@
(render-html (render-html
#:sxml (compare/derivation #:sxml (compare/derivation
query-parameters query-parameters
'())))) #f))))
(let ((base-derivation (assq-ref query-parameters 'base_derivation)) (let ((base-derivation (assq-ref query-parameters 'base_derivation))
(target-derivation (assq-ref query-parameters 'target_derivation))) (target-derivation (assq-ref query-parameters 'target_derivation)))

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

@ -483,191 +483,194 @@
"View JSON"))))) "View JSON")))))
(div (div
(@ (class "row")) (@ (class "row"))
(div ,@(if
(@ (class "col-sm-12")) data
(h2 "Outputs") `((div
,@(let ((outputs (assq-ref data 'outputs))) (@ (class "col-sm-12"))
`((table (h2 "Outputs")
(@ (class "table")) ,@(let ((outputs (assq-ref data 'outputs)))
(thead `((table
(tr
(th "")
(th "Name")
(th "Path")
(th "Hash algorithm")
(th "Hash")
(th "Recursive")))
(tbody
,@(append-map
(lambda (label items)
(map
(lambda (alist)
`(tr
(td ,label)
(td ,(assq-ref alist 'output-name))
(td (a (@ (href ,(assq-ref alist 'path)))
,(display-store-item (assq-ref alist 'path))))
(td ,(assq-ref alist 'hash-algorithm))
(td ,(assq-ref alist 'hash))
(td ,(assq-ref alist 'recursive))))
(or (and=> items vector->list) '())))
(list base target "Common")
(list (assq-ref outputs 'base)
(assq-ref outputs 'target)
(assq-ref outputs 'common)))))))
(h2 "Inputs")
,@(let ((inputs (assq-ref data 'inputs)))
`((table
(@ (class "table"))
(thead
(tr
(th "")
(th "Derivation")
(th "Outputs")))
(tbody
,@(append-map
(lambda (label items)
(map
(lambda (alist)
`(tr
(td ,label)
(td (a (@ (href ,(assq-ref alist 'derivation_file_name)))
,(display-store-item (assq-ref alist 'derivation_file_name))))
(td ,(assq-ref alist 'derivation_output_name))))
(or (and=> items vector->list) '())))
(list base target)
(list (assq-ref inputs 'base)
(assq-ref inputs 'target)))))))
(p "Common inputs are omitted.")
(h2 "Sources")
,@(let ((sources (assq-ref data 'sources)))
`((table
(@ (class "table"))
(thead
(tr
(th "")
(th "Derivation")))
(tbody
,@(append-map
(lambda (label items)
(map
(lambda (alist)
`(tr
(td ,label)
(td (a (@ (href ,(assq-ref alist 'store_path)))
,(display-store-item (assq-ref alist 'store_path))))))
(or (and=> items vector->list) '())))
(list base target "Common")
(list (assq-ref sources 'base)
(assq-ref sources 'target)
(assq-ref sources 'common)))))))
(h2 "System")
,@(let ((system (assq-ref data 'system)))
(let ((common-system (assq-ref system 'common)))
(if common-system
(list common-system)
`(table
(@ (class "table")) (@ (class "table"))
(thead (thead
(tr (tr
(th "") (th "")
(th "System"))) (th "Name")
(th "Path")
(th "Hash algorithm")
(th "Hash")
(th "Recursive")))
(tbody (tbody
,@(let ((base-system (assq-ref system 'base)) ,@(append-map
(target-system (assq-ref system 'target))) (lambda (label items)
`((tr (map
(td ,base) (lambda (alist)
(td ,base-system)) `(tr
(tr (td ,label)
(td ,target) (td ,(assq-ref alist 'output-name))
(td ,target-system))))))))) (td (a (@ (href ,(assq-ref alist 'path)))
(h2 "Builder and arguments") ,(display-store-item (assq-ref alist 'path))))
,(let ((builder (assq-ref data 'builder)) (td ,(assq-ref alist 'hash-algorithm))
(arguments (assq-ref data 'arguments))) (td ,(assq-ref alist 'hash))
(let ((common-builder (assq-ref builder 'common)) (td ,(assq-ref alist 'recursive))))
(common-args (assq-ref arguments 'common))) (or (and=> items vector->list) '())))
(if (and common-builder (list base target "Common")
common-args) (list (assq-ref outputs 'base)
`(table (assq-ref outputs 'target)
(@ (class "table")) (assq-ref outputs 'common)))))))
(thead (h2 "Inputs")
(th "Builder") ,@(let ((inputs (assq-ref data 'inputs)))
(th "Arguments")) `((table
(tbody (@ (class "table"))
(tr (thead
(td ,(display-possible-store-item common-builder)) (tr
(td (ol (th "")
,@(map (lambda (arg) (th "Derivation")
`(li ,(display-possible-store-item arg))) (th "Outputs")))
common-args)))))) (tbody
`(table ,@(append-map
(@ (class "table")) (lambda (label items)
(thead (map
(tr (lambda (alist)
(th "") `(tr
(th "Builder") (td ,label)
(th "Arguments"))) (td (a (@ (href ,(assq-ref alist 'derivation_file_name)))
(tbody ,(display-store-item (assq-ref alist 'derivation_file_name))))
,@(let ((base-builder (assq-ref builder 'base)) (td ,(assq-ref alist 'derivation_output_name))))
(target-builder (assq-ref builder 'target)) (or (and=> items vector->list) '())))
(base-args (assq-ref arguments 'base)) (list base target)
(target-args (assq-ref arguments 'target))) (list (assq-ref inputs 'base)
`((tr (assq-ref inputs 'target)))))))
(td ,base) (p "Common inputs are omitted.")
(td ,(display-possible-store-item (h2 "Sources")
(or base-builder ,@(let ((sources (assq-ref data 'sources)))
common-builder))) `((table
(td (ol (@ (class "table"))
,@(map (lambda (arg) (thead
`(li ,(display-possible-store-item arg))) (tr
(or (and=> common-args vector->list) (th "")
(vector->list base-args)))))) (th "Derivation")))
(tbody
,@(append-map
(lambda (label items)
(map
(lambda (alist)
`(tr
(td ,label)
(td (a (@ (href ,(assq-ref alist 'store_path)))
,(display-store-item (assq-ref alist 'store_path))))))
(or (and=> items vector->list) '())))
(list base target "Common")
(list (assq-ref sources 'base)
(assq-ref sources 'target)
(assq-ref sources 'common)))))))
(h2 "System")
,@(let ((system (assq-ref data 'system)))
(let ((common-system (assq-ref system 'common)))
(if common-system
(list common-system)
`(table
(@ (class "table"))
(thead
(tr (tr
(td ,target) (th "")
(td ,(display-possible-store-item (th "System")))
(or target-builder (tbody
common-builder))) ,@(let ((base-system (assq-ref system 'base))
(td (ol (target-system (assq-ref system 'target)))
,@(map (lambda (arg) `((tr
`(li ,(display-possible-store-item arg))) (td ,base)
(or (and=> common-args vector->list) (td ,base-system))
(vector->list target-args))))))))))))) (tr
(h2 "Environment variables") (td ,target)
,(let ((environment-variables (assq-ref data 'environment-variables))) (td ,target-system)))))))))
`(table (h2 "Builder and arguments")
(@ (class "table")) ,(let ((builder (assq-ref data 'builder))
(thead (arguments (assq-ref data 'arguments)))
(th "Name")) (let ((common-builder (assq-ref builder 'common))
(tbody (common-args (assq-ref arguments 'common)))
,@(append-map (if (and common-builder
(match-lambda common-args)
((name . values) `(table
(let ((common-value (assq-ref values 'common))) (@ (class "table"))
(if common-value (thead
`((tr (th "Builder")
(td ,name) (th "Arguments"))
(td ,(display-possible-store-item common-value)))) (tbody
(let ((base-value (assq-ref values 'base)) (tr
(target-value (assq-ref values 'target))) (td ,(display-possible-store-item common-builder))
(if (and base-value target-value) (td (ol
`((tr ,@(map (lambda (arg)
(td (@ (rowspan 2)) `(li ,(display-possible-store-item arg)))
,name) common-args))))))
(td ,base ,(display-possible-store-item `(table
base-value))) (@ (class "table"))
(tr (thead
(td ,target ,(display-possible-store-item (tr
target-value)))) (th "")
`((tr (th "Builder")
(td ,name) (th "Arguments")))
(td ,@(if base-value (tbody
(list base ,@(let ((base-builder (assq-ref builder 'base))
(display-possible-store-item (target-builder (assq-ref builder 'target))
base-value)) (base-args (assq-ref arguments 'base))
(list target (target-args (assq-ref arguments 'target)))
(display-possible-store-item `((tr
target-value)))))))))))) (td ,base)
environment-variables)))))))))) (td ,(display-possible-store-item
(or base-builder
common-builder)))
(td (ol
,@(map (lambda (arg)
`(li ,(display-possible-store-item arg)))
(or (and=> common-args vector->list)
(vector->list base-args))))))
(tr
(td ,target)
(td ,(display-possible-store-item
(or target-builder
common-builder)))
(td (ol
,@(map (lambda (arg)
`(li ,(display-possible-store-item arg)))
(or (and=> common-args vector->list)
(vector->list target-args)))))))))))))
(h2 "Environment variables")
,(let ((environment-variables (assq-ref data 'environment-variables)))
`(table
(@ (class "table"))
(thead
(th "Name"))
(tbody
,@(append-map
(match-lambda
((name . values)
(let ((common-value (assq-ref values 'common)))
(if common-value
`((tr
(td ,name)
(td ,(display-possible-store-item common-value))))
(let ((base-value (assq-ref values 'base))
(target-value (assq-ref values 'target)))
(if (and base-value target-value)
`((tr
(td (@ (rowspan 2))
,name)
(td ,base ,(display-possible-store-item
base-value)))
(tr
(td ,target ,(display-possible-store-item
target-value))))
`((tr
(td ,name)
(td ,@(if base-value
(list base
(display-possible-store-item
base-value))
(list target
(display-possible-store-item
target-value))))))))))))
environment-variables))))))
'()))))))
(define* (compare/package-derivations query-parameters (define* (compare/package-derivations query-parameters
mode mode