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

Improve package deduplication

Browse source 
Handle cases where there are up to 4 packages with the same name and version
plus some having replacements. This is currently the case with glibc.
This commit is contained in:
Christopher Baines 2025-02-25 11:23:23 +00:00
parent e591346684
commit 5684add77e
1 changed files with 79 additions and 42 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -641,6 +641,51 @@
(define (sort-and-deduplicate-inferior-packages packages (define (sort-and-deduplicate-inferior-packages packages
pkg-to-replacement-hash-table) pkg-to-replacement-hash-table)
(let ((sorted-packages
(sort packages
(lambda (a b)
(let ((a-name (inferior-package-name a))
(b-name (inferior-package-name b)))
(if (string=? a-name b-name)
(let ((a-version (inferior-package-version a))
(b-version (inferior-package-version b)))
(if (string=? a-version b-version)
(let ((a-replacement (hashq-ref pkg-to-replacement-hash-table a))
(b-replacement (hashq-ref pkg-to-replacement-hash-table b)))
(if (or (and a-replacement b-replacement)
(and (eq? #f a-replacement)
(eq? #f b-replacement)))
;; The name and version are the same, so try and
;; pick the same package each time, by looking at
;; the location.
(let ((a-location (inferior-package-location a))
(b-location (inferior-package-location b)))
(> (location-line a-location)
(location-line b-location)))
(->bool a-replacement)))
(string<? a-version
b-version)))
(string<? a-name
b-name)))))))
(define (print-packages-matching-name-and-version name version)
(simple-format (current-error-port) "packages matching: ~A@~A\n"
name version)
(for-each
(lambda (pkg)
(when (and (string=? (inferior-package-name pkg)
name)
(string=? (inferior-package-version pkg)
version))
(simple-format
(current-error-port)
" - ~A@~A (replacement: ~A, location: ~A)\n"
name
version
(hashq-ref pkg-to-replacement-hash-table pkg)
(inferior-package-location pkg))))
sorted-packages))
(pair-fold (pair-fold
(lambda (pair result) (lambda (pair result)
(if (null? (cdr pair)) (if (null? (cdr pair))
@ -652,37 +697,29 @@
(a-version (inferior-package-version a)) (a-version (inferior-package-version a))
(b-version (inferior-package-version b)) (b-version (inferior-package-version b))
(a-replacement (hashq-ref pkg-to-replacement-hash-table a)) (a-replacement (hashq-ref pkg-to-replacement-hash-table a))
(b-replacement (hashq-ref pkg-to-replacement-hash-table b))) (b-replacement (hashq-ref pkg-to-replacement-hash-table b))
(a-location (inferior-package-location a))
(b-location (inferior-package-location b)))
(if (and (string=? a-name b-name) (if (and (string=? a-name b-name)
(string=? a-version b-version) (string=? a-version b-version)
(eq? a-replacement b-replacement)) (or
(and a-replacement b-replacement)
(and (eq? #f a-replacement)
(eq? #f b-replacement))))
(begin (begin
(simple-format (current-error-port) (simple-format (current-error-port)
"warning: ignoring duplicate package: ~A (~A)\n" "warning: ignoring duplicate package: ~A@~A (replacement: ~A, location: ~A)\n"
a-name
a-version
a-replacement
(location-line a-location))
(print-packages-matching-name-and-version
a-name a-name
a-version) a-version)
result) result)
(cons a result))))) (cons a result)))))
'() '()
(sort packages sorted-packages)))
(lambda (a b)
(let ((a-name (inferior-package-name a))
(b-name (inferior-package-name b)))
(if (string=? a-name b-name)
(let ((a-version (inferior-package-version a))
(b-version (inferior-package-version b)))
(if (string=? a-version b-version)
;; The name and version are the same, so try and pick
;; the same package each time, by looking at the
;; location.
(let ((a-location (inferior-package-location a))
(b-location (inferior-package-location b)))
(> (location-line a-location)
(location-line b-location)))
(string<? a-version
b-version)))
(string<? a-name
b-name)))))))
(define (inferior-packages-plus-replacements inf) (define (inferior-packages-plus-replacements inf)
(let* ((packages (let* ((packages