From 957727c51aafe916da34a33778fa4e8112492fd6 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 28 Apr 2024 22:03:25 +0100
Subject: 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(-)

(limited to 'guix-data-service')

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?
-- 
cgit v1.2.3