diff options
| -rw-r--r-- | guix-web/controller.scm | 11 | ||||
| -rw-r--r-- | guix-web/view.scm | 80 |
2 files changed, 61 insertions, 30 deletions
diff --git a/guix-web/controller.scm b/guix-web/controller.scm index 6640810..f3858d3 100644 --- a/guix-web/controller.scm +++ b/guix-web/controller.scm @@ -17,7 +17,9 @@ (define-module (guix-web controller) #:use-module (ice-9 match) + #:use-module (srfi srfi-1) #:use-module (web request) + #:use-module (gnu packages) #:use-module (guix-web render) #:use-module (guix-web view) #:export (controller)) @@ -31,7 +33,14 @@ ((GET "packages.json") (render-json (all-packages-json))) ((GET "package" name) - (render-html (view-package name))) + (match (string-split name #\.) + ((name ext) + (render-json + (if (string=? ext "json") + (view-package-json name) + '()))) + ((name) + (render-html (view-package name))))) ((GET "librejs") (render-html (librejs))) (_ #f))) diff --git a/guix-web/view.scm b/guix-web/view.scm index 6898c28..adf064b 100644 --- a/guix-web/view.scm +++ b/guix-web/view.scm @@ -17,6 +17,7 @@ (define-module (guix-web view) #:use-module (ice-9 match) + #:use-module (srfi srfi-1) #:use-module (json) #:use-module (web uri) #:use-module (guix licenses) @@ -25,6 +26,7 @@ #:export (all-packages all-packages-json view-package + view-package-json librejs)) (define javascripts @@ -54,32 +56,53 @@ (rel "jslicense")) "JavaScript license information"))))))) -(define (all-packages-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) - (define (serialize license) - (json - (object - ("name" ,(license-name license)) - ("uri" ,(license-uri license))))) (let ((license (package-license package))) (cond ((list? license) - (map serialize license)) + (map license->json license)) ((license? license) - (serialize license)) + (license->json license)) (else #f)))) - (json - ,(map (lambda (p) - (json - (object - ("name" ,(package-name p)) - ("version" ,(package-version p)) - ("synopsis" ,(package-synopsis p)) - ("description" ,(package-description p)) - ("homepage" ,(package-home-page p)) - ("license" ,(serialize-license p))))) - (fold-packages cons '())))) + (define (serialize-inputs packages) + (map package->json (filter package? (map second packages)))) + + (if serialize-inputs? + (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)) + ("inputs" ,(serialize-inputs (package-inputs package))) + ("native-inputs" ,(serialize-inputs (package-native-inputs package))) + ("propagated-inputs" ,(serialize-inputs + (package-propagated-inputs package))))) + (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)))))) + +(define (all-packages-json) + (map package->json (fold-packages cons '()))) + +(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) @@ -107,20 +130,19 @@ (define (view-package name) (define (describe-inputs package package-inputs description) (define (describe-input input) - (match input - ((_ input) - `(li - (a (@ (href ,(string-append - "/" - (encode-and-join-uri-path - `("package" ,(package-name input)))))) - ,(string-append (package-name input) " " - (package-version input))))))) + `(li + (a (@ (href ,(string-append + "/" + (encode-and-join-uri-path + `("package" ,(package-name input)))))) + ,(string-append (package-name input) " " + (package-version input))))) (let ((inputs (package-inputs package))) (if (null? inputs) '() `((dt ,description) - (dd (ul ,@(map describe-input inputs))))))) + (dd (ul ,@(map describe-input + (filter package? (second inputs))))))))) (define (describe-package package) `(dl |