From c6e4a686bdbf386d81f45cb7021c516a526a4054 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 4 Sep 2023 21:18:22 +0100
Subject: Display the README as a page

Like the data service.
---
 guix-qa-frontpage/server.scm    | 15 ++++++++++++++-
 guix-qa-frontpage/view/home.scm | 10 +++++++++-
 2 files changed, 23 insertions(+), 2 deletions(-)

(limited to 'guix-qa-frontpage')

diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index b9a814e..affaa4d 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -20,6 +20,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-71)
+  #:use-module (ice-9 textual-ports)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 match)
   #:use-module (web http)
@@ -73,7 +74,8 @@
           branches)))
 
 (define* (make-controller assets-directory database metrics-registry
-                          #:key (patch-issues-to-show 200))
+                          #:key (patch-issues-to-show 200)
+                          doc-dir)
 
   (define handle-static-assets
     (if (string-prefix? (%store-prefix)
@@ -490,6 +492,17 @@ has no patches or has been closed.")
                                         (uri-query (request-uri request))
                                         parse-query-string)
                                        '())))))
+      (('GET "README")
+       (let ((filename (string-append doc-dir "/README.html")))
+         (if (file-exists? filename)
+             (render-html
+              #:sxml (readme (call-with-input-file filename
+                               get-string-all)))
+             (render-html
+              #:sxml (general-not-found
+                      "README not found"
+                      "The README.html file does not exist")
+              #:code 404))))
       ((method path ...)
        (render-html
         #:sxml (general-not-found
diff --git a/guix-qa-frontpage/view/home.scm b/guix-qa-frontpage/view/home.scm
index b7d74d8..c5428b1 100644
--- a/guix-qa-frontpage/view/home.scm
+++ b/guix-qa-frontpage/view/home.scm
@@ -2,7 +2,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:use-module (guix-qa-frontpage view util)
-  #:export (home))
+  #:export (home
+            readme))
 
 (define (home branches)
   (layout
@@ -59,3 +60,10 @@
        (a (@ (href "mailto:guix-devel@gnu.org"))
           "guix-devel@gnu.org")
        ".")))))
+
+(define (readme contents)
+  (layout
+   #:description "Guix Quality Assurance"
+   #:body
+   `((main
+      (raw ,contents)))))
-- 
cgit v1.2.3