summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am3
-rw-r--r--guix-web/controller.scm3
-rw-r--r--guix-web/view/html.scm (renamed from guix-web/view.scm)70
-rw-r--r--guix-web/view/json.scm92
4 files changed, 99 insertions, 69 deletions
diff --git a/Makefile.am b/Makefile.am
index 74b731a..ff6692a 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -27,7 +27,8 @@ SOURCES = \
guix-web/render.scm \
guix-web/server.scm \
guix-web/util.scm \
- guix-web/view.scm
+ guix-web/view/html.scm \
+ guix-web/view/json.scm
EXTRA_DIST += env.in
diff --git a/guix-web/controller.scm b/guix-web/controller.scm
index 490c80f..b3104fe 100644
--- a/guix-web/controller.scm
+++ b/guix-web/controller.scm
@@ -21,7 +21,8 @@
#:use-module (web request)
#:use-module (gnu packages)
#:use-module (guix-web render)
- #:use-module (guix-web view)
+ #:use-module (guix-web view html)
+ #:use-module (guix-web view json)
#:use-module (guix-web package)
#:export (controller))
diff --git a/guix-web/view.scm b/guix-web/view/html.scm
index 559d275..4331692 100644
--- a/guix-web/view.scm
+++ b/guix-web/view/html.scm
@@ -1,5 +1,5 @@
;;; guix-web - Web interface for GNU Guix
-;;; Copyright © 2014 David Thompson <davet@gnu.org>
+;;; 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
@@ -15,12 +15,11 @@
;;; License along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
-(define-module (guix-web view)
+(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 (json)
#:use-module (web uri)
#:use-module (guix licenses)
#:use-module (guix packages)
@@ -28,11 +27,8 @@
#:use-module (gnu packages)
#:use-module (guix-web package)
#:export (all-packages
- all-packages-json
view-package
- view-package-json
- librejs
- generations-json))
+ librejs))
(define-record-type <javascript>
(javascript source-uri license)
@@ -79,48 +75,6 @@
(href "/css/guix.css"))))
(body ,body)))
-(define (license->json license)
- (json
- (object
- ("name" ,(license-name license))
- ("uri" ,(license-uri license)))))
-
-(define* (package->json package #:optional serialize-inputs?)
- (define (serialize-license package)
- (let ((license (package-license package)))
- (cond
- ((list? license)
- (map license->json license))
- ((license? license)
- (license->json license))
- (else #f))))
-
- (define (serialize-inputs packages)
- (map package->json (filter package? (map second packages))))
-
- (json
- (object
- ("name" ,(package-name package))
- ("version" ,(package-version package))
- ("synopsis" ,(package-synopsis package))
- ("description" ,(package-description package))
- ("homepage" ,(package-home-page package))
- ("license" ,(serialize-license package))
- ,@(if serialize-inputs?
- `(("inputs" ,(serialize-inputs (package-inputs package)))
- ("native-inputs" ,(serialize-inputs
- (package-native-inputs package)))
- ("propagated-inputs" ,(serialize-inputs
- (package-propagated-inputs package))))
- '()))))
-
-(define (all-packages-json)
- (map package->json %all-packages))
-
-(define (view-package-json name)
- (map (lambda (p) (package->json p #t))
- (find-packages-by-name name)))
-
(define (render-package-license package)
(define (license-link license)
`(a (@ (href ,(license-uri license)))
@@ -221,21 +175,3 @@
(th "License")
(th "Source Code")))
(tbody ,@(map weblabel javascripts))))))
-
-(define (generations-json)
- (map (match-lambda
- ((n . manifest-entries)
- (json
- (object
- ("number" ,n)
- ("manifestEntries"
- ,(map (match-lambda
- (($ <manifest-entry> name version output location _)
- (json
- (object
- ("name" ,name)
- ("version" ,version)
- ("output" ,output)
- ("location" ,location)))))
- manifest-entries))))))
- (profile-generations*)))
diff --git a/guix-web/view/json.scm b/guix-web/view/json.scm
new file mode 100644
index 0000000..fd279ad
--- /dev/null
+++ b/guix-web/view/json.scm
@@ -0,0 +1,92 @@
+;;; 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 json)
+ #:use-module (ice-9 format)
+ #: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)
+ #:use-module (guix packages)
+ #:use-module (guix profiles)
+ #:use-module (gnu packages)
+ #:use-module (guix-web package)
+ #:export (all-packages-json
+ view-package-json
+ generations-json))
+
+(define (license->json license)
+ (json
+ (object
+ ("name" ,(license-name license))
+ ("uri" ,(license-uri license)))))
+
+(define* (package->json package #:optional serialize-inputs?)
+ (define (serialize-license package)
+ (let ((license (package-license package)))
+ (cond
+ ((list? license)
+ (map license->json license))
+ ((license? license)
+ (license->json license))
+ (else #f))))
+
+ (define (serialize-inputs packages)
+ (map package->json (filter package? (map second packages))))
+
+ (json
+ (object
+ ("name" ,(package-name package))
+ ("version" ,(package-version package))
+ ("synopsis" ,(package-synopsis package))
+ ("description" ,(package-description package))
+ ("homepage" ,(package-home-page package))
+ ("license" ,(serialize-license package))
+ ,@(if serialize-inputs?
+ `(("inputs" ,(serialize-inputs (package-inputs package)))
+ ("native-inputs" ,(serialize-inputs
+ (package-native-inputs package)))
+ ("propagated-inputs" ,(serialize-inputs
+ (package-propagated-inputs package))))
+ '()))))
+
+(define (all-packages-json)
+ (map package->json %all-packages))
+
+(define (view-package-json name)
+ (map (lambda (p) (package->json p #t))
+ (find-packages-by-name name)))
+
+(define (generations-json)
+ (map (match-lambda
+ ((n . manifest-entries)
+ (json
+ (object
+ ("number" ,n)
+ ("manifestEntries"
+ ,(map (match-lambda
+ (($ <manifest-entry> name version output location _)
+ (json
+ (object
+ ("name" ,name)
+ ("version" ,version)
+ ("output" ,output)
+ ("location" ,location)))))
+ manifest-entries))))))
+ (profile-generations*)))