Add /package endpoint.

* guix-web (file-mime-types): Add image/png.
  (run-route): Add /package endpoint.
  (license-link): Delete it.
  (render-package-license): New procedure.
  (view-package): New procedure.
* images/logo.png: New file.

1 files changed, 44 insertions, 9 deletions

diff --git a/guix-web b/guix-web
index 1dcf5a3..84c53e6 100755
--- a/guix-web
+++ b/guix-web
@@ -50,7 +50,8 @@
 
 (define file-mime-types
   '(("css" . (text/css))
-    ("js" . (text/javascript))))
+    ("js" . (text/javascript))
+    ("png" . (image/png))))
 
 (define (serve-static-asset request)
   (let ((filename (string-join
@@ -128,6 +129,8 @@
      (render-html (all-packages)))
     ((GET "packages.json")
      (render-json (all-packages-json)))
+    ((GET "package" name)
+     (render-html (view-package name)))
     ((GET "weblabels")
      (render-html (weblabels)))
     (_ #f)))
@@ -159,15 +162,20 @@
              ("license" ,(serialize-license p)))))
          (fold-packages cons '()))))
 
-(define (license-link package)
+(define (render-package-license package)
+  (define (license-link license)
+    `(a (@ (href ,(license-uri license)))
+        ,(license-name license)))
+
   (let ((license (package-license package)))
-    (if license
-        (let ((license (if (list? license)
-                           (first license)
-                           license)))
-          `(a (@ (href ,(license-uri license)))
-              ,(license-name license)))
-        "")))
+    (cond ((list? license)
+           `(ul (@ (class "list-inline"))
+                ,@(map (lambda (l)
+                         `(li ,(license-link l)))
+                       license)))
+          ((license? license)
+           (license-link license))
+          (else ""))))
 
 (define (all-packages)
   `(html
@@ -185,6 +193,33 @@
           "JavaScript license information")))
      ,@(map script-tag javascripts))))
 
+(define (view-package name)
+  (define (describe-package package)
+    `(dl
+      (dt "Version")
+      (dd ,(package-version package))
+      (dt "Synopsis")
+      (dd ,(package-synopsis package))
+      (dt "Description")
+      (dd ,(package-description package))
+      (dt "License")
+      (dd ,(render-package-license package))))
+
+  (let ((packages (find-packages-by-name name)))
+    `(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")) ,(length packages)))
+            (ul (@ (class "list-unstyled"))
+                ,@(map (lambda (p)
+                           `(li ,(describe-package p)))
+                         packages)))))))
+
 (define (weblabels)
   (define (weblabel js)
     `(tr