;;; guix-web - Web interface for GNU Guix
;;; Copyright © 2014  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 package)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (guix derivations)
  #:use-module (guix monads)
  #:use-module (guix packages)
  #:use-module (guix profiles)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix ui)
  #:use-module (gnu packages)
  #:export (%all-packages
            package-install
            profile-generations*))

(define %all-packages
  (fold-packages cons '()))

(define %profile
  (string-append "/usr/var/guix/profiles/per-user/"
                 (getenv "USER") "/guix-profile"))
(define manifest (profile-manifest %profile))

(define (maybe-register-gc-root store profile)
  "Register PROFILE as a GC root, unless it doesn't need it."
  (unless (string=? profile %profile)
    (add-indirect-root store (canonicalize-path profile))))

(define (package-install package)
  (with-store %store
    (let* ((new (manifest-add manifest
                              (list (package->manifest-entry package))))
           (prof-drv (run-with-store %store
                       (profile-derivation new)))
           (prof     (derivation->output-path prof-drv)))
      (let* ((number (generation-number %profile))
             (name   (generation-file-name %profile
                                           (+ 1 number))))
        (and (build-derivations %store (list prof-drv))
             (let* ((entries (manifest-entries new))
                    (count   (length entries)))
               (switch-symlinks name prof)
               (switch-symlinks %profile name)))))))

(define (profile-generations*)
  (map (lambda (n)
         (cons n (reverse
                  (manifest-entries
                   (profile-manifest
                    (generation-file-name %profile n))))))
       (generation-numbers %profile)))