;;; 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)
  (match license
    ((? license? license)
     (json
      (object
       ("name" ,(license-name license))
       ("uri" ,(license-uri license)))))
    (_  ; a dubious license that we'd rather handle gracefully
     (json
      (object
       ("name" ,(object->string license))
       ("uri" "http://www.gnu.org"))))))

(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*)))