From d605d519a684b1be57ebd09cdf697bcdba017da1 Mon Sep 17 00:00:00 2001 From: Luciana Brito Date: Sun, 25 Apr 2021 15:17:33 -0300 Subject: [PATCH] Change handling of queried data for derivations comparison. comparison.scm: return query data for derivation comparison as an alist, instead of list. html.scm: match on pairs, instead of single values. controller.scm: simplify mapping on outputs/inputs/sources. --- guix-data-service/comparison.scm | 68 +++++++++++--------- guix-data-service/web/compare/controller.scm | 62 ++++-------------- guix-data-service/web/compare/html.scm | 43 ++++++------- 3 files changed, 69 insertions(+), 104 deletions(-) diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm index e5e1955..1f47c38 100644 --- a/guix-data-service/comparison.scm +++ b/guix-data-service/comparison.scm @@ -158,19 +158,23 @@ GROUP BY 1, 2, 3, 4, 5")) (let ((parsed-derivation-ids (map string->number (parse-postgresql-array-string derivation_ids)))) - (list output-name - path - hash-algorithm - hash - recursive - (append (if (memq base-derivation-id - parsed-derivation-ids) - '(base) - '()) - (if (memq target-derivation-id - parsed-derivation-ids) - '(target) - '())))))) + `((output-name . ,output-name) + (path . ,path) + ,@(if (string? hash-algorithm) + `((hash-algorithm . ,hash-algorithm)) + `((hash-algorithm . ()))) + ,@(if (string? hash) + `((hash . ,hash)) + `((hash . ()))) + (recursive . ,(string=? recursive "t")) + ,(append (if (memq base-derivation-id + parsed-derivation-ids) + '(base) + '()) + (if (memq target-derivation-id + parsed-derivation-ids) + '(target) + '())))))) (exec-query conn query))) (define (derivation-inputs-differences-data conn @@ -202,16 +206,16 @@ INNER JOIN derivations ON derivation_outputs.derivation_id = derivations.id (let ((parsed-derivation-ids (map string->number (parse-postgresql-array-string derivation_ids)))) - (list derivation_file_name - derivation_output_name - (append (if (memq base-derivation-id - parsed-derivation-ids) - '(base) - '()) - (if (memq target-derivation-id - parsed-derivation-ids) - '(target) - '())))))) + `((derivation_file_name . ,derivation_file_name) + (derivation_output_name . ,derivation_output_name) + ,(append (if (memq base-derivation-id + parsed-derivation-ids) + '(base) + '()) + (if (memq target-derivation-id + parsed-derivation-ids) + '(target) + '())))))) (exec-query conn query))) (define (derivation-sources-differences-data conn @@ -235,15 +239,15 @@ GROUP BY derivation_source_files.store_path")) (let ((parsed-derivation-ids (map string->number (parse-postgresql-array-string derivation_ids)))) - (list store_path - (append (if (memq base-derivation-id - parsed-derivation-ids) - '(base) - '()) - (if (memq target-derivation-id - parsed-derivation-ids) - '(target) - '())))))) + `((store_path . ,store_path) + ,(append (if (memq base-derivation-id + parsed-derivation-ids) + '(base) + '()) + (if (memq target-derivation-id + parsed-derivation-ids) + '(target) + '())))))) (exec-query conn query))) (define* (package-derivation-differences-data conn diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm index 895bb40..9ef8e5b 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -590,60 +590,24 @@ ((application/json) (let ((outputs (map - (lambda (label items) - (cons label - (list->vector - (map - (match-lambda - ((name path hash-alg hash recursive) - `((name . ,name) - (path . ,path) - ,@(if (string? hash-alg) - `((hash-algorithm . ,hash-alg)) - '()) - ,@(if (string? hash) - `((hash . ,hash)) - '()) - (recursive . ,(string=? recursive "t"))))) - (or items '()))))) - '(base target common) - (let ((output-groups (assq-ref data 'outputs))) - (list (assq-ref output-groups 'base) - (assq-ref output-groups 'target) - (assq-ref output-groups 'common))))) + (match-lambda + ((label values ...) + `(,label . ,(list->vector values)))) + (assq-ref data 'outputs))) (inputs (map - (lambda (label items) - (cons label - (list->vector - (map - (match-lambda - ((derivation output) - `((derivation . ,derivation) - (output . ,output)))) - (or items '()))))) - '(base target common) - (let ((input-groups (assq-ref data 'inputs))) - (list (assq-ref input-groups 'base) - (assq-ref input-groups 'target) - (assq-ref input-groups 'common))))) + (match-lambda + ((label values ...) + `(,label . ,(list->vector values)))) + (assq-ref data 'inputs))) (sources (map - (lambda (label items) - (cons label - (list->vector - (map - (match-lambda - ((derivation) - `((derivation . ,derivation)))) - (or items '()))))) - '(base target common) - (let ((source-groups (assq-ref data 'sources))) - (list (assq-ref source-groups 'base) - (assq-ref source-groups 'target) - (assq-ref source-groups 'common))))) + (match-lambda + ((label values ...) + `(,label . ,(list->vector values)))) + (assq-ref data 'sources))) (arguments (map @@ -651,7 +615,7 @@ ((label args ...) `(,label . ,(list->vector args)))) (assq-ref data 'arguments)))) - + (render-json `((base . ((derivation . ,base-derivation))) (target . ((derivation . ,target-derivation))) diff --git a/guix-data-service/web/compare/html.scm b/guix-data-service/web/compare/html.scm index 5b5fe0a..30cc499 100644 --- a/guix-data-service/web/compare/html.scm +++ b/guix-data-service/web/compare/html.scm @@ -487,27 +487,24 @@ (th "Hash") (th "Recursive"))) (tbody - ,@(let ((base-outputs (assq-ref outputs 'base)) - (target-outputs (assq-ref outputs 'target)) - (common-outputs (assq-ref outputs 'common))) - (append-map - (lambda (label items) - (map - (match-lambda - ((name path hash-algorithm hash recursive) - `(tr - (td ,label) - (td ,name) - (td (a (@ (href ,path)) - ,(display-store-item path))) - (td ,hash-algorithm) - (td ,hash) - (td ,recursive)))) - (or items '()))) - (list base target "Common") - (list (assq-ref outputs 'base) - (assq-ref outputs 'target) - (assq-ref outputs 'common)))))))) + ,@(append-map + (lambda (label items) + (map + (match-lambda + (((_ . name) (_ . path) (_ . hash-alg) (_ . hash) (_ . recursive)) + `(tr + (td ,label) + (td ,name) + (td (a (@ (href ,path)) + ,(display-store-item path))) + (td ,hash-alg) + (td ,hash) + (td ,recursive)))) + (or items '()))) + (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 @@ -522,7 +519,7 @@ (lambda (label items) (map (match-lambda - ((derivation outputs) + (((_ . derivation) (_ . outputs)) `(tr (td ,label) (td (a (@ (href ,derivation)) @@ -546,7 +543,7 @@ (lambda (label items) (map (match-lambda - ((file) + (((_ . file)) `(tr (td ,label) (td (a (@ (href ,file)) -- 2.30.2