From eb75964e76bb1b90c4239a912d2241849d2440d8 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 5 Nov 2025 08:42:39 +0000 Subject: [PATCH] Handle query parameter errors on the fix derivation page --- guix-data-service/web/compare/controller.scm | 2 +- guix-data-service/web/compare/html.scm | 361 ++++++++++--------- 2 files changed, 183 insertions(+), 180 deletions(-) diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm index 8d7583f..2c94904 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -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))) diff --git a/guix-data-service/web/compare/html.scm b/guix-data-service/web/compare/html.scm index 8711574..e92f74f 100644 --- a/guix-data-service/web/compare/html.scm +++ b/guix-data-service/web/compare/html.scm @@ -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