summaryrefslogtreecommitdiff
path: root/guix/web/view/html.scm
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2015-01-31 20:54:35 -0500
committerDavid Thompson <dthompson2@worcester.edu>2015-01-31 20:54:35 -0500
commit74217b986ba5582c70ec84b94b3b972764b515b6 (patch)
treeb564ca79ed403e6ba9efbd677e481f0b05a1b79a /guix/web/view/html.scm
parent6d7586080110fbcb83f8ae5344d0545314d97ae6 (diff)
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.
Diffstat (limited to 'guix/web/view/html.scm')
-rw-r--r--guix/web/view/html.scm131
1 files changed, 131 insertions, 0 deletions
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))))))