From d2a437f447f99fc3689e2b1420dffb0eef7fb899 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Wed, 13 Aug 2014 20:50:07 -0400
Subject: Add javascript record type.

* guix-web/view.scm (<javascript>): New record type.
  (javascript, javascript?, javascript-source-uri, javascript-license,
  javascript-license-uri): New procedures.
  (javascripts): Use javascript constructor.
  (script-tag, librejs): Use new javascript procedures.
---
 guix-web/view.scm | 46 +++++++++++++++++++++++++++++++---------------
 1 file changed, 31 insertions(+), 15 deletions(-)

diff --git a/guix-web/view.scm b/guix-web/view.scm
index 1a7f2a1..c1c2941 100644
--- a/guix-web/view.scm
+++ b/guix-web/view.scm
@@ -18,6 +18,7 @@
 (define-module (guix-web view)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
   #:use-module (json)
   #:use-module (web uri)
   #:use-module (guix licenses)
@@ -29,14 +30,28 @@
             view-package-json
             librejs))
 
+(define-record-type <javascript>
+  (javascript source-uri license)
+  javascript?
+  (source-uri javascript-source-uri)
+  (license javascript-license))
+
+(define (javascript-license-uri javascript)
+  (let ((license (javascript-license javascript)))
+    (cond
+     ((eq? license expat)
+      "http://www.jclark.com/xml/copying.txt")
+     ((eq? license agpl3+)
+      "https://www.gnu.org/licenses/agpl-3.0.html"))))
+
 (define javascripts
-  '("/js/underscore.js"
-    "/js/mithril.js"
-    "/js/guix-packages.js"))
+  (list (javascript "/js/underscore.js" expat)
+        (javascript "/js/mithril.js" expat)
+        (javascript "/js/guix-packages.js" agpl3+)))
 
-(define (script-tag src)
+(define (script-tag javascript)
   `(script (@ (type "text/javascript")
-              (src ,src))
+              (src ,(javascript-source-uri javascript)))
            ;; hack to ensure closing </script> tag
            ""))
 
@@ -195,16 +210,17 @@
 
 (define (librejs)
   (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)))))
+    (let ((source (javascript-source-uri js)))
+      `(tr
+        (td
+         (a (@ (href ,source))
+            ,(basename source)))
+        (td
+         (a (@ (href ,(javascript-license-uri js)))
+            ,(license-name (javascript-license js))))
+        (td
+         (a (@ (href ,source))
+            ,(basename source))))))
 
   (main-layout
    "LibreJS"
-- 
cgit v1.2.3