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/web/revision/controller.scm | 19 ++++++++++++-------
 guix-data-service/web/revision/html.scm       |  7 +++++--
 2 files changed, 17 insertions(+), 9 deletions(-)

(limited to 'guix-data-service/web')

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