;;; 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 (srfi srfi-26)
  #:use-module (guix config)
  #: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 %state-directory "/profiles/"
                 (or (and=> (or (getenv "USER")
                                (getenv "LOGNAME"))
                            (cut string-append "per-user/" <>))
                     "default")
                 "/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 (install-new-profile-generation profile prof)
  "Let PROF become the new generation of PROFILE."
  (let* ((number (generation-number profile))
         (name   (generation-file-name profile (+ 1 number))))
    (switch-symlinks name prof)
    (switch-symlinks profile name)
    ;; (maybe-register-gc-root (%store) profile)
    ))

(define (package-install package)
  (with-store %store
    (let* ((new (manifest-add manifest
                              (list (package->manifest-entry package))))
           (prof-drv (run-with-store %store
                       (mbegin %store-monad
                         (set-guile-for-build (default-guile))
                         (profile-derivation new))))
           (prof   (derivation->output-path prof-drv)))
      (and (build-derivations %store (list prof-drv))
           (install-new-profile-generation %profile prof)))))

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