summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xguix-web72
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)))