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>
This commit is contained in:
Luciana Lima Brito
parent
e38bddcae5
commit
767e60b2b3
4 changed files with 97 additions and 154 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue