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

81
guix-data-service/comparison.scm
View file

@ -74,19 +74,20 @@
'value)) 'value))
`((outputs `((outputs
. ,(group-to-alist . ,(group-to-alist/vector
group-by-last-element group-by-last-element
(derivation-outputs-differences-data conn (derivation-outputs-differences-data conn
(first base-derivation) (first base-derivation)
(first target-derivation)))) (first target-derivation))))
(inputs (inputs
. ,(group-to-alist . ,(group-to-alist/vector
group-by-last-element group-by-last-element
(derivation-inputs-differences-data conn (derivation-inputs-differences-data conn
(first base-derivation) (first base-derivation)
(first target-derivation)))) (first target-derivation))))
(sources (sources
. ,(group-to-alist . ,(group-to-alist/vector
group-by-last-element group-by-last-element
(derivation-sources-differences-data conn (derivation-sources-differences-data conn
(first base-derivation) (first base-derivation)
@ -107,9 +108,9 @@
(target . ,target-builder)))) (target . ,target-builder))))
(arguments (arguments
. ,(if (eq? base-args target-args) . ,(if (eq? base-args target-args)
`((common . ,base-args)) `((common . ,(list->vector base-args)))
`((base . ,base-args) `((base . ,(list->vector base-args))
(target . ,target-args)))) (target . ,(list->vector target-args)))))
(environment-variables (environment-variables
. ,(map (lambda (key) . ,(map (lambda (key)
(let ((base-value (fetch-value base-env-vars 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 (let ((parsed-derivation-ids
(map string->number (map string->number
(parse-postgresql-array-string derivation_ids)))) (parse-postgresql-array-string derivation_ids))))
(list output-name `((output-name . ,output-name)
path (path . ,path)
hash-algorithm ,@(if (string? hash-algorithm)
hash `((hash-algorithm . ,hash-algorithm))
recursive `((hash-algorithm . null)))
(append (if (memq base-derivation-id ,@(if (string? hash)
parsed-derivation-ids) `((hash . ,hash))
'(base) `((hash . null)))
'()) (recursive . ,(string=? recursive "t"))
(if (memq target-derivation-id ,(append (if (memq base-derivation-id
parsed-derivation-ids) parsed-derivation-ids)
'(target) '(base)
'())))))) '())
(if (memq target-derivation-id
parsed-derivation-ids)
'(target)
'()))))))
(exec-query conn query))) (exec-query conn query)))
(define (derivation-inputs-differences-data conn (define (derivation-inputs-differences-data conn
@ -202,16 +207,16 @@ INNER JOIN derivations ON derivation_outputs.derivation_id = derivations.id
(let ((parsed-derivation-ids (let ((parsed-derivation-ids
(map string->number (map string->number
(parse-postgresql-array-string derivation_ids)))) (parse-postgresql-array-string derivation_ids))))
(list derivation_file_name `((derivation_file_name . ,derivation_file_name)
derivation_output_name (derivation_output_name . ,derivation_output_name)
(append (if (memq base-derivation-id ,(append (if (memq base-derivation-id
parsed-derivation-ids) parsed-derivation-ids)
'(base) '(base)
'()) '())
(if (memq target-derivation-id (if (memq target-derivation-id
parsed-derivation-ids) parsed-derivation-ids)
'(target) '(target)
'())))))) '()))))))
(exec-query conn query))) (exec-query conn query)))
(define (derivation-sources-differences-data conn (define (derivation-sources-differences-data conn
@ -235,15 +240,15 @@ GROUP BY derivation_source_files.store_path"))
(let ((parsed-derivation-ids (let ((parsed-derivation-ids
(map string->number (map string->number
(parse-postgresql-array-string derivation_ids)))) (parse-postgresql-array-string derivation_ids))))
(list store_path `((store_path . ,store_path)
(append (if (memq base-derivation-id ,(append (if (memq base-derivation-id
parsed-derivation-ids) parsed-derivation-ids)
'(base) '(base)
'()) '())
(if (memq target-derivation-id (if (memq target-derivation-id
parsed-derivation-ids) parsed-derivation-ids)
'(target) '(target)
'())))))) '()))))))
(exec-query conn query))) (exec-query conn query)))
(define* (package-derivation-differences-data conn (define* (package-derivation-differences-data conn

8
guix-data-service/model/utils.scm
View file

@ -33,6 +33,7 @@
deduplicate-strings deduplicate-strings
group-list-by-first-n-fields group-list-by-first-n-fields
group-to-alist group-to-alist
group-to-alist/vector
insert-missing-data-and-return-all-ids)) insert-missing-data-and-return-all-ids))
(define NULL '()) (define NULL '())
@ -114,6 +115,13 @@
'() '()
lst)) 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) (define (table-schema conn table-name)
(let ((results (let ((results
(exec-query (exec-query

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

@ -589,82 +589,18 @@
'(application/json text/html) '(application/json text/html)
mime-types) mime-types)
((application/json) ((application/json)
(let ((outputs (render-json
(map `((base . ((derivation . ,base-derivation)))
(lambda (label items) (target . ((derivation . ,target-derivation)))
(cons label (outputs . ,(assq-ref data 'outputs))
(list->vector (inputs . ,(assq-ref data 'inputs))
(map (sources . ,(assq-ref data 'sources))
(match-lambda (system . ,(assq-ref data 'system))
((name path hash-alg hash recursive) (builder . ,(assq-ref data 'builder))
`((name . ,name) (arguments . ,(assq-ref data 'arguments))
(path . ,path) (environment-variables . ,(assq-ref
,@(if (string? hash-alg) data 'environment-variables)))
`((hash-algorithm . ,hash-alg)) #:extra-headers http-headers-for-unchanging-content))
'())
,@(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)))
(else (else
(render-html (render-html
#:sxml (compare/derivation #:sxml (compare/derivation

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

@ -494,27 +494,23 @@
(th "Hash") (th "Hash")
(th "Recursive"))) (th "Recursive")))
(tbody (tbody
,@(let ((base-outputs (assq-ref outputs 'base)) ,@(append-map
(target-outputs (assq-ref outputs 'target)) (lambda (label items)
(common-outputs (assq-ref outputs 'common))) (map
(append-map (lambda (alist)
(lambda (label items) `(tr
(map (td ,label)
(match-lambda (td ,(assq-ref alist 'output-name))
((name path hash-algorithm hash recursive) (td (a (@ (href ,(assq-ref alist 'path)))
`(tr ,(display-store-item (assq-ref alist 'path))))
(td ,label) (td ,(assq-ref alist 'hash-algorithm))
(td ,name) (td ,(assq-ref alist 'hash))
(td (a (@ (href ,path)) (td ,(assq-ref alist 'recursive))))
,(display-store-item path))) (or (and=> items vector->list) '())))
(td ,hash-algorithm) (list base target "Common")
(td ,hash) (list (assq-ref outputs 'base)
(td ,recursive)))) (assq-ref outputs 'target)
(or items '()))) (assq-ref outputs 'common)))))))
(list base target "Common")
(list (assq-ref outputs 'base)
(assq-ref outputs 'target)
(assq-ref outputs 'common))))))))
(h2 "Inputs") (h2 "Inputs")
,@(let ((inputs (assq-ref data 'inputs))) ,@(let ((inputs (assq-ref data 'inputs)))
`((table `((table
@ -528,14 +524,13 @@
,@(append-map ,@(append-map
(lambda (label items) (lambda (label items)
(map (map
(match-lambda (lambda (alist)
((derivation outputs) `(tr
`(tr (td ,label)
(td ,label) (td (a (@ (href ,(assq-ref alist 'derivation_file_name)))
(td (a (@ (href ,derivation)) ,(display-store-item (assq-ref alist 'derivation_file_name))))
,(display-store-item derivation))) (td ,(assq-ref alist 'derivation_output_name))))
(td ,outputs)))) (or (and=> items vector->list) '())))
(or items '())))
(list base target) (list base target)
(list (assq-ref inputs 'base) (list (assq-ref inputs 'base)
(assq-ref inputs 'target))))))) (assq-ref inputs 'target)))))))
@ -552,13 +547,12 @@
,@(append-map ,@(append-map
(lambda (label items) (lambda (label items)
(map (map
(match-lambda (lambda (alist)
((file) `(tr
`(tr (td ,label)
(td ,label) (td (a (@ (href ,(assq-ref alist 'store_path)))
(td (a (@ (href ,file)) ,(display-store-item (assq-ref alist 'store_path))))))
,(display-store-item file)))))) (or (and=> items vector->list) '())))
(or items '())))
(list base target "Common") (list base target "Common")
(list (assq-ref sources 'base) (list (assq-ref sources 'base)
(assq-ref sources 'target) (assq-ref sources 'target)
@ -622,8 +616,8 @@
(td (ol (td (ol
,@(map (lambda (arg) ,@(map (lambda (arg)
`(li ,(display-possible-store-item arg))) `(li ,(display-possible-store-item arg)))
(or common-args (or (and=> common-args vector->list)
base-args))))) (vector->list base-args))))))
(tr (tr
(td ,target) (td ,target)
(td ,(display-possible-store-item (td ,(display-possible-store-item
@ -632,8 +626,8 @@
(td (ol (td (ol
,@(map (lambda (arg) ,@(map (lambda (arg)
`(li ,(display-possible-store-item arg))) `(li ,(display-possible-store-item arg)))
(or common-args (or (and=> common-args vector->list)
target-args)))))))))))) (vector->list target-args)))))))))))))
(h2 "Environment variables") (h2 "Environment variables")
,(let ((environment-variables (assq-ref data 'environment-variables))) ,(let ((environment-variables (assq-ref data 'environment-variables)))
`(table `(table