Handle query parameter errors on the fix derivation page

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

View file

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

View file

@ -483,191 +483,194 @@
"View JSON")))))
(div
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h2 "Outputs")
,@(let ((outputs (assq-ref data 'outputs)))
`((table
(@ (class "table"))
(thead
(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
,@(if
data
`((div
(@ (class "col-sm-12"))
(h2 "Outputs")
,@(let ((outputs (assq-ref data 'outputs)))
`((table
(@ (class "table"))
(thead
(tr
(th "")
(th "System")))
(th "Name")
(th "Path")
(th "Hash algorithm")
(th "Hash")
(th "Recursive")))
(tbody
,@(let ((base-system (assq-ref system 'base))
(target-system (assq-ref system 'target)))
`((tr
(td ,base)
(td ,base-system))
(tr
(td ,target)
(td ,target-system)))))))))
(h2 "Builder and arguments")
,(let ((builder (assq-ref data 'builder))
(arguments (assq-ref data 'arguments)))
(let ((common-builder (assq-ref builder 'common))
(common-args (assq-ref arguments 'common)))
(if (and common-builder
common-args)
`(table
(@ (class "table"))
(thead
(th "Builder")
(th "Arguments"))
(tbody
(tr
(td ,(display-possible-store-item common-builder))
(td (ol
,@(map (lambda (arg)
`(li ,(display-possible-store-item arg)))
common-args))))))
`(table
(@ (class "table"))
(thead
(tr
(th "")
(th "Builder")
(th "Arguments")))
(tbody
,@(let ((base-builder (assq-ref builder 'base))
(target-builder (assq-ref builder 'target))
(base-args (assq-ref arguments 'base))
(target-args (assq-ref arguments 'target)))
`((tr
(td ,base)
(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))))))
,@(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"))
(thead
(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))))))))))
(th "")
(th "System")))
(tbody
,@(let ((base-system (assq-ref system 'base))
(target-system (assq-ref system 'target)))
`((tr
(td ,base)
(td ,base-system))
(tr
(td ,target)
(td ,target-system)))))))))
(h2 "Builder and arguments")
,(let ((builder (assq-ref data 'builder))
(arguments (assq-ref data 'arguments)))
(let ((common-builder (assq-ref builder 'common))
(common-args (assq-ref arguments 'common)))
(if (and common-builder
common-args)
`(table
(@ (class "table"))
(thead
(th "Builder")
(th "Arguments"))
(tbody
(tr
(td ,(display-possible-store-item common-builder))
(td (ol
,@(map (lambda (arg)
`(li ,(display-possible-store-item arg)))
common-args))))))
`(table
(@ (class "table"))
(thead
(tr
(th "")
(th "Builder")
(th "Arguments")))
(tbody
,@(let ((base-builder (assq-ref builder 'base))
(target-builder (assq-ref builder 'target))
(base-args (assq-ref arguments 'base))
(target-args (assq-ref arguments 'target)))
`((tr
(td ,base)
(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
mode