aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--guix-data-service/jobs/load-new-guix-revision.scm55
-rw-r--r--guix-data-service/model/package-metadata.scm20
-rw-r--r--guix-data-service/model/package.scm8
-rw-r--r--sqitch/deploy/packages_replacement.sql16
-rw-r--r--sqitch/revert/packages_replacement.sql7
-rw-r--r--sqitch/sqitch.plan1
-rw-r--r--sqitch/verify/packages_replacement.sql7
-rw-r--r--tests/model-package.scm22
8 files changed, 118 insertions, 18 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index a25e3f9..15ca098 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -39,6 +39,7 @@
#:use-module (guix-data-service config)
#:use-module (guix-data-service database)
#:use-module (guix-data-service utils)
+ #:use-module (guix-data-service model utils)
#:use-module (guix-data-service model build)
#:use-module (guix-data-service model channel-instance)
#:use-module (guix-data-service model channel-news)
@@ -765,7 +766,34 @@ WHERE job_id = $1")
(string<? a-name
b-name)))))))
-(define (insert-packages conn inf packages)
+(define (inferior-packages-plus-replacements inf)
+ (let* ((packages
+ ;; This isn't perfect, sometimes there can be two packages with the
+ ;; same name and version, but different derivations. Guix will warn
+ ;; about this case though, generally this means only one of the
+ ;; packages should be exported.
+ (deduplicate-inferior-packages
+ (inferior-packages inf)))
+ (replacements (filter-map inferior-package-replacement packages))
+
+ (package-id-hash-table (make-hash-table)))
+
+ (for-each (lambda (pkg)
+ (hash-set! package-id-hash-table
+ (inferior-package-id pkg)
+ #t))
+ packages)
+
+ (let ((non-exported-replacements
+ (filter (lambda (pkg)
+ (eq? #f
+ (hash-ref package-id-hash-table
+ (inferior-package-id pkg))))
+ replacements)))
+
+ (append packages non-exported-replacements))))
+
+(define* (insert-packages conn inf packages #:key (process-replacements? #t))
(let* ((package-license-set-ids
(with-time-logging "fetching inferior package license metadata"
(inferior-packages->license-set-ids
@@ -777,7 +805,24 @@ WHERE job_id = $1")
(((all-package-metadata-ids new-package-metadata-ids)
(with-time-logging "fetching inferior package metadata"
(inferior-packages->package-metadata-ids
- conn inf packages package-license-set-ids))))
+ conn inf packages package-license-set-ids)))
+ ((package-replacement-package-ids)
+ (map (lambda (package)
+ (let ((replacement (inferior-package-replacement package)))
+ (if (and process-replacements? replacement)
+ ;; I'm not sure if replacements can themselves be
+ ;; replaced, but I do know for sure that there are
+ ;; infinite chains of replacements (python(2)-urllib3
+ ;; in 7c4c781aa40c42d4cd10b8d9482199f3db345e1b for
+ ;; example).
+ ;;
+ ;; This code currently just capures the first level of
+ ;; replacements
+ (car
+ (insert-packages conn inf (list replacement)
+ #:process-replacements? #f))
+ (cons "integer" NULL))))
+ packages)))
(unless (null? new-package-metadata-ids)
(with-time-logging "fetching package metadata tsvector entries"
@@ -789,7 +834,8 @@ WHERE job_id = $1")
conn
(zip (map inferior-package-name packages)
(map inferior-package-version packages)
- all-package-metadata-ids))))))
+ all-package-metadata-ids
+ package-replacement-package-ids))))))
(define (insert-lint-warnings conn inferior-package-id->package-database-id
lint-checker-ids
@@ -1201,8 +1247,7 @@ WHERE job_id = $1")
(lambda ()
(let* ((packages
(with-time-logging "fetching inferior packages"
- (deduplicate-inferior-packages
- (inferior-packages inf))))
+ (inferior-packages-plus-replacements inf)))
(inferior-lint-warnings
(with-time-logging "fetching inferior lint warnings"
(all-inferior-lint-warnings inf store packages)))
diff --git a/guix-data-service/model/package-metadata.scm b/guix-data-service/model/package-metadata.scm
index d7de893..912d0c2 100644
--- a/guix-data-service/model/package-metadata.scm
+++ b/guix-data-service/model/package-metadata.scm
@@ -109,9 +109,16 @@
fields)
" AND ")))
-(define (select-package-metadata-by-revision-name-and-version
- conn revision-commit-hash name version locale)
- (define query "
+(define* (select-package-metadata-by-revision-name-and-version
+ conn
+ revision-commit-hash
+ name
+ version
+ locale
+ #:key replacement?)
+ (define query
+ (string-append
+ "
SELECT translated_package_synopsis.synopsis, translated_package_synopsis.locale,
translated_package_descriptions.description, translated_package_descriptions.locale,
package_metadata.home_page,
@@ -179,7 +186,12 @@ WHERE packages.id IN (
WHERE guix_revisions.commit = $1
)
AND packages.name = $2
- AND packages.version = $3")
+ AND packages.version = $3"
+ (if replacement?
+ "
+ AND packages.replacement_package_id IS NOT NULL"
+ "
+ AND packages.replacement_package_id IS NULL")))
(map
(match-lambda
diff --git a/guix-data-service/model/package.scm b/guix-data-service/model/package.scm
index 813d820..97deefc 100644
--- a/guix-data-service/model/package.scm
+++ b/guix-data-service/model/package.scm
@@ -162,7 +162,9 @@ WITH revision_packages AS (
WHERE guix_revisions.commit = $1
)
), search_results AS (
- SELECT DISTINCT ON (packages.name) packages.name,
+ SELECT DISTINCT ON
+ (packages.name, packages.version, packages.replacement_package_id)
+ packages.name,
packages.version, package_synopsis.synopsis,
package_synopsis.locale AS synopsis_locale,
package_descriptions.description,
@@ -195,7 +197,7 @@ WITH revision_packages AS (
OR
package_metadata_tsvectors.synopsis_and_description @@ plainto_tsquery($2)
)
- ORDER BY name,
+ ORDER BY name, packages.version, packages.replacement_package_id,
CASE WHEN package_metadata_tsvectors.locale = 'en_US.UTF-8' THEN 2
WHEN package_metadata_tsvectors.locale = $3 THEN 1
ELSE 0
@@ -265,7 +267,7 @@ RETURNING id"))
(insert-missing-data-and-return-all-ids
conn
"packages"
- '(name version package_metadata_id)
+ '(name version package_metadata_id replacement_package_id)
package-entries))
(define (select-package-versions-for-revision conn
diff --git a/sqitch/deploy/packages_replacement.sql b/sqitch/deploy/packages_replacement.sql
new file mode 100644
index 0000000..95df32a
--- /dev/null
+++ b/sqitch/deploy/packages_replacement.sql
@@ -0,0 +1,16 @@
+-- Deploy guix-data-service:packages_replacement to pg
+
+BEGIN;
+
+ALTER TABLE packages
+ ADD COLUMN replacement_package_id integer REFERENCES packages (id);
+
+ALTER TABLE packages DROP CONSTRAINT packages_pkey;
+ALTER TABLE packages ADD PRIMARY KEY (id);
+
+CREATE UNIQUE INDEX packages_not_null_replacement_package_id_idx
+ ON packages (name, version, package_metadata_id, replacement_package_id);
+CREATE UNIQUE INDEX packages_null_replacement_package_id_idx
+ ON packages (name, version, package_metadata_id) WHERE replacement_package_id IS NULL;
+
+COMMIT;
diff --git a/sqitch/revert/packages_replacement.sql b/sqitch/revert/packages_replacement.sql
new file mode 100644
index 0000000..e3216e2
--- /dev/null
+++ b/sqitch/revert/packages_replacement.sql
@@ -0,0 +1,7 @@
+-- Revert guix-data-service:packages_replacement from pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan
index db4bac9..10a3fe1 100644
--- a/sqitch/sqitch.plan
+++ b/sqitch/sqitch.plan
@@ -81,3 +81,4 @@ remove_guix_revisions_store_path 2021-02-02T20:06:18Z Christopher Baines <mail@c
systems_table 2021-04-22T08:12:10Z Christopher Baines <mail@cbaines.net> # Add a systems table
some_indexes 2021-05-17T17:36:38Z Christopher Baines <mail@cbaines.net> # Add some indexes
package_metadata_location_id_index 2021-05-27T19:51:13Z Canan Talayhan <canan.t.talayhan@gmail.com> # Add index for location id
+packages_replacement 2021-04-24T04:52:57Z Christopher Baines <mail@cbaines.net> # Add packages.replacement_package_id
diff --git a/sqitch/verify/packages_replacement.sql b/sqitch/verify/packages_replacement.sql
new file mode 100644
index 0000000..a0deb6d
--- /dev/null
+++ b/sqitch/verify/packages_replacement.sql
@@ -0,0 +1,7 @@
+-- Verify guix-data-service:packages_replacement on pg
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;
diff --git a/tests/model-package.scm b/tests/model-package.scm
index e953645..a0fdc45 100644
--- a/tests/model-package.scm
+++ b/tests/model-package.scm
@@ -53,7 +53,8 @@
`(("en_US.UTF-8" . "Fake description")))))
(with-mock-inferior-packages
(lambda ()
- (use-modules (guix-data-service model package)
+ (use-modules (guix-data-service model utils)
+ (guix-data-service model package)
(guix-data-service model git-repository)
(guix-data-service model guix-revision)
(guix-data-service model package-metadata))
@@ -71,12 +72,16 @@
conn
""
mock-inferior-packages
- (test-license-set-ids conn))))
+ (test-license-set-ids conn)))
+ (package-replacement-package-ids
+ (make-list (length mock-inferior-packages)
+ (cons "integer" NULL))))
(match (inferior-packages->package-ids
conn
(zip (map mock-inferior-package-name mock-inferior-packages)
(map mock-inferior-package-version mock-inferior-packages)
- package-metadata-ids))
+ package-metadata-ids
+ package-replacement-package-ids))
((x) (number? x))))))
#:always-rollback? #t)
@@ -87,18 +92,23 @@
conn
""
mock-inferior-packages
- (test-license-set-ids conn))))
+ (test-license-set-ids conn)))
+ (package-replacement-package-ids
+ (make-list (length mock-inferior-packages)
+ (cons "integer" NULL))))
(test-equal
(inferior-packages->package-ids
conn
(zip (map mock-inferior-package-name mock-inferior-packages)
(map mock-inferior-package-version mock-inferior-packages)
- package-metadata-ids))
+ package-metadata-ids
+ package-replacement-package-ids))
(inferior-packages->package-ids
conn
(zip (map mock-inferior-package-name mock-inferior-packages)
(map mock-inferior-package-version mock-inferior-packages)
- package-metadata-ids)))))
+ package-metadata-ids
+ package-replacement-package-ids)))))
#:always-rollback? #t))))))
(test-end)
generated by cgit v1.2.3 (git 2.25.4) at 2024-05-17 02:55:47 +0000