From 006b96a9ff41f5d8e639f93f81eeab87d204bd89 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 4 Feb 2024 14:03:17 +0100
Subject: Add support for tag links

---
 bffe/server.scm     |  6 ++++--
 bffe/view/build.scm | 11 ++++++++---
 2 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/bffe/server.scm b/bffe/server.scm
index 65b49b5..b8788c0 100644
--- a/bffe/server.scm
+++ b/bffe/server.scm
@@ -419,7 +419,8 @@
                           #:key
                           title
                           (template-directory (%config 'template-dir))
-                          (derivation-link-target (const #f)))
+                          (derivation-link-target (const #f))
+                          (tag-link-target (const #f)))
 
   (define handle-static-assets
     (if (string-prefix? (%store-prefix)
@@ -522,7 +523,8 @@
             (render-html
              #:sxml (build title
                            (json->scm body)
-                           derivation-link-target))))))
+                           derivation-link-target
+                           tag-link-target))))))
       (('GET "agent" agent-id)
        (let ((response
               body
diff --git a/bffe/view/build.scm b/bffe/view/build.scm
index a9cf84a..ded00ef 100644
--- a/bffe/view/build.scm
+++ b/bffe/view/build.scm
@@ -7,7 +7,7 @@
   #:use-module ((guix store) #:select (%store-prefix))
   #:export (build))
 
-(define (build title build-details derivation-link-target)
+(define (build title build-details derivation-link-target tag-link-target)
   (layout
    #:title (string-append
             "Build " (assoc-ref build-details "uuid") " — " title)
@@ -27,8 +27,13 @@
        (dt "Tags")
        (dd (ul
             ,@(map (lambda (tag)
-                     `(li ,(assoc-ref tag "key") ": "
-                          ,(assoc-ref tag "value")))
+                     (let* ((key (assoc-ref tag "key"))
+                            (value (assoc-ref tag "value"))
+                            (link (tag-link-target key value build-details)))
+                       (if link
+                           `(a (@ (href ,link))
+                               (li ,key ": " ,value))
+                           `(li ,key ": " ,value))))
                    (vector->list
                     (assoc-ref build-details "tags")))))
 
-- 
cgit v1.2.3