From 04bd443162b063bce43f602f26dc5ace24e6a6f8 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Thu, 7 Aug 2014 07:55:20 -0400
Subject: Add LibreJS weblabels page.

* guix-web (javascripts): Use absolute paths.
  (run-route): Add weblabels route.
  (all-packages): Add js license information link.
  (weblabels): New procedure.
---
 guix-web | 34 +++++++++++++++++++++++++++++++---
 1 file changed, 31 insertions(+), 3 deletions(-)

diff --git a/guix-web b/guix-web
index 81595c1..4afc56a 100755
--- a/guix-web
+++ b/guix-web
@@ -115,9 +115,9 @@
 ;;;
 
 (define javascripts
-  '("js/underscore.js"
-    "js/mithril.js"
-    "js/guix-web.js"))
+  '("/js/underscore.js"
+    "/js/mithril.js"
+    "/js/guix-web.js"))
 
 (define (run-route request)
   (match (cons (request-method request)
@@ -128,6 +128,8 @@
      (render-html (all-packages)))
     ((GET "packages.json")
      (render-json (all-packages-json)))
+    ((GET "weblabels")
+     (render-html (weblabels)))
     (_ #f)))
 
 (define (all-packages-json)
@@ -176,8 +178,34 @@
     (body
      (div (@ (id "guix")
              (class "container")))
+     (footer
+      (small
+       (a (@ (href "/weblabels")
+             (rel "jslicense"))
+          "JavaScript license information")))
      ,@(map script-tag javascripts))))
 
+(define (weblabels)
+  (define (weblabel js)
+    `(tr
+      (td
+       (a (@ (href ,js))
+          ,(basename js)))
+      (td
+       (a (@ (href "http://www.gnu.org/licenses/agpl-3.0.html"))
+          ,(license-name agpl3+)))
+      (td
+       (a (@ (href ,js))
+          ,(basename js)))))
+
+  `(html
+    (head
+     (title "GNU Guix"))
+    (body
+     (div (@ (class "container"))
+          (table (@ (id "jslicense-labels1"))
+                 ,@(map weblabel javascripts))))))
+
 (spawn-server (make-tcp-server-socket #:port 37146))
 (run-server (lambda args (apply handler args)))
 
-- 
cgit v1.2.3