diff options
| author | Christopher Baines <mail@cbaines.net> | 2019-03-29 09:13:29 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2019-03-29 09:13:29 +0000 |
| commit | 944492bd797703f18300672f92e296733295fbd4 (patch) | |
| tree | 2618ef73052fa213c7d06c971b6b46dbd23735e8 | |
| parent | b1ab70a226755208168de3e3ff077e37fb6fb2c1 (diff) | |
| download | data-service-944492bd797703f18300672f92e296733295fbd4.tar data-service-944492bd797703f18300672f92e296733295fbd4.tar.gz | |
Deduplicate inferior packages
As sometimes there can be duplicates, for example with deprecated packages.
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 34 |
1 files changed, 33 insertions, 1 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 071457e..056432a 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -118,10 +118,42 @@ (append (map list supported-system-pairs) supported-system-cross-build-pairs))) +(define (deduplicate-inferior-packages packages) + (pair-fold + (lambda (pair result) + (if (null? (cdr pair)) + (cons (first pair) result) + (let* ((a (first pair)) + (b (second pair)) + (a-name (inferior-package-name a)) + (b-name (inferior-package-name b)) + (a-version (inferior-package-version a)) + (b-version (inferior-package-version b))) + (if (and (string=? a-name b-name) + (string=? a-version b-version)) + (begin + (simple-format (current-error-port) + "warning: ignoring duplicate package: ~A (~A)\n" + a-name + a-version) + result) + (cons a result))))) + '() + (sort packages + (lambda (a b) + (let ((a-name (inferior-package-name a)) + (b-name (inferior-package-name b))) + (if (string=? a-name b-name) + (string<? (inferior-package-version a) + (inferior-package-version b)) + (string<? a-name + b-name))))))) + (define (inferior-guix->package-derivation-ids store conn inf) (let* ((packages (log-time "fetching inferior packages" (lambda () - (inferior-packages inf)))) + (deduplicate-inferior-packages + (inferior-packages inf))))) (packages-metadata-ids (log-time "fetching inferior package metadata" (lambda () |