From 74217b986ba5582c70ec84b94b3b972764b515b6 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 31 Jan 2015 20:54:35 -0500
Subject: Move all modules into the 'guix web' namespace.

* guix-web/config.scm: Delete.
* guix-web/controller.scm: Delete.
* guix-web/package.scm: Delete.
* guix-web/render.scm: Delete.
* guix-web/server.scm: Delete.
* guix-web/sxml.scm: Delete.
* guix-web/util.scm: Delete.
* guix-web/view/html.scm: Delete.
* guix-web/view/json.scm: Delete.
* guix/web/config.scm: New file.
* guix/web/controller.scm: New file.
* guix/web/package.scm: New file.
* guix/web/render.scm: New file.
* guix/web/server.scm: New file.
* guix/web/sxml.scm: New file.
* guix/web/util.scm: New file.
* guix/web/view/html.scm: New file.
* guix/web/view/json.scm: New file.
* guix/scripts/web.scm: Tweak imports.
* Makefile.am (SOURCES): Add new files and remove deleted ones.
---
 guix/web/view/html.scm | 131 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 131 insertions(+)
 create mode 100644 guix/web/view/html.scm

(limited to 'guix/web/view/html.scm')

diff --git a/guix/web/view/html.scm b/guix/web/view/html.scm
new file mode 100644
index 0000000..462055c
--- /dev/null
+++ b/guix/web/view/html.scm
@@ -0,0 +1,131 @@
+;;; guix-web - Web interface for GNU Guix
+;;; Copyright © 2014, 2015  David Thompson <davet@gnu.org>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU Affero General Public License
+;;; as published by the Free Software Foundation, either version 3 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (guix web view html)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (web uri)
+  #:use-module (guix licenses)
+  #:use-module (guix packages)
+  #:use-module (guix profiles)
+  #:use-module (gnu packages)
+  #:use-module (guix web package)
+  #:export (all-packages
+            view-package
+            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
+  (list (javascript "/js/lib/underscore.js" expat)
+        (javascript "/js/lib/mithril.js" expat)
+        (javascript "/js/utils.js" agpl3+)
+        (javascript "/js/view/ui.js" agpl3+)
+        (javascript "/js/view/layout.js" agpl3+)
+        (javascript "/js/model/packages.js" agpl3+)
+        (javascript "/js/model/generations.js" agpl3+)
+        (javascript "/js/controller/packages.js" agpl3+)
+        (javascript "/js/controller/packageInfo.js" agpl3+)
+        (javascript "/js/controller/generations.js" agpl3+)
+        (javascript "/js/view/packages.js" agpl3+)
+        (javascript "/js/view/packageInfo.js" agpl3+)
+        (javascript "/js/view/generations.js" agpl3+)
+        (javascript "/js/routes.js" agpl3+)))
+
+(define stylesheets
+  (list "/css/bootstrap.css"
+        "/css/guix.css"))
+
+(define (render-javascript javascript)
+  `(script (@ (type "text/javascript")
+              (src ,(javascript-source-uri javascript)))))
+
+(define (render-stylesheet stylesheet-uri)
+  `(link (@ (rel "stylesheet")
+            (href ,stylesheet-uri))))
+
+(define (main-layout subtitle body)
+  `((doctype "HTML")
+    (html
+     (head
+      (meta (@ (content "text/html;charset=utf-8")
+               (http-equiv "Content-Type")))
+      (title ,(string-append "GNU Guix - " subtitle))
+      ,@(map render-stylesheet stylesheets))
+     (body ,body))))
+
+(define (render-package-license package)
+  (define (license-link license)
+    `(a (@ (href ,(license-uri license)))
+        ,(license-name license)))
+
+  (let ((license (package-license package)))
+    (cond ((list? license)
+           `(ul (@ (class "list-inline"))
+                ,@(map (lambda (l)
+                         `(li ,(license-link l)))
+                       license)))
+          ((license? license)
+           (license-link license))
+          (else ""))))
+
+(define (all-packages)
+  (main-layout "Packages" (map render-javascript javascripts)))
+
+(define (librejs)
+  (define (weblabel js)
+    (let ((source (javascript-source-uri js)))
+      `(tr
+        (td
+         (a (@ (href ,source))
+            ,source))
+        (td
+         (a (@ (href ,(javascript-license-uri js)))
+            ,(license-name (javascript-license js))))
+        (td
+         (a (@ (href ,source))
+            ,(basename source))))))
+
+  (main-layout
+   "LibreJS"
+   `(div (@ (class "container"))
+         (div
+          (a (@ (href "/"))
+             (img (@ (src "/images/logo.png")))))
+         (h1 "JavaScript License Information")
+         (table (@ (id "jslicense-labels1")
+                   (class "table"))
+                (thead
+                 (tr
+                  (th "URI")
+                  (th "License")
+                  (th "Source Code")))
+                (tbody ,@(map weblabel javascripts))))))
-- 
cgit v1.2.3