From 93ef30e06d7e10fd3a140c6f2a729d40540b05a8 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: remove mapping for outputs/inputs/sources. utils.scm: add group-to-alist/vector function. --- guix-data-service/comparison.scm | 81 +++++++++--------- guix-data-service/model/utils.scm | 8 ++ guix-data-service/web/compare/controller.scm | 88 +++----------------- guix-data-service/web/compare/html.scm | 74 ++++++++-------- 4 files changed, 97 insertions(+), 154 deletions(-) diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm index e5e1955..46f5377 100644 --- a/guix-data-service/comparison.scm +++ b/guix-data-service/comparison.scm @@ -74,19 +74,20 @@ 'value)) `((outputs - . ,(group-to-alist + . ,(group-to-alist/vector group-by-last-element (derivation-outputs-differences-data conn (first base-derivation) (first target-derivation)))) (inputs - . ,(group-to-alist + . ,(group-to-alist/vector group-by-last-element (derivation-inputs-differences-data conn (first base-derivation) (first target-derivation)))) + (sources - . ,(group-to-alist + . ,(group-to-alist/vector group-by-last-element (derivation-sources-differences-data conn (first base-derivation) @@ -107,9 +108,9 @@ (target . ,target-builder)))) (arguments . ,(if (eq? base-args target-args) - `((common . ,base-args)) - `((base . ,base-args) - (target . ,target-args)))) + `((common . ,(list->vector base-args))) + `((base . ,(list->vector base-args)) + (target . ,(list->vector target-args))))) (environment-variables . ,(map (lambda (key) (let ((base-value (fetch-value base-env-vars key)) @@ -158,19 +159,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 . null))) + ,@(if (string? hash) + `((hash . ,hash)) + `((hash . null))) + (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 +207,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 +240,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/model/utils.scm b/guix-data-service/model/utils.scm index 13947bd..b11cee5 100644 --- a/guix-data-service/model/utils.scm +++ b/guix-data-service/model/utils.scm @@ -33,6 +33,7 @@ deduplicate-strings group-list-by-first-n-fields group-to-alist + group-to-alist/vector insert-missing-data-and-return-all-ids)) (define NULL '()) @@ -114,6 +115,13 @@ '() lst)) +(define (group-to-alist/vector process lst) + (map + (match-lambda + ((label . items) + (cons label (list->vector items)))) + (group-to-alist process lst))) + (define (table-schema conn table-name) (let ((results (exec-query diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm index 895bb40..8445185 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -588,82 +588,18 @@ '(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)))) - - (render-json - `((base . ((derivation . ,base-derivation))) - (target . ((derivation . ,target-derivation))) - (outputs . ,outputs) - (inputs . ,inputs) - (sources . ,sources) - (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))) + (render-json + `((base . ((derivation . ,base-derivation))) + (target . ((derivation . ,target-derivation))) + (outputs . ,(assq-ref data 'outputs)) + (inputs . ,(assq-ref data 'inputs)) + (sources . ,(assq-ref data 'sources)) + (system . ,(assq-ref data 'system)) + (builder . ,(assq-ref data 'builder)) + (arguments . ,(assq-ref data 'arguments)) + (environment-variables . ,(assq-ref + data 'environment-variables))) + #:extra-headers http-headers-for-unchanging-content)) (else (render-html #:sxml (compare/derivation diff --git a/guix-data-service/web/compare/html.scm b/guix-data-service/web/compare/html.scm index 5b5fe0a..e1ff15c 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 (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 @@ -521,14 +517,13 @@ ,@(append-map (lambda (label items) (map - (match-lambda - ((derivation outputs) - `(tr - (td ,label) - (td (a (@ (href ,derivation)) - ,(display-store-item derivation))) - (td ,outputs)))) - (or items '()))) + (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))))))) @@ -545,13 +540,12 @@ ,@(append-map (lambda (label items) (map - (match-lambda - ((file) - `(tr - (td ,label) - (td (a (@ (href ,file)) - ,(display-store-item file)))))) - (or items '()))) + (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) @@ -615,8 +609,8 @@ (td (ol ,@(map (lambda (arg) `(li ,(display-possible-store-item arg))) - (or common-args - base-args))))) + (or (and=> common-args vector->list) + (vector->list base-args)))))) (tr (td ,target) (td ,(display-possible-store-item @@ -625,8 +619,8 @@ (td (ol ,@(map (lambda (arg) `(li ,(display-possible-store-item arg))) - (or common-args - target-args)))))))))))) + (or (and=> common-args vector->list) + (vector->list target-args))))))))))))) (h2 "Environment variables") ,(let ((environment-variables (assq-ref data 'environment-variables))) `(table -- 2.30.2