aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service/web/compare
diff options
context:
space:
mode:
authorLuciana Lima Brito <lubrito@posteo.net>2021-04-27 19:53:55 +0000
committerChristopher Baines <mail@cbaines.net>2021-04-27 21:18:51 +0100
commit767e60b2b3c62f7f3fc185f828fa58b868764150 (patch)
treeb72c006ce3a94bb920d467666a79dbe7c04dda71 /guix-data-service/web/compare
parente38bddcae542bad878a4e9169fcf40fec72a1134 (diff)
downloaddata-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.scm88
-rw-r--r--guix-data-service/web/compare/html.scm74
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