From 03a70ac2e07f2eec35a9473d8930a9cbefa50b92 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: Access derivation differences data using assq-ref. controller.scm: generalize map for outputs/inputs/sources/arguments. --- guix-data-service/comparison.scm | 68 +++++++++-------- guix-data-service/web/compare/controller.scm | 78 +++----------------- guix-data-service/web/compare/html.scm | 62 +++++++--------- 3 files changed, 75 insertions(+), 133 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..a48b7c5 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -588,79 +588,23 @@ '(application/json text/html) mime-types) ((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))))) - - (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))))) - - (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))))) - - (arguments - (map - (match-lambda - ((label args ...) - `(,label . ,(list->vector args)))) - (assq-ref data 'arguments)))) + (let ((data-groups + (map (lambda (name) + (cons name + (map + (match-lambda + ((label args ...) + `(,label . ,(list->vector args)))) + (assq-ref data name)))) + '(outputs inputs sources arguments)))) + ;data-groups returns four pairs/entries: outputs, inputs, sources and arguments. (render-json `((base . ((derivation . ,base-derivation))) (target . ((derivation . ,target-derivation))) - (outputs . ,outputs) - (inputs . ,inputs) - (sources . ,sources) + ,@data-groups (system . ,(assq-ref data 'system)) (builder . ,(assq-ref data 'builder)) - (arguments . ,arguments) (environment-variables . ,(assq-ref data 'environment-variables))) #:extra-headers http-headers-for-unchanging-content))) diff --git a/guix-data-service/web/compare/html.scm b/guix-data-service/web/compare/html.scm index 5b5fe0a..d144736 100644 --- a/guix-data-service/web/compare/html.scm +++ b/guix-data-service/web/compare/html.scm @@ -487,27 +487,23 @@ (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 + (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 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 @@ -521,13 +517,12 @@ ,@(append-map (lambda (label items) (map - (match-lambda - ((derivation outputs) - `(tr - (td ,label) - (td (a (@ (href ,derivation)) - ,(display-store-item derivation))) - (td ,outputs)))) + (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 items '()))) (list base target) (list (assq-ref inputs 'base) @@ -545,12 +540,11 @@ ,@(append-map (lambda (label items) (map - (match-lambda - ((file) - `(tr - (td ,label) - (td (a (@ (href ,file)) - ,(display-store-item file)))))) + (lambda (alist) + `(tr + (td ,label) + (td (a (@ (href ,(assq-ref alist 'store_path))) + ,(display-store-item (assq-ref alist 'store_path)))))) (or items '()))) (list base target "Common") (list (assq-ref sources 'base) -- 2.30.2