Extract common page layout to procedure.

* guix-web (main-layout): New procedure.
  (all-packages, view-package, weblabels): Use main-layout.

1 files changed, 38 insertions, 34 deletions

diff --git a/guix-web b/guix-web
index 73c5641..1a63e69 100755
--- a/guix-web
+++ b/guix-web
@@ -162,6 +162,22 @@
              ("license" ,(serialize-license p)))))
          (fold-packages cons '()))))
 
+(define (main-layout subtitle body)
+  `(html
+    (head
+     (title ,(string-append "GNU Guix - " subtitle))
+     (link (@ (rel "stylesheet")
+              (href "/css/bootstrap.css"))))
+    (body
+     (div (@ (class "container"))
+          (image (@ (src "/images/logo.png")))
+          ,@body
+          (footer
+           (small
+            (a (@ (href "/librejs")
+                  (rel "jslicense"))
+               "JavaScript license information")))))))
+
 (define (render-package-license package)
   (define (license-link license)
     `(a (@ (href ,(license-uri license)))
@@ -178,19 +194,9 @@
           (else ""))))
 
 (define (all-packages)
-  `(html
-    (head
-     (title "GNU Guix")
-     (link (@ (rel "stylesheet")
-              (href "/css/bootstrap.css"))))
-    (body
-     (div (@ (id "guix")
-             (class "container")))
-     (footer
-      (small
-       (a (@ (href "/weblabels")
-             (rel "jslicense"))
-          "JavaScript license information")))
+  (main-layout
+   "Packages"
+   `((div (@ (id "guix")) "")
      ,@(map script-tag javascripts))))
 
 (define (view-package name)
@@ -213,22 +219,16 @@
                 (if (> count 1)
                     "versions"
                     "version"))))
-    `(html
-      (head
-       (title ,(string-append "GNU Guix - " name))
-       (link (@ (rel "stylesheet")
-                (href "/css/bootstrap.css"))))
-      (body
-       (div (@ (class "container"))
-            (image (@ (src "/images/logo.png")))
-            (h1 ,name (span (@ (class "badge"))
-                            ,(format-package-count)))
-            (ul (@ (class "list-unstyled"))
-                ,@(map (lambda (p)
-                           `(li ,(describe-package p)))
-                         packages)))))))
 
 (define (weblabels)
+    (main-layout
+     name
+     `((h1 ,name (span (@ (class "badge"))
+                       ,(format-package-count)))
+       (ul (@ (class "list-unstyled"))
+           ,@(map (lambda (p)
+                    `(li ,(describe-package p)))
+                  packages))))))
   (define (weblabel js)
     `(tr
       (td
@@ -241,13 +241,17 @@
        (a (@ (href ,js))
           ,(basename js)))))
 
-  `(html
-    (head
-     (title "GNU Guix"))
-    (body
-     (div (@ (class "container"))
-          (table (@ (id "jslicense-labels1"))
-                 ,@(map weblabel javascripts))))))
+  (main-layout
+   "LibreJS"
+   `((h1 "JavaScript License Information")
+     (table (@ (id "jslicense-labels1")
+               (class "table"))
+            (thead
+             (tr
+              (th "URI")
+              (th "License")
+              (th "Source Code")))
+            (tbody ,@(map weblabel javascripts))))))
 
 (spawn-server (make-tcp-server-socket #:port 37146))
 (run-server (lambda args (apply handler args)))