1 files changed, 92 insertions, 0 deletions
diff --git a/guix/web/view/json.scm b/guix/web/view/json.scm
new file mode 100644
index 0000000..4fe45a2
--- /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)))
+            ("nativeInputs" ,(serialize-inputs
+                               (package-native-inputs package)))
+            ("propagatedInputs" ,(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*)))