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

Better split up the comparision functionality

Browse source 
The packages comparison was getting confused by differences in the
derivations, so split the data used to make the comparison more sensible.

This resolves an issue comparing 8dd723f5… and 365892e9… which coinsided with
the fix for importing foreign architecture derivations, meaning that a whole
lot of new derivations appeared in the database. Prior to these changes, it
appeared like every package was new, and with these changes, the list is more
sensible.
This commit is contained in:
Christopher Baines 2020-01-02 20:41:24 +00:00
parent a6302a32ef
commit 83c86431ae
2 changed files with 111 additions and 54 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -27,15 +27,20 @@
#:use-module (guix-data-service model derivation) #:use-module (guix-data-service model derivation)
#:export (derivation-differences-data #:export (derivation-differences-data
package-data->package-data-vhashes
package-differences-data package-differences-data
package-data-vhash->derivations package-data->package-data-vhashes
package-data->names-and-versions
package-data-vhash->derivations-and-build-status
package-data-vhashes->new-packages package-data-vhashes->new-packages
package-data-vhashes->removed-packages package-data-vhashes->removed-packages
package-data-version-changes package-data-version-changes
package-data-derivation-changes
package-derivation-differences-data
package-derivation-data->package-derivation-data-vhashes
package-derivation-data->names-and-versions
package-derivation-data-vhash->derivations
package-derivation-data-vhash->derivations-and-build-status
package-derivation-data-changes
lint-warning-differences-data lint-warning-differences-data
@ -239,12 +244,12 @@ GROUP BY derivation_source_files.store_path"))
'())))))) '()))))))
(exec-query conn query))) (exec-query conn query)))
(define* (package-differences-data conn (define* (package-derivation-differences-data conn
base_guix_revision_id base_guix_revision_id
target_guix_revision_id target_guix_revision_id
#:key #:key
(systems #f) (systems #f)
(targets #f)) (targets #f))
(define extra-constraints (define extra-constraints
(string-append (string-append
(if systems (if systems
@ -318,6 +323,50 @@ ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.v
(exec-query conn query (list base_guix_revision_id target_guix_revision_id))) (exec-query conn query (list base_guix_revision_id target_guix_revision_id)))
(define* (package-differences-data conn
base_guix_revision_id
target_guix_revision_id)
(define query
(string-append "
WITH base_packages AS (
SELECT *
FROM packages
WHERE id IN (
SELECT package_id
FROM package_derivations
INNER JOIN guix_revision_package_derivations
ON package_derivations.id =
guix_revision_package_derivations.package_derivation_id
WHERE guix_revision_package_derivations.revision_id = $1
)
), target_packages AS (
SELECT *
FROM packages
WHERE id IN (
SELECT package_id
FROM package_derivations
INNER JOIN guix_revision_package_derivations
ON package_derivations.id =
guix_revision_package_derivations.package_derivation_id
WHERE guix_revision_package_derivations.revision_id = $2
)
)
SELECT base_packages.name, base_packages.version,
base_packages.package_metadata_id,
target_packages.name, target_packages.version,
target_packages.package_metadata_id
FROM base_packages
FULL OUTER JOIN target_packages
ON base_packages.name = target_packages.name
AND base_packages.version = target_packages.version
WHERE
base_packages.id IS NULL OR
target_packages.id IS NULL OR
base_packages.id != target_packages.id
ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.version, target_packages.version"))
(exec-query conn query (list base_guix_revision_id target_guix_revision_id)))
(define (package-data->package-data-vhashes package-data) (define (package-data->package-data-vhashes package-data)
(define (add-data-to-vhash data vhash) (define (add-data-to-vhash data vhash)
(let ((key (first data))) (let ((key (first data)))
@ -327,6 +376,25 @@ ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.v
(drop data 1) (drop data 1)
vhash)))) vhash))))
(apply values
(fold (lambda (row result)
(let-values (((base-row-part target-row-part) (split-at row 3)))
(match result
((base-package-data target-package-data)
(list (add-data-to-vhash base-row-part base-package-data)
(add-data-to-vhash target-row-part target-package-data))))))
(list vlist-null vlist-null)
package-data)))
(define (package-derivation-data->package-derivation-data-vhashes package-data)
(define (add-data-to-vhash data vhash)
(let ((key (first data)))
(if (string-null? key)
vhash
(vhash-cons key
(drop data 1)
vhash))))
(apply values (apply values
(fold (lambda (row result) (fold (lambda (row result)
(let-values (((base-row-part target-row-part) (split-at row 6))) (let-values (((base-row-part target-row-part) (split-at row 6)))
@ -337,7 +405,7 @@ ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.v
(list vlist-null vlist-null) (list vlist-null vlist-null)
package-data))) package-data)))
(define (package-data->names-and-versions package-data) (define (package-derivation-data->names-and-versions package-data)
(reverse (reverse
(pair-fold (pair-fold
(lambda (pair result) (lambda (pair result)
@ -359,7 +427,7 @@ ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.v
(cons base-name base-version)))) (cons base-name base-version))))
package-data)))) package-data))))
(define (package-data-vhash->derivations conn packages-vhash) (define (package-derivation-data-vhash->derivations conn packages-vhash)
(define (vhash->derivation-ids vhash) (define (vhash->derivation-ids vhash)
(vhash-fold (lambda (key value result) (vhash-fold (lambda (key value result)
(cons (third value) (cons (third value)
@ -373,9 +441,13 @@ ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.v
(select-derivations-by-id conn derivation-ids))) (select-derivations-by-id conn derivation-ids)))
derivation-data)) derivation-data))
(define (package-data-vhash->derivations-and-build-status conn packages-vhash (define (package-derivation-data-vhash->derivations-and-build-status
systems targets conn
build-statuses) package-derivation-data-vhash
systems
targets
build-statuses)
(define (vhash->derivation-file-names vhash) (define (vhash->derivation-file-names vhash)
(vhash-fold (lambda (key value result) (vhash-fold (lambda (key value result)
(cons (third value) (cons (third value)
@ -384,7 +456,7 @@ ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.v
vhash)) vhash))
(let* ((derivation-file-names (let* ((derivation-file-names
(vhash->derivation-file-names packages-vhash))) (vhash->derivation-file-names package-derivation-data-vhash)))
(if (null? derivation-file-names) (if (null? derivation-file-names)
'() '()
(select-derivations-and-build-status (select-derivations-and-build-status
@ -431,29 +503,13 @@ ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.v
base-packages-vhash)))) base-packages-vhash))))
(define (package-data-vhash->package-versions-hash-table package-data-vhash) (define (package-data-vhash->package-versions-hash-table package-data-vhash)
(define (system-and-target<? a b)
(if (string=? (car a) (car b))
(string<? (cdr a) (cdr b))
(string<? (car a) (car b))))
(define (add-version-system-and-target-to-alist alist data)
(match data
((version package-metadata-id derivation-id system target)
(let ((systems-for-version (or (and=> (assoc version alist) cdr)
'())))
`((,version . ,(sort (cons (cons system target)
systems-for-version)
system-and-target<?))
,@(alist-delete version alist))))))
(vhash-fold (lambda (name details result) (vhash-fold (lambda (name details result)
(let ((version (first details)) (let ((version (first details))
(known-versions (or (hash-ref result name) (known-versions (or (hash-ref result name)
'()))) '())))
(hash-set! result (hash-set! result
name name
(add-version-system-and-target-to-alist known-versions (cons version known-versions))
details))
result)) result))
(make-hash-table) (make-hash-table)
package-data-vhash)) package-data-vhash))
@ -465,12 +521,12 @@ ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.v
(target-versions (target-versions
(package-data-vhash->package-versions-hash-table (package-data-vhash->package-versions-hash-table
target-packages-vhash))) target-packages-vhash)))
>
(hash-fold (lambda (name target-versions result) (hash-fold (lambda (name target-versions result)
(let ((base-versions (hash-ref base-versions name))) (let ((base-versions (hash-ref base-versions name)))
(if base-versions (if base-versions
(let ((base-version-numbers (map car base-versions)) (let ((base-version-numbers base-versions)
(target-version-numbers (map car target-versions))) (target-version-numbers target-versions))
(if (equal? base-version-numbers target-version-numbers) (if (equal? base-version-numbers target-version-numbers)
result result
(cons (cons
@ -481,7 +537,7 @@ ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.v
'() '()
target-versions))) target-versions)))
(define (package-data-derivation-changes names-and-versions (define (package-derivation-data-changes names-and-versions
base-packages-vhash base-packages-vhash
target-packages-vhash) target-packages-vhash)

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

@ -460,18 +460,19 @@
(build-statuses (assq-ref query-parameters 'build_status))) (build-statuses (assq-ref query-parameters 'build_status)))
(let* (let*
((data ((data
(package-differences-data conn (package-derivation-differences-data
(commit->revision-id conn base-commit) conn
(commit->revision-id conn target-commit) (commit->revision-id conn base-commit)
#:systems systems (commit->revision-id conn target-commit)
#:targets targets)) #:systems systems
#:targets targets))
(names-and-versions (names-and-versions
(package-data->names-and-versions data))) (package-derivation-data->names-and-versions data)))
(let-values (let-values
(((base-packages-vhash target-packages-vhash) (((base-packages-vhash target-packages-vhash)
(package-data->package-data-vhashes data))) (package-derivation-data->package-derivation-data-vhashes data)))
(let ((derivation-changes (let ((derivation-changes
(package-data-derivation-changes names-and-versions (package-derivation-data-changes names-and-versions
base-packages-vhash base-packages-vhash
target-packages-vhash))) target-packages-vhash)))
(case (most-appropriate-mime-type (case (most-appropriate-mime-type
@ -538,18 +539,18 @@
target-branch target-branch
target-datetime)) target-datetime))
(data (data
(package-differences-data conn (package-derivation-differences-data conn
(first base-revision-details) (first base-revision-details)
(first target-revision-details) (first target-revision-details)
#:systems systems #:systems systems
#:targets targets)) #:targets targets))
(names-and-versions (names-and-versions
(package-data->names-and-versions data))) (package-derivation-data->names-and-versions data)))
(let-values (let-values
(((base-packages-vhash target-packages-vhash) (((base-packages-vhash target-packages-vhash)
(package-data->package-data-vhashes data))) (package-derivation-data->package-derivation-data-vhashes data)))
(let ((derivation-changes (let ((derivation-changes
(package-data-derivation-changes names-and-versions (package-derivation-data-changes names-and-versions
base-packages-vhash base-packages-vhash
target-packages-vhash))) target-packages-vhash)))
(case (most-appropriate-mime-type (case (most-appropriate-mime-type