cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Change data handling when comparing derivations

Browse source 
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>
This commit is contained in:
Luciana Lima Brito 2021-04-27 19:53:55 +00:00 • committed by Christopher Baines
parent e38bddcae5
commit 767e60b2b3
4 changed files with 97 additions and 154 deletions
Download patch file Download diff file Expand all files Collapse all files

88
guix-data-service/web/compare/controller.scm
View file

@ -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

74
guix-data-service/web/compare/html.scm
View file

@ -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