236 lines
8.7 KiB
EmacsLisp
236 lines
8.7 KiB
EmacsLisp
;;; guix-profiles.el --- Guix profiles
|
||
|
||
;; Copyright © 2014–2018 Alex Kost <alezost@gmail.com>
|
||
;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
|
||
|
||
;; This file is part of Emacs-Guix.
|
||
|
||
;; Emacs-Guix is free software; you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
;;
|
||
;; Emacs-Guix 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 General Public License for more details.
|
||
;;
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with Emacs-Guix. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; This file provides a general code related to location and contents of
|
||
;; Guix profiles.
|
||
|
||
;;; Code:
|
||
|
||
(require 'guix-config)
|
||
(require 'guix-utils)
|
||
|
||
(defvar guix-user-profile
|
||
(expand-file-name "~/.guix-profile")
|
||
"User profile.")
|
||
|
||
(defvar guix-system-profile
|
||
(concat guix-state-directory "/profiles/system")
|
||
"System profile.")
|
||
|
||
(defvar guix-default-profile
|
||
(concat guix-state-directory
|
||
"/profiles/per-user/"
|
||
(getenv "USER")
|
||
"/guix-profile")
|
||
"Default Guix profile.")
|
||
|
||
(defvar guix-pulled-profile
|
||
;; XXX There is `xdg-config-home' in "xdg.el" in Emacs 26.
|
||
(expand-file-name "guix/current"
|
||
(or (getenv "XDG_CONFIG_HOME")
|
||
(expand-file-name "~/.config")))
|
||
"Profile populated by 'guix pull' command.")
|
||
|
||
(defvar guix-current-profile guix-default-profile
|
||
"Current Guix profile.
|
||
It is used by various commands as the default working profile.")
|
||
|
||
(defvar guix-system-profile-regexp
|
||
(rx-to-string `(and string-start
|
||
(or ,guix-system-profile
|
||
"/run/booted-system"
|
||
"/run/current-system"))
|
||
t)
|
||
"Regexp matching system profiles.")
|
||
|
||
(defvar guix-pulled-profile-regexp
|
||
;; XXX Should profiles from other users (HOME directories) be handled?
|
||
(rx-to-string `(and ,guix-pulled-profile)
|
||
t)
|
||
"Regexp matching 'guix pull'-ed profile.")
|
||
|
||
(defvar guix-generation-file-name-regexp
|
||
(rx (group (one-or-more any))
|
||
"-" (one-or-more digit) "-link")
|
||
"Regexp matching file names of profile generations.
|
||
The first parenthesized group should match profile file name.")
|
||
|
||
(defun guix-current-profile? (profile)
|
||
"Return non-nil, if PROFILE is `guix-current-profile'."
|
||
(string= (guix-profile profile)
|
||
(guix-profile guix-current-profile)))
|
||
|
||
(defun guix-system-profile? (profile)
|
||
"Return non-nil, if PROFILE is a system one."
|
||
(string-match-p guix-system-profile-regexp profile))
|
||
|
||
(defun guix-pulled-profile? (profile)
|
||
"Return non-nil, if PROFILE is populated by 'guix pull'."
|
||
(string-match-p guix-pulled-profile-regexp profile))
|
||
|
||
(defun guix-assert-non-system-profile (profile)
|
||
"Raise an error when PROFILE is a system one."
|
||
(when (guix-system-profile? profile)
|
||
(user-error "\
|
||
Packages cannot be installed or removed to/from profile '%s'.
|
||
Use 'guix system reconfigure' shell command to modify a system profile."
|
||
profile)))
|
||
|
||
(defun guix-generation-file (profile generation)
|
||
"Return the file name of a PROFILE's GENERATION."
|
||
(format "%s-%s-link" profile generation))
|
||
|
||
(defun guix-generation-file-name->profile (file-name)
|
||
"Return profile file name by generation FILE-NAME.
|
||
Return nil if FILE-NAME does not look like a generation file name."
|
||
(when (string-match guix-generation-file-name-regexp file-name)
|
||
(match-string-no-properties 1 file-name)))
|
||
|
||
(defun guix-profile (profile)
|
||
"Return normalized file name of PROFILE.
|
||
\"Normalized\" means the returned file name is expanded, does not
|
||
have a trailing slash and it is `guix-default-profile' if PROFILE
|
||
is `guix-user-profile'. `guix-user-profile' is special because
|
||
it is actually a symlink to a real user profile, and the HOME
|
||
directory does not contain profile generations."
|
||
(let ((profile (guix-file-name profile)))
|
||
(if (string= profile guix-user-profile)
|
||
guix-default-profile
|
||
profile)))
|
||
|
||
(defun guix-generation-profile (profile &optional generation)
|
||
"Return file name of PROFILE or its GENERATION.
|
||
The returned file name is the one that have generations in the
|
||
same parent directory.
|
||
|
||
If PROFILE matches `guix-system-profile-regexp', then it is
|
||
considered to be a system profile. Unlike usual profiles, for a
|
||
system profile, packages are placed in 'profile' sub-directory,
|
||
so the returned file name does not contain this potential
|
||
trailing '/profile'."
|
||
(let* ((profile (guix-profile profile))
|
||
(profile (if (and (guix-system-profile? profile)
|
||
(string-match (rx (group (* any))
|
||
"/profile" string-end)
|
||
profile))
|
||
(match-string 1 profile)
|
||
profile)))
|
||
(if generation
|
||
(guix-generation-file profile generation)
|
||
profile)))
|
||
|
||
(defun guix-package-profile (profile &optional generation)
|
||
"Return file name of PROFILE or its GENERATION.
|
||
The returned file name is the one where packages are installed.
|
||
|
||
If PROFILE is a system one (see `guix-generation-profile'), then
|
||
the returned file name ends with '/profile'."
|
||
(let* ((profile (guix-generation-profile profile))
|
||
(profile (if generation
|
||
(guix-generation-file profile generation)
|
||
profile)))
|
||
(if (guix-system-profile? profile)
|
||
(expand-file-name "profile" profile)
|
||
profile)))
|
||
|
||
(defun guix-manifest-file (profile &optional generation)
|
||
"Return manifest file name of PROFILE or its GENERATION."
|
||
(expand-file-name "manifest"
|
||
(guix-package-profile profile generation)))
|
||
|
||
(defun guix-profile-number-of-packages (profile &optional generation)
|
||
"Return the number of packages installed in PROFILE or its GENERATION.
|
||
Return nil if packages are not found (presumably because PROFILE
|
||
is not a guix profile)."
|
||
(let ((manifest (guix-manifest-file profile generation)))
|
||
;; Just count a number of sexps inside (packages ...) of manifest
|
||
;; file. It should be much faster than running the REPL and
|
||
;; calculating manifest entries on the Scheme side.
|
||
(when (file-exists-p manifest)
|
||
(with-temp-buffer
|
||
(insert-file-contents-literally manifest)
|
||
(goto-char (point-min))
|
||
(re-search-forward "(packages" nil t)
|
||
(down-list)
|
||
(let ((num 0)
|
||
(pos (point)))
|
||
(while (setq pos (condition-case nil
|
||
(scan-sexps pos 1)
|
||
(error nil)))
|
||
(setq num (1+ num)))
|
||
num)))))
|
||
|
||
(defun guix-profile-number-of-generations (profile)
|
||
"Return the number of generations of PROFILE."
|
||
(let* ((profile (guix-generation-profile profile))
|
||
(dir-name (file-name-directory profile))
|
||
(base-name (file-name-nondirectory profile))
|
||
(regexp (concat (regexp-quote base-name)
|
||
"-[[:digit:]]+-link")))
|
||
(when (file-exists-p profile)
|
||
(length (directory-files dir-name nil regexp 'no-sort)))))
|
||
|
||
|
||
;;; Minibuffer readers
|
||
|
||
(defun guix-read-profile (&optional default)
|
||
"Prompt for profile and return it.
|
||
Use DEFAULT as a start directory. If it is nil, use
|
||
`guix-current-profile'."
|
||
(guix-read-file-name "Profile: "
|
||
(file-name-directory
|
||
(or default guix-current-profile))))
|
||
|
||
(defun guix-read-package-profile (&optional default)
|
||
"Prompt for a package profile and return it.
|
||
See `guix-read-profile' for the meaning of DEFAULT, and
|
||
`guix-package-profile' for the meaning of package profile."
|
||
(guix-package-profile (guix-read-profile default)))
|
||
|
||
(defun guix-read-generation-profile (&optional default)
|
||
"Prompt for a generation profile and return it.
|
||
See `guix-read-profile' for the meaning of DEFAULT, and
|
||
`guix-generation-profile' for the meaning of generation profile."
|
||
(guix-generation-profile (guix-read-profile default)))
|
||
|
||
(defun guix-read-manifest-file-name (&optional prompt)
|
||
"Prompt for a manifest file name and return it."
|
||
(guix-read-file-name (or prompt "File with manifest: ")))
|
||
|
||
|
||
;;;###autoload
|
||
(defun guix-set-current-profile (file-name)
|
||
"Set `guix-current-profile' to FILE-NAME.
|
||
Interactively, prompt for FILE-NAME. With prefix, use
|
||
`guix-default-profile'."
|
||
(interactive
|
||
(list (if current-prefix-arg
|
||
guix-default-profile
|
||
(guix-read-package-profile))))
|
||
(setq guix-current-profile file-name)
|
||
(message "Current profile has been set to '%s'."
|
||
guix-current-profile))
|
||
|
||
(provide 'guix-profiles)
|
||
|
||
;;; guix-profiles.el ends here
|