guix/data-service
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/data-service.git synced 2023-12-14 03:23:03 +01:00
Code Issues Releases Wiki Activity

Deduplicate inferior packages

Browse source 
As sometimes there can be duplicates, for example with deprecated packages.
This commit is contained in:
Christopher Baines 2019-03-29 09:13:29 +00:00
parent b1ab70a226
commit 944492bd79
No known key found for this signature in database
GPG key ID: 5E28A33B0B84F577
1 changed files with 33 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
guix-data-service/jobs/load-new-guix-revision.scm
View file

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