cbaines pushed a commit to branch master
in repository data-service.
commit 957727c51aafe916da34a33778fa4e8112492fd6
Author: Christopher Baines <m...@cbaines.net>
AuthorDate: Sun Apr 28 22:03:25 2024 +0100
Fix package replacement handling on the revision packages page
---
guix-data-service/model/package.scm | 12 ++++++++----
guix-data-service/web/revision/controller.scm | 19 ++++++++++++-------
guix-data-service/web/revision/html.scm | 7 +++++--
3 files changed, 25 insertions(+), 13 deletions(-)
diff --git a/guix-data-service/model/package.scm
b/guix-data-service/model/package.scm
index 7ec2b09..8d62ef3 100644
--- a/guix-data-service/model/package.scm
+++ b/guix-data-service/model/package.scm
@@ -65,7 +65,9 @@ JOIN (VALUES "
(define query
(string-append "
WITH data AS (
- SELECT packages.name, packages.version, translated_package_synopsis.synopsis,
+ SELECT packages.name, packages.version,
+ packages.replacement_package_id IS NOT NULL,
+ translated_package_synopsis.synopsis,
translated_package_synopsis.locale,
translated_package_descriptions.description,
translated_package_descriptions.locale, package_metadata.home_page,
locations.file, locations.line, locations.column_number,
@@ -165,7 +167,9 @@ WITH revision_packages AS (
SELECT DISTINCT ON
(packages.name, packages.version, packages.replacement_package_id)
packages.name,
- packages.version, package_synopsis.synopsis,
+ packages.version,
+ packages.replacement_package_id IS NOT NULL AS has_replacement,
+ package_synopsis.synopsis,
package_synopsis.locale AS synopsis_locale,
package_descriptions.description,
package_descriptions.locale AS description_locale,
@@ -203,7 +207,7 @@ WITH revision_packages AS (
ELSE 0
END DESC
)
-SELECT name, version, synopsis, synopsis_locale,
+SELECT name, version, has_replacement, synopsis, synopsis_locale,
description, description_locale,
home_page, file, line, column_number, licenses
FROM search_results
@@ -538,7 +542,7 @@ ORDER BY first_datetime DESC, package_version DESC")
(define (any-package-synopsis-or-descriptions-translations? packages locale)
(any
(match-lambda
- ((name version synopsis synopsis-locale description description-locale _
_ _ _ _)
+ ((name version has-replacement? synopsis synopsis-locale description
description-locale _ _ _ _ _)
(or (string=? synopsis-locale locale)
(string=? description-locale locale))))
packages))
diff --git a/guix-data-service/web/revision/controller.scm
b/guix-data-service/web/revision/controller.scm
index d4b741f..114e9f4 100644
--- a/guix-data-service/web/revision/controller.scm
+++ b/guix-data-service/web/revision/controller.scm
@@ -175,12 +175,14 @@
(let ((parsed-query-parameters
(parse-query-parameters
request
- `((locale ,identity #:default "en_US.UTF-8")))))
+ `((locale ,identity #:default "en_US.UTF-8")
+ (has_replacement ,parse-checkbox-value
+ #:default #f)))))
(render-revision-package-version mime-types
- commit-hash
- name
- version
- parsed-query-parameters))
+ commit-hash
+ name
+ version
+ parsed-query-parameters))
(render-unprocessed-revision mime-types
commit-hash)))
(('GET "revision" commit-hash "package-derivations")
@@ -762,7 +764,7 @@
(packages
. ,(list->vector
(map (match-lambda
- ((name version synopsis synopsis-locale
description description-locale home-page
+ ((name version has-replacement? synopsis
synopsis-locale description description-locale home-page
location-file location-line
location-column-number licenses)
`((name . ,name)
@@ -918,6 +920,8 @@
(define locale (assq-ref query-parameters 'locale))
+ (define has-replacement? (assq-ref query-parameters 'has_replacement))
+
(letpar& ((metadata
(with-resource-from-pool (connection-pool) conn
(select-package-metadata-by-revision-name-and-version
@@ -925,7 +929,8 @@
commit-hash
name
version
- locale)))
+ locale
+ #:replacement? has-replacement?)))
(derivations
(with-resource-from-pool (connection-pool) conn
(map
diff --git a/guix-data-service/web/revision/html.scm
b/guix-data-service/web/revision/html.scm
index 6081c69..0b9d4f5 100644
--- a/guix-data-service/web/revision/html.scm
+++ b/guix-data-service/web/revision/html.scm
@@ -658,7 +658,7 @@
,@(let ((fields (assq-ref query-parameters 'field)))
(map
(match-lambda
- ((name version synopsis synopsis-locale description
description-locale home-page
+ ((name version has-replacement? synopsis synopsis-locale
description description-locale home-page
location-file location-line
location-column-number licenses)
`(tr
@@ -725,7 +725,10 @@
(a (@ (href ,(string-append
(string-drop-right path-base 1)
"/" name "/" version
- "?locale=" (assoc-ref query-parameters
'locale))))
+ "?locale=" (assoc-ref query-parameters
'locale)
+ (if (string=? has-replacement? "t")
+ "&has_replacement=on"
+ ""))))
"More information")))))
packages))))))
,@(if show-next-page?
