diff options
Diffstat (limited to 'guix/web/package.scm')
-rw-r--r-- | guix/web/package.scm | 68 |
1 files changed, 68 insertions, 0 deletions
diff --git a/guix/web/package.scm b/guix/web/package.scm new file mode 100644 index 0000000..f5a032c --- /dev/null +++ b/guix/web/package.scm @@ -0,0 +1,68 @@ +;;; 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))) |