From 7a2fedf8fedff844536dcbe14af4232fb61ff095 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Fri, 7 Nov 2025 01:24:21 +0000
Subject: forge: Add project CI badges to home page.

---
 guix/forge/forge.scm | 23 +++++++++++++++++++++--
 1 file changed, 21 insertions(+), 2 deletions(-)

(limited to 'guix/forge')

diff --git a/guix/forge/forge.scm b/guix/forge/forge.scm
index 802ea97..9fa2cc5 100644
--- a/guix/forge/forge.scm
+++ b/guix/forge/forge.scm
@@ -148,17 +148,34 @@
                      (ice-9 match)
                      (htmlprag))
 
+        (define (laminar-badge job-name)
+          `(li (a (@ (href ,(string-append "https://"
+                                           #$(forge-configuration-laminar-domain config)
+                                           "/jobs/"
+                                           job-name)))
+                  (img (@ (src ,(string-append "https://"
+                                               #$(forge-configuration-laminar-domain config)
+                                               "/badge/"
+                                               job-name
+                                               ".svg")))))))
+
         (mkdir #$output)
         (let ((html
                (sxml->html
                 `(html
                   (body
                    ,@(map (match-lambda
-                            ((name description website-link)
+                            ((name description website-link jobs)
                              `((h2 ,(if website-link
                                         `(a (@ (href ,website-link))
                                             ,name)
                                         name))
+                               ,@(match jobs
+                                   (() '())
+                                   (_
+                                    (if #$(forge-configuration-laminar-domain config)
+                                        `((ul ,@(map laminar-badge jobs)))
+                                        '())))
                                ,@(if description
                                      `((p ,description))
                                      '())
@@ -175,7 +192,9 @@
                                           (and (forge-project-website-ci-job project)
                                                (if (forge-project-web-domain project)
                                                    (string-append "https://" (forge-project-web-domain project))
-                                                   (string-append "/" (forge-project-name project) "/")))))
+                                                   (string-append "/" (forge-project-name project) "/")))
+                                          (map forge-laminar-job-name
+                                               (forge-project-all-ci-jobs project config))))
                                   (forge-configuration-projects config))))))))
           (call-with-output-file (string-append #$output "/index.html")
             (cut put-string <> html))))))
-- 
cgit 1.4.1