diff options
author | Luciana Lima Brito <lubrito@posteo.net> | 2021-04-27 19:53:55 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2021-04-27 21:18:51 +0100 |
commit | 767e60b2b3c62f7f3fc185f828fa58b868764150 (patch) | |
tree | b72c006ce3a94bb920d467666a79dbe7c04dda71 /guix-data-service/web/compare | |
parent | e38bddcae542bad878a4e9169fcf40fec72a1134 (diff) | |
download | data-service-767e60b2b3c62f7f3fc185f828fa58b868764150.tar data-service-767e60b2b3c62f7f3fc185f828fa58b868764150.tar.gz |
Change data handling when comparing derivations
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.
Signed-off-by: Christopher Baines <mail@cbaines.net>
Diffstat (limited to 'guix-data-service/web/compare')
-rw-r--r-- | guix-data-service/web/compare/controller.scm | 88 | ||||
-rw-r--r-- | guix-data-service/web/compare/html.scm | 74 |
2 files changed, 46 insertions, 116 deletions
diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm index 30cf835..bbc9829 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -589,82 +589,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 be98f43..128e3f4 100644 --- a/guix-data-service/web/compare/html.scm +++ b/guix-data-service/web/compare/html.scm @@ -494,27 +494,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 @@ -528,14 +524,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))))))) @@ -552,13 +547,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) @@ -622,8 +616,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 @@ -632,8 +626,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 |