Merge branch 'wip-guix-home'
This commit is contained in:
Oleg Pykhalov
commit
6ae4644984
|
|
@ -15,6 +15,7 @@
|
|||
# Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
|
||||
# Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
|
||||
# Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
|
||||
# Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
||||
#
|
||||
# This file is part of GNU Guix.
|
||||
#
|
||||
|
|
@ -295,6 +296,8 @@ MODULES = \
|
|||
guix/scripts/system.scm \
|
||||
guix/scripts/system/search.scm \
|
||||
guix/scripts/system/reconfigure.scm \
|
||||
guix/scripts/home.scm \
|
||||
guix/scripts/home/import.scm \
|
||||
guix/scripts/lint.scm \
|
||||
guix/scripts/challenge.scm \
|
||||
guix/scripts/import/crate.scm \
|
||||
|
|
|
|||
738
doc/guix.texi
738
doc/guix.texi
|
|
@ -96,6 +96,7 @@ Copyright @copyright{} 2021 Domagoj Stolfa@*
|
|||
Copyright @copyright{} 2021 Hui Lu@*
|
||||
Copyright @copyright{} 2021 pukkamustard@*
|
||||
Copyright @copyright{} 2021 Alice Brenon@*
|
||||
Copyright @copyright{} 2021 Andrew Tropin@*
|
||||
|
||||
Permission is granted to copy, distribute and/or modify this document
|
||||
under the terms of the GNU Free Documentation License, Version 1.3 or
|
||||
|
|
@ -167,6 +168,7 @@ Weblate} (@pxref{Translating Guix}).
|
|||
* Programming Interface:: Using Guix in Scheme.
|
||||
* Utilities:: Package management commands.
|
||||
* System Configuration:: Configuring the operating system.
|
||||
* Home Configuration:: Configuring the home environment.
|
||||
* Documentation:: Browsing software user manuals.
|
||||
* Installing Debugging Files:: Feeding the debugger.
|
||||
* Security Updates:: Deploying security fixes quickly.
|
||||
|
|
@ -328,6 +330,10 @@ System Configuration
|
|||
* Running Guix in a VM:: How to run Guix System in a virtual machine.
|
||||
* Defining Services:: Adding new service definitions.
|
||||
|
||||
Home Environment Configuration
|
||||
|
||||
* Invoking guix home:: Instantiating a home environment configuration.
|
||||
|
||||
Services
|
||||
|
||||
* Base Services:: Essential system services.
|
||||
|
|
@ -16181,9 +16187,9 @@ This is the type of the @code{mcron} service, whose value is an
|
|||
@code{mcron-configuration} object.
|
||||
|
||||
This service type can be the target of a service extension that provides
|
||||
it additional job specifications (@pxref{Service Composition}). In
|
||||
other words, it is possible to define services that provide additional
|
||||
mcron jobs to run.
|
||||
additional job specifications (@pxref{Service Composition}). In other
|
||||
words, it is possible to define services that provide additional mcron
|
||||
jobs to run.
|
||||
@end defvr
|
||||
|
||||
@deftp {Data Type} mcron-configuration
|
||||
|
|
@ -35357,6 +35363,732 @@ system:
|
|||
This service represents PID@tie{}1.
|
||||
@end defvr
|
||||
|
||||
@node Home Configuration
|
||||
@chapter Home Configuration
|
||||
@cindex home configuration
|
||||
Guix supports declarative configuration of @dfn{home environments} by
|
||||
utilizing the configuration mechanism described in the previous chapter
|
||||
(@pxref{Defining Services}), but for user's dotfiles and packages. It
|
||||
works both on Guix System and foreign distros and allows users to
|
||||
declare all the packages and services that should be installed and
|
||||
configured for the user. Once a user has written a file containing
|
||||
@code{home-environment} record, such a configuration can be
|
||||
@dfn{instantiated} by an unprivileged user with the @command{guix home}
|
||||
command (@pxref{Invoking guix home}).
|
||||
@c Maybe later, it will be possible to make home configuration a part of
|
||||
@c system configuration to make everything managed by guix system.
|
||||
|
||||
@quotation Note
|
||||
The functionality described in this section is still under development
|
||||
and is subject to change. Get in touch with us on
|
||||
@email{guix-devel@@gnu.org}!
|
||||
@end quotation
|
||||
|
||||
The user's home environment usually consists of three basic parts:
|
||||
software, configuration, and state. Software in mainstream distros are
|
||||
usually installed system-wide, but with GNU Guix most software packages
|
||||
can be installed on a per-user basis without needing root privileges,
|
||||
and are thus considered part of the user’s @dfn{home environment}.
|
||||
Packages on their own not very useful in many cases, because often they
|
||||
require some additional configuration, usually config files that reside
|
||||
in @env{XDG_CONFIG_HOME} (@file{~/.config} by default) or other
|
||||
directories. Everything else can be considered state, like media files,
|
||||
application databases, and logs.
|
||||
|
||||
Using Guix for managing home environments provides a number of
|
||||
advantages:
|
||||
|
||||
@itemize
|
||||
|
||||
@item All software can be configured in one language (Guile Scheme),
|
||||
this gives users the ability to share values between configurations of
|
||||
different programs.
|
||||
|
||||
@item A well-defined home environment is self-contained and can be
|
||||
created in a declarative and reproducible way---there is no need to grab
|
||||
external binaries or manually edit some configuration file.
|
||||
|
||||
@item After every @command{guix home reconfigure} invocation, a new home
|
||||
environment generation will be created. This means that users can
|
||||
rollback to a previous home environment generation so they don’t have to
|
||||
worry about breaking their configuration.
|
||||
|
||||
@item It is possible to manage stateful data with Guix Home, this
|
||||
includes the ability to automatically clone Git repositories on the
|
||||
initial setup of the machine, and periodically running commands like
|
||||
@command{rsync} to sync data with another host. This functionality is
|
||||
still in an experimental stage, though.
|
||||
|
||||
@end itemize
|
||||
|
||||
@menu
|
||||
* Declaring the Home Environment:: Customizing your Home.
|
||||
* Configuring the Shell:: Enabling home environment.
|
||||
* Home Services:: Specifying home services.
|
||||
* Invoking guix home:: Instantiating a home configuration.
|
||||
@end menu
|
||||
|
||||
@node Declaring the Home Environment
|
||||
@section Declaring the Home Environment
|
||||
The home environment is configured by providing a
|
||||
@code{home-environment} declaration in a file that can be passed to the
|
||||
@command{guix home} command (@pxref{Invoking guix home}). A simple
|
||||
setup can include Bash and a custom text configuration, like in the
|
||||
example below. Don't be afraid to declare home environment parts, which
|
||||
overlaps with your current dotfiles, before installing any configuration
|
||||
files, Guix Home will back up existing config files to a separate place
|
||||
in the home folder.
|
||||
|
||||
@quotation Note
|
||||
It is highly recommended that you manage your shell or shells with Guix
|
||||
Home, because it will make sure that all the necessary scripts are
|
||||
sourced by the shell configuration file. Otherwise you will need to do
|
||||
it manually. (@pxref{Configuring the Shell}).
|
||||
@end quotation
|
||||
|
||||
@findex home-environment
|
||||
@lisp
|
||||
@include he-config-bare-bones.scm
|
||||
@end lisp
|
||||
|
||||
The @code{packages} field should be self-explanatory, it will install
|
||||
the list of packages into the user's profile. The most important field
|
||||
is @code{services}, it contains a list of @dfn{home services}, which are
|
||||
the basic building blocks of a home environment.
|
||||
|
||||
There is no daemon (at least not necessarily) related to a home service,
|
||||
a home service is just an element that is used to declare part of home
|
||||
environment and extend other parts of it. The extension mechanism
|
||||
discussed in the previous chapter (@pxref{Defining Services}) should not
|
||||
be confused with @ref{Shepherd Services}. Using this extension
|
||||
mechanism and some Scheme code that glues things together gives the user
|
||||
the freedom to declare their own, very custom, home environments.
|
||||
|
||||
@node Configuring the Shell
|
||||
@section Configuring the Shell
|
||||
This section is safe to skip if your shell or shells are managed by
|
||||
Guix Home. Otherwise, read it carefully.
|
||||
|
||||
There are a few scripts that must be evaluated by a login shell to
|
||||
activate the home environment. The shell startup files only read by
|
||||
login shells often have @code{profile} suffix. For more information
|
||||
about login shells see @ref{Invoking Bash,,, bash, The GNU Bash
|
||||
Reference Manual} and see @ref{Bash Startup Files,,, bash, The GNU Bash
|
||||
Reference Manual}.
|
||||
|
||||
The first script that needs to be sourced is @file{setup-environment},
|
||||
which sets all the necessary environment variables (including variables
|
||||
declared by the user) and the second one is @file{on-first-login}, which
|
||||
starts Shepherd for the current user and performs actions declared by
|
||||
other home services that extends
|
||||
@code{home-run-on-first-login-service-type}.
|
||||
|
||||
Guix Home will always create @file{~/.profile}, which contains the
|
||||
following lines:
|
||||
|
||||
@example
|
||||
HOME_ENVIRONMENT=$HOME/.guix-home
|
||||
. $HOME_ENVIRONMENT/setup-environment
|
||||
$HOME_ENVIRONMENT/on-first-login
|
||||
@end example
|
||||
|
||||
This makes POSIX compliant login shells activate the home environment.
|
||||
However, in most cases this file won't be read by most modern shells,
|
||||
because they are run in non POSIX mode by default and have their own
|
||||
@file{*profile} startup files. For example Bash will prefer
|
||||
@file{~/.bash_profile} in case it exists and only if it doesn't will it
|
||||
fallback to @file{~/.profile}. Zsh (if no additional options are
|
||||
specified) will ignore @file{~/.profile}, even if @file{~/.zprofile}
|
||||
doesn't exist.
|
||||
|
||||
To make your shell respect @file{~/.profile}, add @code{. ~/.profile} or
|
||||
@code{source ~/profile} to the startup file for the login shell. In
|
||||
case of Bash, it is @file{~/.bash_profile}, and in case of Zsh, it is
|
||||
@file{~/.zprofile}.
|
||||
|
||||
@quotation Note
|
||||
This step is only required if your shell is NOT managed by Guix Home.
|
||||
Otherwise, everything will be done automatically.
|
||||
@end quotation
|
||||
|
||||
@node Home Services
|
||||
@section Home Services
|
||||
@cindex home services
|
||||
|
||||
A @dfn{home service} is not necessarily something that has a daemon and
|
||||
is managed by Shepherd (@pxref{Jump Start,,, shepherd, The GNU Shepherd
|
||||
Manual}), in most cases it doesn't. It's a simple building block of the
|
||||
home environment, often declaring a set of packages to be installed in
|
||||
the home environment profile, a set of config files to be symlinked into
|
||||
@env{XDG_CONFIG_HOME} (@file{~/.config} by default), and environment
|
||||
variables to be set by a login shell.
|
||||
|
||||
There is a service extension mechanism (@pxref{Service Composition})
|
||||
which allows home services to extend other home services and utilize
|
||||
capabilities they provide; for example: declare mcron jobs
|
||||
(@pxref{Top,,, mcron, GNU@tie{}Mcron}) by extending @ref{Mcron Home
|
||||
Service}; declare daemons by extending @ref{Shepherd Home Service}; add
|
||||
commands, which will be invoked on by the Bash by extending
|
||||
@ref{Shells Home Services, @code{home-bash-service-type}}.
|
||||
|
||||
A good way to discover avaliable home services is using the
|
||||
@command{guix home search} command (@pxref{Invoking guix home}). After
|
||||
the required home services are found, include its module with the
|
||||
@code{use-modules} form (@pxref{use-modules,, Using Guile Modules,
|
||||
guile, The GNU Guile Reference Manual}), or the @code{#:use-modules}
|
||||
directive (@pxref{define-module,, Creating Guile Modules, guile, The GNU
|
||||
Guile Reference Manual}) and declare a home service using the
|
||||
@code{service} function, or extend a service type by declaring a new
|
||||
service with the @code{simple-service} procedure from @code{(gnu
|
||||
services)}.
|
||||
|
||||
@menu
|
||||
* Essential Home Services:: Environment variables, packages, on-* scripts.
|
||||
* Shells: Shells Home Services. POSIX shells, Bash, Zsh.
|
||||
* Mcron: Mcron Home Service. Scheduled User's Job Execution.
|
||||
* Shepherd: Shepherd Home Service. Managing User's Daemons.
|
||||
@end menu
|
||||
@c In addition to that Home Services can provide
|
||||
|
||||
@node Essential Home Services
|
||||
@subsection Essential Home Services
|
||||
There are a few essential services defined in @code{(gnu
|
||||
home-services)}, they are mostly for internal use and are required to
|
||||
build a home environment, but some of them will be useful for the end
|
||||
user.
|
||||
|
||||
@cindex environment variables
|
||||
|
||||
@defvr {Scheme Variable} home-environment-variables-service-type
|
||||
The service of this type will be instantiated by every home environment
|
||||
automatically by default, there is no need to define it, but someone may
|
||||
want to extend it with a list of pairs to set some environment
|
||||
variables.
|
||||
|
||||
@lisp
|
||||
(list ("ENV_VAR1" . "value1")
|
||||
("ENV_VAR2" . "value2"))
|
||||
@end lisp
|
||||
|
||||
The easiest way to extend a service type, without defining new service
|
||||
type is to use the @code{simple-service} helper from @code{(gnu
|
||||
services)}.
|
||||
|
||||
@lisp
|
||||
(simple-service 'some-useful-env-vars-service
|
||||
home-environment-variables-service-type
|
||||
`(("LESSHISTFILE" . "$XDG_CACHE_HOME/.lesshst")
|
||||
("SHELL" . ,(file-append zsh "/bin/zsh"))
|
||||
("USELESS_VAR" . #f)
|
||||
("_JAVA_AWT_WM_NONREPARENTING" . #t)))
|
||||
@end lisp
|
||||
|
||||
If you include such a service in you home environment definition, it
|
||||
will add the following content to the @file{setup-environment} script
|
||||
(which is expected to be sourced by the login shell):
|
||||
|
||||
@example
|
||||
export LESSHISTFILE=$XDG_CACHE_HOME/.lesshst
|
||||
export SHELL=/gnu/store/2hsg15n644f0glrcbkb1kqknmmqdar03-zsh-5.8/bin/zsh
|
||||
export _JAVA_AWT_WM_NONREPARENTING
|
||||
@end example
|
||||
|
||||
@quotation Note
|
||||
Make sure that module @code{(gnu packages shells)} is imported with
|
||||
@code{use-modules} or any other way, this namespace contains the
|
||||
definition of the @code{zsh} packages, which is used in the example
|
||||
above.
|
||||
@end quotation
|
||||
|
||||
The association list (@pxref{Association Lists, alists, Association
|
||||
Lists, guile, The GNU Guile Reference manual}) is a data structure
|
||||
containing key-value pairs, for
|
||||
@code{home-environment-variables-service-type} the key is always a
|
||||
string, the value can be a string, string-valued gexp
|
||||
(@pxref{G-Expressions}), file-like object (@pxref{G-Expressions,
|
||||
file-like object}) or boolean. For gexps, the variable will be set to
|
||||
the value of the gexp; for file-like objects, it will be set to the path
|
||||
of the file in the store (@pxref{The Store}); for @code{#t}, it will
|
||||
export the variable without any value; and for @code{#f}, it will omit
|
||||
variable.
|
||||
|
||||
@end defvr
|
||||
|
||||
@defvr {Scheme Variable} home-profile-service-type
|
||||
The service of this type will be instantiated by every home environment
|
||||
automatically, there is no need to define it, but you may want to extend
|
||||
it with a list of packages if you want to install additional packages
|
||||
into your profile. Other services, which need to make some programs
|
||||
avaliable to the user will also extend this service type.
|
||||
|
||||
The extension value is just a list of packages:
|
||||
|
||||
@lisp
|
||||
(list htop vim emacs)
|
||||
@end lisp
|
||||
|
||||
The same approach as @code{simple-service} (@pxref{Service Reference,
|
||||
simple-service}) for @code{home-environment-variables-service-type} can
|
||||
be used here, too. Make sure that modules containing the specified
|
||||
packages are imported with @code{use-modules}. To find a package or
|
||||
information about its module use @command{guix search} (@pxref{Invoking
|
||||
guix package}). Alternatively, @code{specification->package} can be
|
||||
used to get the package record from string without importing related
|
||||
module.
|
||||
@end defvr
|
||||
|
||||
There are few more essential services, but users are not expected to
|
||||
extend them.
|
||||
|
||||
@defvr {Scheme Variable} home-service-type
|
||||
The root of home services DAG, it generates a folder, which later will be
|
||||
symlinked to @file{~/.guix-home}, it contains configurations,
|
||||
profile with binaries and libraries, and some necessary scripts to glue
|
||||
things together.
|
||||
@end defvr
|
||||
|
||||
@defvr {Scheme Variable} home-run-on-first-login-service-type
|
||||
The service of this type generates a Guile script, which is expected to
|
||||
be executed by the login shell. It is only executed if the special flag
|
||||
file inside @env{XDG_RUNTIME_DIR} hasn't been created, this prevents
|
||||
redundant executions of the script if multiple login shells are spawned.
|
||||
|
||||
It can be extended with a gexp. However, to autostart an application,
|
||||
users @emph{should not} use this service, in most cases it's better to extend
|
||||
@code{home-shpeherd-service-type} with a Shepherd service
|
||||
(@pxref{Shepherd Services}), or extend the shell's startup file with
|
||||
required command using the appropriate service type.
|
||||
@end defvr
|
||||
|
||||
@defvr {Scheme Variable} home-activation-service-type
|
||||
The service of this type generates a guile script, which runs on every
|
||||
@command{guix home reconfigure} invocation or any other action, which
|
||||
leads to the activation of the home environment.
|
||||
@end defvr
|
||||
|
||||
@node Shells Home Services
|
||||
@subsection Shells
|
||||
|
||||
@cindex shell
|
||||
@cindex login shell
|
||||
@cindex interactive shell
|
||||
@cindex bash
|
||||
@cindex zsh
|
||||
|
||||
Shells play a quite important role in the environment initialization
|
||||
process, you can configure them manually as described in section
|
||||
@ref{Configuring the Shell}, but the recommended way is to use home services
|
||||
listed below. It's both easier and more reliable.
|
||||
|
||||
Each home environment instantiates
|
||||
@code{home-shell-profile-service-type}, which creates a
|
||||
@file{~/.profile} startup file for all POSIX-compatible shells. This
|
||||
file contains all the necessary steps to properly initialize the
|
||||
environment, but many modern shells like Bash or Zsh prefer their own
|
||||
startup files, that's why the respective home services
|
||||
(@code{home-bash-service-type} and @code{home-zsh-service-type}) ensure
|
||||
that @file{~/.profile} is sourced by @file{~/.bash_profile} and
|
||||
@file{~/.zprofile}, respectively.
|
||||
|
||||
@subsubheading Shell Profile Service
|
||||
|
||||
@deftp {Data Type} home-shell-profile-configuration
|
||||
Available @code{home-shell-profile-configuration} fields are:
|
||||
|
||||
@table @asis
|
||||
@item @code{profile} (default: @code{()}) (type: text-config)
|
||||
@code{home-shell-profile} is instantiated automatically by
|
||||
@code{home-environment}, DO NOT create this service manually, it can
|
||||
only be extended. @code{profile} is a list of strings or gexps, which
|
||||
will go to @file{~/.profile}. By default @file{~/.profile} contains the
|
||||
initialization code, which have to be evaluated by login shell to make
|
||||
home-environment's profile avaliable to the user, but other commands can
|
||||
be added to the file if it is really necessary. In most cases shell's
|
||||
configuration files are preferred places for user's customizations.
|
||||
Extend home-shell-profile service only if you really know what you do.
|
||||
|
||||
@end table
|
||||
|
||||
@end deftp
|
||||
|
||||
@subsubheading Bash Home Service
|
||||
|
||||
@deftp {Data Type} home-bash-configuration
|
||||
Available @code{home-bash-configuration} fields are:
|
||||
|
||||
@table @asis
|
||||
@item @code{package} (default: @code{bash}) (type: package)
|
||||
The Bash package to use.
|
||||
|
||||
@item @code{guix-defaults?} (default: @code{#t}) (type: boolean)
|
||||
Add sane defaults like reading @file{/etc/bashrc}, coloring output for
|
||||
@code{ls} provided by guix to @file{.bashrc}.
|
||||
|
||||
@item @code{environment-variables} (default: @code{()}) (type: alist)
|
||||
Association list of environment variables to set for the Bash session.
|
||||
|
||||
@item @code{bash-profile} (default: @code{()}) (type: text-config)
|
||||
List of strings or gexps, which will be added to @file{.bash_profile}.
|
||||
Used for executing user's commands at start of login shell (In most
|
||||
cases the shell started on tty just after login). @file{.bash_login}
|
||||
won't be ever read, because @file{.bash_profile} always present.
|
||||
|
||||
@item @code{bashrc} (default: @code{()}) (type: text-config)
|
||||
List of strings or gexps, which will be added to @file{.bashrc}. Used
|
||||
for executing user's commands at start of interactive shell (The shell
|
||||
for interactive usage started by typing @code{bash} or by terminal app
|
||||
or any other program).
|
||||
|
||||
@item @code{bash-logout} (default: @code{()}) (type: text-config)
|
||||
List of strings or gexps, which will be added to @file{.bash_logout}.
|
||||
Used for executing user's commands at the exit of login shell. It won't
|
||||
be read in some cases (if the shell terminates by exec'ing another
|
||||
process for example).
|
||||
|
||||
@end table
|
||||
|
||||
@end deftp
|
||||
|
||||
@subsubheading Zsh Home Service
|
||||
|
||||
@deftp {Data Type} home-zsh-configuration
|
||||
Available @code{home-zsh-configuration} fields are:
|
||||
|
||||
@table @asis
|
||||
@item @code{package} (default: @code{zsh}) (type: package)
|
||||
The Zsh package to use.
|
||||
|
||||
@item @code{xdg-flavor?} (default: @code{#t}) (type: boolean)
|
||||
Place all the configs to @file{$XDG_CONFIG_HOME/zsh}. Makes
|
||||
@file{~/.zshenv} to set @env{ZDOTDIR} to @file{$XDG_CONFIG_HOME/zsh}.
|
||||
Shell startup process will continue with
|
||||
@file{$XDG_CONFIG_HOME/zsh/.zshenv}.
|
||||
|
||||
@item @code{environment-variables} (default: @code{()}) (type: alist)
|
||||
Association list of environment variables to set for the Zsh session.
|
||||
|
||||
@item @code{zshenv} (default: @code{()}) (type: text-config)
|
||||
List of strings or gexps, which will be added to @file{.zshenv}. Used
|
||||
for setting user's shell environment variables. Must not contain
|
||||
commands assuming the presence of tty or producing output. Will be read
|
||||
always. Will be read before any other file in @env{ZDOTDIR}.
|
||||
|
||||
@item @code{zprofile} (default: @code{()}) (type: text-config)
|
||||
List of strings or gexps, which will be added to @file{.zprofile}. Used
|
||||
for executing user's commands at start of login shell (In most cases the
|
||||
shell started on tty just after login). Will be read before
|
||||
@file{.zlogin}.
|
||||
|
||||
@item @code{zshrc} (default: @code{()}) (type: text-config)
|
||||
List of strings or gexps, which will be added to @file{.zshrc}. Used
|
||||
for executing user's commands at start of interactive shell (The shell
|
||||
for interactive usage started by typing @code{zsh} or by terminal app or
|
||||
any other program).
|
||||
|
||||
@item @code{zlogin} (default: @code{()}) (type: text-config)
|
||||
List of strings or gexps, which will be added to @file{.zlogin}. Used
|
||||
for executing user's commands at the end of starting process of login
|
||||
shell.
|
||||
|
||||
@item @code{zlogout} (default: @code{()}) (type: text-config)
|
||||
List of strings or gexps, which will be added to @file{.zlogout}. Used
|
||||
for executing user's commands at the exit of login shell. It won't be
|
||||
read in some cases (if the shell terminates by exec'ing another process
|
||||
for example).
|
||||
|
||||
@end table
|
||||
|
||||
@end deftp
|
||||
|
||||
@node Mcron Home Service
|
||||
@subsection Scheduled User's Job Execution
|
||||
|
||||
@cindex cron
|
||||
@cindex mcron
|
||||
@cindex scheduling jobs
|
||||
|
||||
The @code{(gnu home-services mcron)} module provides an interface to
|
||||
GNU@tie{}mcron, a daemon to run jobs at scheduled times (@pxref{Top,,,
|
||||
mcron, GNU@tie{}mcron}). The information about system's mcron is
|
||||
applicable here (@pxref{Scheduled Job Execution}), the only difference
|
||||
for home services is that they have to be declared in a
|
||||
@code{home-envirnoment} record instead of an @code{operating-system}
|
||||
record.
|
||||
|
||||
@defvr {Scheme Variable} home-mcron-service-type
|
||||
This is the type of the @code{mcron} home service, whose value is an
|
||||
@code{home-mcron-configuration} object. It allows to manage scheduled
|
||||
tasks.
|
||||
|
||||
This service type can be the target of a service extension that provides
|
||||
additional job specifications (@pxref{Service Composition}). In other
|
||||
words, it is possible to define services that provide additional mcron
|
||||
jobs to run.
|
||||
@end defvr
|
||||
|
||||
@deftp {Data Type} home-mcron-configuration
|
||||
Data type representing the configuration of mcron.
|
||||
|
||||
@table @asis
|
||||
@item @code{mcron} (default: @var{mcron})
|
||||
The mcron package to use.
|
||||
|
||||
@item @code{jobs}
|
||||
This is a list of gexps (@pxref{G-Expressions}), where each gexp
|
||||
corresponds to an mcron job specification (@pxref{Syntax, mcron job
|
||||
specifications,, mcron, GNU@tie{}mcron}).
|
||||
@end table
|
||||
@end deftp
|
||||
|
||||
@node Shepherd Home Service
|
||||
@subsection Managing User's Daemons
|
||||
|
||||
@cindex shepherd services
|
||||
|
||||
@defvr {Scheme Variable} home-shepherd-service-type
|
||||
The service type for the userland Shepherd, which allows one to manage
|
||||
long-running processes or one-shot tasks. User's Shepherd is not an
|
||||
init process (PID 1), but almost all other information described in
|
||||
(@pxref{Shepherd Services}) is applicable here too.
|
||||
|
||||
This is the service type that extensions target when they want to create
|
||||
shepherd services (@pxref{Service Types and Services}, for an example).
|
||||
Each extension must pass a list of @code{<shepherd-service>}. Its
|
||||
value must be a @code{shepherd-configuration}, as described below.
|
||||
@end defvr
|
||||
|
||||
@deftp {Data Type} shepherd-configuration
|
||||
This data type represents the Shepherd's configuration.
|
||||
|
||||
@table @code
|
||||
@item shepherd (default: @code{shepherd})
|
||||
The Shepherd package to use.
|
||||
|
||||
@item auto-start? (default: @code{#t})
|
||||
Whether or not to start Shepherd on first login.
|
||||
|
||||
@item services (default: @code{'()})
|
||||
A list of @code{<shepherd-service>} to start.
|
||||
You should probably use the service extension
|
||||
mechanism instead (@pxref{Shepherd Services}).
|
||||
@end table
|
||||
@end deftp
|
||||
|
||||
@node Invoking guix home
|
||||
@section Invoking @code{guix home}
|
||||
|
||||
Once you have written a home environment declaration (@pxref{Declaring
|
||||
the Home Environment,,,,}, it can be @dfn{instantiated} using the
|
||||
@command{guix home} command. The synopsis is:
|
||||
|
||||
@example
|
||||
guix home @var{options}@dots{} @var{action} @var{file}
|
||||
@end example
|
||||
|
||||
@var{file} must be the name of a file containing a
|
||||
@code{home-environment} declaration. @var{action} specifies how the
|
||||
home environment is instantiated, but there are few auxuliary actions
|
||||
which don't instantiate it. Currently the following values are
|
||||
supported:
|
||||
|
||||
@table @code
|
||||
@item search
|
||||
Display available home service type definitions that match the given
|
||||
regular expressions, sorted by relevance:
|
||||
|
||||
@cindex shell
|
||||
@cindex shell-profile
|
||||
@cindex bash
|
||||
@cindex zsh
|
||||
@example
|
||||
$ guix home search shell
|
||||
name: home-shell-profile
|
||||
location: gnu/home-services/shells.scm:73:2
|
||||
extends: home-files
|
||||
description: Create `~/.profile', which is used for environment initialization
|
||||
+ of POSIX compatible login shells. Can be extended with a list of strings or
|
||||
+ gexps.
|
||||
relevance: 6
|
||||
|
||||
name: home-zsh-plugin-manager
|
||||
location: gnu/home-services/shellutils.scm:28:2
|
||||
extends: home-zsh home-profile
|
||||
description: Install plugins in profile and configure Zsh to load them.
|
||||
relevance: 1
|
||||
|
||||
name: home-zsh-direnv
|
||||
location: gnu/home-services/shellutils.scm:69:2
|
||||
extends: home-profile home-zsh
|
||||
description: Enables `direnv' for `zsh'. Adds hook to `.zshrc' and installs a
|
||||
+ package in the profile.
|
||||
relevance: 1
|
||||
|
||||
name: home-zsh-autosuggestions
|
||||
location: gnu/home-services/shellutils.scm:43:2
|
||||
extends: home-zsh-plugin-manager home-zsh
|
||||
description: Enables Fish-like fast/unobtrusive autosuggestions for `zsh' and
|
||||
+ sets reasonable default values for some plugin's variables to improve perfomance
|
||||
+ and adjust behavior: `(history completion)' is set for strategy, manual rebind
|
||||
+ and async are enabled.
|
||||
relevance: 1
|
||||
|
||||
name: home-zsh
|
||||
location: gnu/home-services/shells.scm:236:2
|
||||
extends: home-files home-profile
|
||||
description: Install and configure Zsh.
|
||||
relevance: 1
|
||||
|
||||
name: home-bash
|
||||
location: gnu/home-services/shells.scm:388:2
|
||||
extends: home-files home-profile
|
||||
description: Install and configure Bash.
|
||||
relevance: 1
|
||||
|
||||
@dots{}
|
||||
@end example
|
||||
|
||||
As for @command{guix package --search}, the result is written in
|
||||
@code{recutils} format, which makes it easy to filter the output
|
||||
(@pxref{Top, GNU recutils databases,, recutils, GNU recutils manual}).
|
||||
|
||||
@item reconfigure
|
||||
Build the home environment described in @var{file}, and switch to it.
|
||||
Switching means that the activation script will be evaluated and (in
|
||||
basic scenario) symlinks to configuration files generated from
|
||||
@code{home-environment} declaration will be created in @file{~}. If the
|
||||
file with the same path already exists in home folder it will be moved
|
||||
to @file{~/TIMESTAMP-guix-home-legacy-configs-backup}, where TIMESTAMP
|
||||
is a current UNIX epoch time.
|
||||
|
||||
@quotation Note
|
||||
It is highly recommended to run @command{guix pull} once before you run
|
||||
@command{guix home reconfigure} for the first time (@pxref{Invoking guix
|
||||
pull}).
|
||||
@end quotation
|
||||
|
||||
This effects all the configuration specified in @var{file}. The command
|
||||
starts Shepherd services specified in @var{file} that are not currently
|
||||
running; if a service is currently running, this command will arrange
|
||||
for it to be upgraded the next time it is stopped (e.g.@: by @code{herd
|
||||
stop X} or @code{herd restart X}).
|
||||
|
||||
This command creates a new generation whose number is one greater than
|
||||
the current generation (as reported by @command{guix home
|
||||
list-generations}). If that generation already exists, it will be
|
||||
overwritten. This behavior mirrors that of @command{guix package}
|
||||
(@pxref{Invoking guix package}).
|
||||
|
||||
@cindex provenance tracking, of the home environment
|
||||
Upon completion, the new home is deployed under @file{~/.guix-home}.
|
||||
This directory contains @dfn{provenance meta-data}: the list of channels
|
||||
in use (@pxref{Channels}) and @var{file} itself, when available. You
|
||||
can view the provenance information by running:
|
||||
|
||||
@example
|
||||
guix home describe
|
||||
@end example
|
||||
|
||||
This information is useful should you later want to inspect how this
|
||||
particular generation was built. In fact, assuming @var{file} is
|
||||
self-contained, you can later rebuild generation @var{n} of your
|
||||
home environment with:
|
||||
|
||||
@example
|
||||
guix time-machine \
|
||||
-C /var/guix/profiles/per-user/@var{USER}/guix-home-@var{n}-link/channels.scm -- \
|
||||
home reconfigure \
|
||||
/var/guix/profiles/per-user/@var{USER}/guix-home-@var{n}-link/configuration.scm
|
||||
|
||||
@end example
|
||||
|
||||
You can think of it as some sort of built-in version control! Your
|
||||
home is not just a binary artifact: @emph{it carries its own source}.
|
||||
@c @xref{Service Reference, @code{provenance-service-type}}, for more
|
||||
@c information on provenance tracking.
|
||||
|
||||
@c @footnote{This action (and the related actions
|
||||
@c @code{switch-generation} and @code{roll-back}) are usable after the
|
||||
@c home environment is initialized.}.
|
||||
|
||||
@item switch-generation
|
||||
@cindex home generations
|
||||
Switch to an existing home generation. This action atomically switches
|
||||
the home profile to the specified home generation.
|
||||
|
||||
The target generation can be specified explicitly by its generation
|
||||
number. For example, the following invocation would switch to home
|
||||
generation 7:
|
||||
|
||||
@example
|
||||
guix home switch-generation 7
|
||||
@end example
|
||||
|
||||
The target generation can also be specified relative to the current
|
||||
generation with the form @code{+N} or @code{-N}, where @code{+3} means
|
||||
``3 generations ahead of the current generation,'' and @code{-1} means
|
||||
``1 generation prior to the current generation.'' When specifying a
|
||||
negative value such as @code{-1}, you must precede it with @code{--} to
|
||||
prevent it from being parsed as an option. For example:
|
||||
|
||||
@example
|
||||
guix home switch-generation -- -1
|
||||
@end example
|
||||
|
||||
This action will fail if the specified generation does not exist.
|
||||
|
||||
@item roll-back
|
||||
@cindex rolling back
|
||||
Switch to the preceding home generation. This is the inverse
|
||||
of @command{reconfigure}, and it is exactly the same as invoking
|
||||
@command{switch-generation} with an argument of @code{-1}.
|
||||
|
||||
@item delete-generations
|
||||
@cindex deleting home generations
|
||||
@cindex saving space
|
||||
Delete home generations, making them candidates for garbage collection
|
||||
(@pxref{Invoking guix gc}, for information on how to run the ``garbage
|
||||
collector'').
|
||||
|
||||
This works in the same way as @samp{guix package --delete-generations}
|
||||
(@pxref{Invoking guix package, @option{--delete-generations}}). With no
|
||||
arguments, all home generations but the current one are deleted:
|
||||
|
||||
@example
|
||||
guix home delete-generations
|
||||
@end example
|
||||
|
||||
You can also select the generations you want to delete. The example below
|
||||
deletes all the home generations that are more than two month old:
|
||||
|
||||
@example
|
||||
guix home delete-generations 2m
|
||||
@end example
|
||||
|
||||
@item build
|
||||
Build the derivation of the home environment, which includes all the
|
||||
configuration files and programs needed. This action does not actually
|
||||
install anything.
|
||||
|
||||
@item describe
|
||||
Describe the current home generation: its file name, as well as
|
||||
provenance information when available.
|
||||
|
||||
@item list-generations
|
||||
List a summary of each generation of the home environment available on
|
||||
disk, in a human-readable way. This is similar to the
|
||||
@option{--list-generations} option of @command{guix package}
|
||||
(@pxref{Invoking guix package}).
|
||||
|
||||
Optionally, one can specify a pattern, with the same syntax that is used
|
||||
in @command{guix package --list-generations}, to restrict the list of
|
||||
generations displayed. For instance, the following command displays
|
||||
generations that are up to 10 days old:
|
||||
|
||||
@example
|
||||
$ guix home list-generations 10d
|
||||
@end example
|
||||
|
||||
@end table
|
||||
|
||||
@node Documentation
|
||||
@chapter Documentation
|
||||
|
|
|
|||
|
|
@ -0,0 +1,24 @@
|
|||
(use-modules (gnu home)
|
||||
(gnu home-services)
|
||||
(gnu home-services shells)
|
||||
(gnu services)
|
||||
(gnu packages admin)
|
||||
(guix gexp))
|
||||
|
||||
|
||||
(home-environment
|
||||
(packages (list htop))
|
||||
(services
|
||||
(list
|
||||
(service home-bash-service-type
|
||||
(home-bash-configuration
|
||||
(guix-defaults? #t)
|
||||
(bash-profile '("\
|
||||
export HISTFILE=$XDG_CACHE_HOME/.bash_history"))))
|
||||
|
||||
(simple-service 'test-config
|
||||
home-files-service-type
|
||||
(list `("config/test.conf"
|
||||
,(plain-file "tmp-file.txt"
|
||||
"the content of ~/.config/test.conf")))))))
|
||||
|
||||
30
etc/news.scm
30
etc/news.scm
|
|
@ -15,6 +15,7 @@
|
|||
;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
|
||||
;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
|
||||
;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||
;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
||||
;;
|
||||
;; Copying and distribution of this file, with or without modification, are
|
||||
;; permitted in any medium without royalty provided the copyright notice and
|
||||
|
|
@ -22,6 +23,35 @@
|
|||
|
||||
(channel-news
|
||||
(version 0)
|
||||
(entry (commit "a2324d8b56eabf8117bca220a507cc791edffd2e")
|
||||
(title
|
||||
(en "Guix Home is a part of GNU Guix")
|
||||
(ru "Guix Home теперь поставляется в составе GNU Guix"))
|
||||
(body
|
||||
(en "Guix Home splitted out from rde project and now is a part of
|
||||
Guix proper. The new @command{guix home} with its actions allows users to
|
||||
manage their packages and configurations (aka. dotfiles) in a declarative way,
|
||||
similar to how many people manage their system with @command{guix system}.
|
||||
|
||||
Take a look at available actions and arguments:
|
||||
@example
|
||||
guix home --help
|
||||
@end example
|
||||
|
||||
See @command{info \"(guix) Home Configuration\"} for more information.")
|
||||
(ru "Guix Home отделился от проекта rde и теперь является частью
|
||||
Guix. Новая команда @command{guix home} даёт возможность пользователям
|
||||
управлять их пакетами и конфигурациями (дотфайлами) для них в декларативном
|
||||
стиле, аналогично тому, как многие люди управляют своими системами с помощью
|
||||
@command{guix system}.
|
||||
|
||||
Чтобы получить список доступных действий и аргументов:
|
||||
@example
|
||||
guix home --help
|
||||
@end example
|
||||
|
||||
Смотрите @command{info \"(guix) Home Configuration\"} для получения более
|
||||
детальных сведений.")))
|
||||
|
||||
(entry (commit "5b32ad4f6f555d305659cee825879df075b06331")
|
||||
(title
|
||||
|
|
|
|||
|
|
@ -0,0 +1,524 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
||||
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU 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.
|
||||
;;;
|
||||
;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu home-services)
|
||||
#:use-module (gnu services)
|
||||
#:use-module (guix channels)
|
||||
#:use-module (guix monads)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix profiles)
|
||||
#:use-module (guix sets)
|
||||
#:use-module (guix ui)
|
||||
#:use-module (guix discovery)
|
||||
#:use-module (guix diagnostics)
|
||||
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (ice-9 match)
|
||||
|
||||
#:export (home-service-type
|
||||
home-profile-service-type
|
||||
home-environment-variables-service-type
|
||||
home-files-service-type
|
||||
home-run-on-first-login-service-type
|
||||
home-activation-service-type
|
||||
home-run-on-change-service-type
|
||||
home-provenance-service-type
|
||||
|
||||
fold-home-service-types)
|
||||
|
||||
#:re-export (service
|
||||
service-type
|
||||
service-extension))
|
||||
|
||||
;;; Comment:
|
||||
;;;
|
||||
;;; This module is similar to (gnu system services) module, but
|
||||
;;; provides Home Services, which are supposed to be used for building
|
||||
;;; home-environment.
|
||||
;;;
|
||||
;;; Home Services use the same extension as System Services. Consult
|
||||
;;; (gnu system services) module or manual for more information.
|
||||
;;;
|
||||
;;; home-service-type is a root of home services DAG.
|
||||
;;;
|
||||
;;; home-profile-service-type is almost the same as profile-service-type, at least
|
||||
;;; for now.
|
||||
;;;
|
||||
;;; home-environment-variables-service-type generates a @file{setup-environment}
|
||||
;;; shell script, which is expected to be sourced by login shell or other program,
|
||||
;;; which starts early and spawns all other processes. Home services for shells
|
||||
;;; automatically add code for sourcing this file, if person do not use those home
|
||||
;;; services they have to source this script manually in their's shell *profile
|
||||
;;; file (details described in the manual).
|
||||
;;;
|
||||
;;; home-files-service-type is similar to etc-service-type, but doesn't extend
|
||||
;;; home-activation, because deploy mechanism for config files is pluggable and
|
||||
;;; can be different for different home environments: The default one is called
|
||||
;;; symlink-manager (will be introudced in a separate patch series), which creates
|
||||
;;; links for various dotfiles (like $XDG_CONFIG_HOME/$APP/...) to store, but is
|
||||
;;; possible to implement alternative approaches like read-only home from Julien's
|
||||
;;; guix-home-manager.
|
||||
;;;
|
||||
;;; home-run-on-first-login-service-type provides an @file{on-first-login} guile
|
||||
;;; script, which runs provided gexps once, when user makes first login. It can
|
||||
;;; be used to start user's Shepherd and maybe some other process. It relies on
|
||||
;;; assumption that /run/user/$UID will be created on login by some login
|
||||
;;; manager (elogind for example).
|
||||
;;;
|
||||
;;; home-activation-service-type provides an @file{activate} guile script, which
|
||||
;;; do three main things:
|
||||
;;;
|
||||
;;; - Sets environment variables to the values declared in
|
||||
;;; @file{setup-environment} shell script. It's necessary, because user can set
|
||||
;;; for example XDG_CONFIG_HOME and it should be respected by activation gexp of
|
||||
;;; symlink-manager.
|
||||
;;;
|
||||
;;; - Sets GUIX_NEW_HOME and possibly GUIX_OLD_HOME vars to paths in the store.
|
||||
;;; Later those variables can be used by activation gexps, for example by
|
||||
;;; symlink-manager or run-on-change services.
|
||||
;;;
|
||||
;;; - Run all activation gexps provided by other home services.
|
||||
;;;
|
||||
;;; home-run-on-change-service-type allows to trigger actions during
|
||||
;;; activation if file or directory specified by pattern is changed.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
|
||||
(define (home-derivation entries mextensions)
|
||||
"Return as a monadic value the derivation of the 'home'
|
||||
directory containing the given entries."
|
||||
(mlet %store-monad ((extensions (mapm/accumulate-builds identity
|
||||
mextensions)))
|
||||
(lower-object
|
||||
(file-union "home" (append entries (concatenate extensions))))))
|
||||
|
||||
(define home-service-type
|
||||
;; This is the ultimate service type, the root of the home service
|
||||
;; DAG. The service of this type is extended by monadic name/item
|
||||
;; pairs. These items end up in the "home-environment directory" as
|
||||
;; returned by 'home-environment-derivation'.
|
||||
(service-type (name 'home)
|
||||
(extensions '())
|
||||
(compose identity)
|
||||
(extend home-derivation)
|
||||
(default-value '())
|
||||
(description
|
||||
"Build the home environment top-level directory,
|
||||
which in turn refers to everything the home environment needs: its
|
||||
packages, configuration files, activation script, and so on.")))
|
||||
|
||||
(define (packages->profile-entry packages)
|
||||
"Return a system entry for the profile containing PACKAGES."
|
||||
;; XXX: 'mlet' is needed here for one reason: to get the proper
|
||||
;; '%current-target' and '%current-target-system' bindings when
|
||||
;; 'packages->manifest' is called, and thus when the 'package-inputs'
|
||||
;; etc. procedures are called on PACKAGES. That way, conditionals in those
|
||||
;; inputs see the "correct" value of these two parameters. See
|
||||
;; <https://issues.guix.gnu.org/44952>.
|
||||
(mlet %store-monad ((_ (current-target-system)))
|
||||
(return `(("profile" ,(profile
|
||||
(content (packages->manifest
|
||||
(map identity
|
||||
;;(options->transformation transformations)
|
||||
(delete-duplicates packages eq?))))))))))
|
||||
|
||||
;; MAYBE: Add a list of transformations for packages. It's better to
|
||||
;; place it in home-profile-service-type to affect all profile
|
||||
;; packages and prevent conflicts, when other packages relies on
|
||||
;; non-transformed version of package.
|
||||
(define home-profile-service-type
|
||||
(service-type (name 'home-profile)
|
||||
(extensions
|
||||
(list (service-extension home-service-type
|
||||
packages->profile-entry)))
|
||||
(compose concatenate)
|
||||
(extend append)
|
||||
(description
|
||||
"This is the @dfn{home profile} and can be found in
|
||||
@file{~/.guix-home/profile}. It contains packages and
|
||||
configuration files that the user has declared in their
|
||||
@code{home-environment} record.")))
|
||||
|
||||
(define (environment-variables->setup-environment-script vars)
|
||||
"Return a file that can be sourced by a POSIX compliant shell which
|
||||
initializes the environment. The file will source the home
|
||||
environment profile, set some default environment variables, and set
|
||||
environment variables provided in @code{vars}. @code{vars} is a list
|
||||
of pairs (@code{(key . value)}), @code{key} is a string and
|
||||
@code{value} is a string or gexp.
|
||||
|
||||
If value is @code{#f} variable will be omitted.
|
||||
If value is @code{#t} variable will be just exported.
|
||||
For any other, value variable will be set to the @code{value} and
|
||||
exported."
|
||||
(define (warn-about-duplicate-defenitions)
|
||||
(fold
|
||||
(lambda (x acc)
|
||||
(when (equal? (car x) (car acc))
|
||||
(warning
|
||||
(G_ "duplicate definition for `~a' environment variable ~%") (car x)))
|
||||
x)
|
||||
(cons "" "")
|
||||
(sort vars (lambda (a b)
|
||||
(string<? (car a) (car b))))))
|
||||
|
||||
(warn-about-duplicate-defenitions)
|
||||
(with-monad
|
||||
%store-monad
|
||||
(return
|
||||
`(("setup-environment"
|
||||
;; TODO: It's necessary to source ~/.guix-profile too
|
||||
;; on foreign distros
|
||||
,(apply mixed-text-file "setup-environment"
|
||||
"\
|
||||
HOME_ENVIRONMENT=$HOME/.guix-home
|
||||
GUIX_PROFILE=\"$HOME_ENVIRONMENT/profile\"
|
||||
PROFILE_FILE=\"$HOME_ENVIRONMENT/profile/etc/profile\"
|
||||
[ -f $PROFILE_FILE ] && . $PROFILE_FILE
|
||||
|
||||
case $XDG_DATA_DIRS in
|
||||
*$HOME_ENVIRONMENT/profile/share*) ;;
|
||||
*) export XDG_DATA_DIRS=$HOME_ENVIRONMENT/profile/share:$XDG_DATA_DIRS ;;
|
||||
esac
|
||||
case $MANPATH in
|
||||
*$HOME_ENVIRONMENT/profile/share/man*) ;;
|
||||
*) export MANPATH=$HOME_ENVIRONMENT/profile/share/man:$MANPATH
|
||||
esac
|
||||
case $INFOPATH in
|
||||
*$HOME_ENVIRONMENT/profile/share/info*) ;;
|
||||
*) export INFOPATH=$HOME_ENVIRONMENT/profile/share/info:$INFOPATH ;;
|
||||
esac
|
||||
case $XDG_CONFIG_DIRS in
|
||||
*$HOME_ENVIRONMENT/profile/etc/xdg*) ;;
|
||||
*) export XDG_CONFIG_DIRS=$HOME_ENVIRONMENT/profile/etc/xdg:$XDG_CONFIG_DIRS ;;
|
||||
esac
|
||||
case $XCURSOR_PATH in
|
||||
*$HOME_ENVIRONMENT/profile/share/icons*) ;;
|
||||
*) export XCURSOR_PATH=$HOME_ENVIRONMENT/profile/share/icons:$XCURSOR_PATH ;;
|
||||
esac
|
||||
|
||||
"
|
||||
|
||||
(append-map
|
||||
(match-lambda
|
||||
((key . #f)
|
||||
'())
|
||||
((key . #t)
|
||||
(list "export " key "\n"))
|
||||
((key . value)
|
||||
(list "export " key "=" value "\n")))
|
||||
vars)))))))
|
||||
|
||||
(define home-environment-variables-service-type
|
||||
(service-type (name 'home-environment-variables)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
home-service-type
|
||||
environment-variables->setup-environment-script)))
|
||||
(compose concatenate)
|
||||
(extend append)
|
||||
(default-value '())
|
||||
(description "Set the environment variables.")))
|
||||
|
||||
(define (files->files-directory files)
|
||||
"Return a @code{files} directory that contains FILES."
|
||||
(define (assert-no-duplicates files)
|
||||
(let loop ((files files)
|
||||
(seen (set)))
|
||||
(match files
|
||||
(() #t)
|
||||
(((file _) rest ...)
|
||||
(when (set-contains? seen file)
|
||||
(raise (formatted-message (G_ "duplicate '~a' entry for files/")
|
||||
file)))
|
||||
(loop rest (set-insert file seen))))))
|
||||
|
||||
;; Detect duplicates early instead of letting them through, eventually
|
||||
;; leading to a build failure of "files.drv".
|
||||
(assert-no-duplicates files)
|
||||
|
||||
(file-union "files" files))
|
||||
|
||||
(define (files-entry files)
|
||||
"Return an entry for the @file{~/.guix-home/files}
|
||||
directory containing FILES."
|
||||
(with-monad %store-monad
|
||||
(return `(("files" ,(files->files-directory files))))))
|
||||
|
||||
(define home-files-service-type
|
||||
(service-type (name 'home-files)
|
||||
(extensions
|
||||
(list (service-extension home-service-type
|
||||
files-entry)))
|
||||
(compose concatenate)
|
||||
(extend append)
|
||||
(default-value '())
|
||||
(description "Configuration files for programs that
|
||||
will be put in @file{~/.guix-home/files}.")))
|
||||
|
||||
(define (compute-on-first-login-script _ gexps)
|
||||
(gexp->script
|
||||
"on-first-login"
|
||||
#~(let* ((xdg-runtime-dir (or (getenv "XDG_RUNTIME_DIR")
|
||||
(format #f "/run/user/~a" (getuid))))
|
||||
(flag-file-path (string-append
|
||||
xdg-runtime-dir "/on-first-login-executed"))
|
||||
(touch (lambda (file-name)
|
||||
(call-with-output-file file-name (const #t)))))
|
||||
;; XDG_RUNTIME_DIR dissapears on logout, that means such trick
|
||||
;; allows to launch on-first-login script on first login only
|
||||
;; after complete logout/reboot.
|
||||
(when (not (file-exists? flag-file-path))
|
||||
(begin #$@gexps (touch flag-file-path))))))
|
||||
|
||||
(define (on-first-login-script-entry m-on-first-login)
|
||||
"Return, as a monadic value, an entry for the on-first-login script
|
||||
in the home environment directory."
|
||||
(mlet %store-monad ((on-first-login m-on-first-login))
|
||||
(return `(("on-first-login" ,on-first-login)))))
|
||||
|
||||
(define home-run-on-first-login-service-type
|
||||
(service-type (name 'home-run-on-first-login)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
home-service-type
|
||||
on-first-login-script-entry)))
|
||||
(compose identity)
|
||||
(extend compute-on-first-login-script)
|
||||
(default-value #f)
|
||||
(description "Run gexps on first user login. Can be
|
||||
extended with one gexp.")))
|
||||
|
||||
|
||||
(define (compute-activation-script init-gexp gexps)
|
||||
(gexp->script
|
||||
"activate"
|
||||
#~(let* ((he-init-file (lambda (he) (string-append he "/setup-environment")))
|
||||
(he-path (string-append (getenv "HOME") "/.guix-home"))
|
||||
(new-home-env (getenv "GUIX_NEW_HOME"))
|
||||
(new-home (or new-home-env
|
||||
;; Path of the activation file if called interactively
|
||||
(dirname (car (command-line)))))
|
||||
(old-home-env (getenv "GUIX_OLD_HOME"))
|
||||
(old-home (or old-home-env
|
||||
(if (file-exists? (he-init-file he-path))
|
||||
(readlink he-path)
|
||||
#f))))
|
||||
(if (file-exists? (he-init-file new-home))
|
||||
(let* ((port ((@ (ice-9 popen) open-input-pipe)
|
||||
(format #f "source ~a && env -0"
|
||||
(he-init-file new-home))))
|
||||
(result ((@ (ice-9 rdelim) read-delimited) "" port))
|
||||
(vars (map (lambda (x)
|
||||
(let ((si (string-index x #\=)))
|
||||
(cons (string-take x si)
|
||||
(string-drop x (1+ si)))))
|
||||
((@ (srfi srfi-1) remove)
|
||||
string-null?
|
||||
(string-split result #\nul)))))
|
||||
(close-port port)
|
||||
(map (lambda (x) (setenv (car x) (cdr x))) vars)
|
||||
|
||||
(setenv "GUIX_NEW_HOME" new-home)
|
||||
(setenv "GUIX_OLD_HOME" old-home)
|
||||
|
||||
#$@gexps
|
||||
|
||||
;; Do not unset env variable if it was set outside.
|
||||
(unless new-home-env (setenv "GUIX_NEW_HOME" #f))
|
||||
(unless old-home-env (setenv "GUIX_OLD_HOME" #f)))
|
||||
(format #t "\
|
||||
Activation script was either called or loaded by file from this direcotry:
|
||||
~a
|
||||
It doesn't seem that home environment is somewhere around.
|
||||
Make sure that you call ./activate by symlink from -home store item.\n"
|
||||
new-home)))))
|
||||
|
||||
(define (activation-script-entry m-activation)
|
||||
"Return, as a monadic value, an entry for the activation script
|
||||
in the home environment directory."
|
||||
(mlet %store-monad ((activation m-activation))
|
||||
(return `(("activate" ,activation)))))
|
||||
|
||||
(define home-activation-service-type
|
||||
(service-type (name 'home-activation)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
home-service-type
|
||||
activation-script-entry)))
|
||||
(compose identity)
|
||||
(extend compute-activation-script)
|
||||
(default-value #f)
|
||||
(description "Run gexps to activate the current
|
||||
generation of home environment and update the state of the home
|
||||
directory. @command{activate} script automatically called during
|
||||
reconfiguration or generation switching. This service can be extended
|
||||
with one gexp, but many times, and all gexps must be idempotent.")))
|
||||
|
||||
|
||||
;;;
|
||||
;;; On-change.
|
||||
;;;
|
||||
|
||||
(define (compute-on-change-gexp eval-gexps? pattern-gexp-tuples)
|
||||
#~(begin
|
||||
(define (equal-regulars? file1 file2)
|
||||
"Check if FILE1 and FILE2 are bit for bit identical."
|
||||
(let* ((cmp-binary #$(file-append
|
||||
(@ (gnu packages base) diffutils) "/bin/cmp"))
|
||||
(stats1 (lstat file1))
|
||||
(stats2 (lstat file2)))
|
||||
(cond
|
||||
((= (stat:ino stats1) (stat:ino stats2)) #t)
|
||||
((not (= (stat:size stats1) (stat:size stats2))) #f)
|
||||
|
||||
(else (= (system* cmp-binary file1 file2) 0)))))
|
||||
|
||||
(define (equal-symlinks? symlink1 symlink2)
|
||||
"Check if SYMLINK1 and SYMLINK2 are pointing to the same target."
|
||||
(string=? (readlink symlink1) (readlink symlink2)))
|
||||
|
||||
(define (equal-directories? dir1 dir2)
|
||||
"Check if DIR1 and DIR2 have the same content."
|
||||
(define (ordinary-file file)
|
||||
(not (or (string=? file ".")
|
||||
(string=? file ".."))))
|
||||
(let* ((files1 (scandir dir1 ordinary-file))
|
||||
(files2 (scandir dir2 ordinary-file)))
|
||||
(if (equal? files1 files2)
|
||||
(map (lambda (file)
|
||||
(equal-files?
|
||||
(string-append dir1 "/" file)
|
||||
(string-append dir2 "/" file)))
|
||||
files1)
|
||||
#f)))
|
||||
|
||||
(define (equal-files? file1 file2)
|
||||
"Compares files, symlinks or directories of the same type."
|
||||
(case (file-type file1)
|
||||
((directory) (equal-directories? file1 file2))
|
||||
((symlink) (equal-symlinks? file1 file2))
|
||||
((regular) (equal-regulars? file1 file2))
|
||||
(else
|
||||
(display "The file type is unsupported by on-change service.\n")
|
||||
#f)))
|
||||
|
||||
(define (file-type file)
|
||||
(stat:type (lstat file)))
|
||||
|
||||
(define (something-changed? file1 file2)
|
||||
(cond
|
||||
((and (not (file-exists? file1))
|
||||
(not (file-exists? file2))) #f)
|
||||
((or (not (file-exists? file1))
|
||||
(not (file-exists? file2))) #t)
|
||||
|
||||
((not (eq? (file-type file1) (file-type file2))) #t)
|
||||
|
||||
(else
|
||||
(not (equal-files? file1 file2)))))
|
||||
|
||||
(define expressions-to-eval
|
||||
(map
|
||||
(lambda (x)
|
||||
(let* ((file1 (string-append
|
||||
(or (getenv "GUIX_OLD_HOME")
|
||||
"/gnu/store/non-existing-generation")
|
||||
"/" (car x)))
|
||||
(file2 (string-append (getenv "GUIX_NEW_HOME") "/" (car x)))
|
||||
(_ (format #t "Comparing ~a and\n~10t~a..." file1 file2))
|
||||
(any-changes? (something-changed? file1 file2))
|
||||
(_ (format #t " done (~a)\n"
|
||||
(if any-changes? "changed" "same"))))
|
||||
(if any-changes? (cadr x) "")))
|
||||
'#$pattern-gexp-tuples))
|
||||
|
||||
(if #$eval-gexps?
|
||||
(begin
|
||||
(display "Evaling on-change gexps.\n\n")
|
||||
(for-each primitive-eval expressions-to-eval)
|
||||
(display "On-change gexps evaluation finished.\n\n"))
|
||||
(display "\
|
||||
On-change gexps won't be evaluated, disabled by service
|
||||
configuration.\n"))))
|
||||
|
||||
(define home-run-on-change-service-type
|
||||
(service-type (name 'home-run-on-change)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
home-activation-service-type
|
||||
identity)))
|
||||
(compose concatenate)
|
||||
(extend compute-on-change-gexp)
|
||||
(default-value #t)
|
||||
(description "\
|
||||
G-expressions to run if the specified files have changed since the
|
||||
last generation. The extension should be a list of lists where the
|
||||
first element is the pattern for file or directory that expected to be
|
||||
changed, and the second element is the G-expression to be evaluated.")))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Provenance tracking.
|
||||
;;;
|
||||
|
||||
(define home-provenance-service-type
|
||||
(service-type
|
||||
(name 'home-provenance)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
home-service-type
|
||||
(service-extension-compute
|
||||
(first (service-type-extensions provenance-service-type))))))
|
||||
(default-value #f) ;the HE config file
|
||||
(description "\
|
||||
Store provenance information about the home environment in the home
|
||||
environment itself: the channels used when building the home
|
||||
environment, and its configuration file, when available.")))
|
||||
|
||||
(define sexp->home-provenance sexp->system-provenance)
|
||||
(define home-provenance system-provenance)
|
||||
|
||||
|
||||
;;;
|
||||
;;; Searching
|
||||
;;;
|
||||
|
||||
(define (parent-directory directory)
|
||||
"Get the parent directory of DIRECTORY"
|
||||
(string-join (drop-right (string-split directory #\/) 1) "/"))
|
||||
|
||||
(define %guix-home-root-directory
|
||||
;; Absolute file name of the module hierarchy.
|
||||
(parent-directory (dirname (search-path %load-path "gnu/home-services.scm"))))
|
||||
|
||||
(define %service-type-path
|
||||
;; Search path for service types.
|
||||
(make-parameter `((,%guix-home-root-directory . "gnu/home-services"))))
|
||||
|
||||
(define (all-home-service-modules)
|
||||
"Return the default set of home-service modules."
|
||||
(cons (resolve-interface '(gnu home-services))
|
||||
(all-modules (%service-type-path)
|
||||
#:warn warn-about-load-error)))
|
||||
|
||||
(define* (fold-home-service-types proc seed)
|
||||
(fold-service-types proc seed (all-home-service-modules)))
|
||||
|
|
@ -0,0 +1,107 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
||||
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU 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.
|
||||
;;;
|
||||
;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu home-services configuration)
|
||||
#:use-module (gnu services configuration)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (ice-9 curried-definitions)
|
||||
#:use-module (ice-9 match)
|
||||
|
||||
#:export (filter-configuration-fields
|
||||
|
||||
interpose
|
||||
list-of
|
||||
|
||||
list-of-strings?
|
||||
alist?
|
||||
string-or-gexp?
|
||||
serialize-string-or-gexp
|
||||
text-config?
|
||||
serialize-text-config
|
||||
generic-serialize-alist-entry
|
||||
generic-serialize-alist))
|
||||
|
||||
(define* (filter-configuration-fields configuration-fields fields
|
||||
#:optional negate?)
|
||||
"Retrieve the fields listed in FIELDS from CONFIGURATION-FIELDS.
|
||||
If NEGATE? is @code{#t}, retrieve all fields except FIELDS."
|
||||
(filter (lambda (field)
|
||||
(let ((member? (member (configuration-field-name field) fields)))
|
||||
(if (not negate?) member? (not member?))))
|
||||
configuration-fields))
|
||||
|
||||
|
||||
(define* (interpose ls #:optional (delimiter "\n") (grammar 'infix))
|
||||
"Same as @code{string-join}, but without join and string, returns an
|
||||
DELIMITER interposed LS. Support 'infix and 'suffix GRAMMAR values."
|
||||
(when (not (member grammar '(infix suffix)))
|
||||
(raise
|
||||
(formatted-message
|
||||
(G_ "The GRAMMAR value must be 'infix or 'suffix, but ~a provided.")
|
||||
grammar)))
|
||||
(fold-right (lambda (e acc)
|
||||
(cons e
|
||||
(if (and (null? acc) (eq? grammar 'infix))
|
||||
acc
|
||||
(cons delimiter acc))))
|
||||
'() ls))
|
||||
|
||||
(define (list-of pred?)
|
||||
"Return a procedure that takes a list and check if all the elements of
|
||||
the list result in @code{#t} when applying PRED? on them."
|
||||
(lambda (x)
|
||||
(if (list? x)
|
||||
(every pred? x)
|
||||
#f)))
|
||||
|
||||
|
||||
(define list-of-strings?
|
||||
(list-of string?))
|
||||
|
||||
(define alist? list?)
|
||||
|
||||
(define (string-or-gexp? sg) (or (string? sg) (gexp? sg)))
|
||||
(define (serialize-string-or-gexp field-name val) "")
|
||||
|
||||
(define (text-config? config)
|
||||
(and (list? config) (every string-or-gexp? config)))
|
||||
(define (serialize-text-config field-name val)
|
||||
#~(string-append #$@(interpose val "\n" 'suffix)))
|
||||
|
||||
(define ((generic-serialize-alist-entry serialize-field) entry)
|
||||
"Apply the SERIALIZE-FIELD procedure on the field and value of ENTRY."
|
||||
(match entry
|
||||
((field . val) (serialize-field field val))))
|
||||
|
||||
(define (generic-serialize-alist combine serialize-field fields)
|
||||
"Generate a configuration from an association list FIELDS.
|
||||
|
||||
SERIALIZE-FIELD is a procedure that takes two arguments, it will be
|
||||
applied on the fields and values of FIELDS using the
|
||||
@code{generic-serialize-alist-entry} procedure.
|
||||
|
||||
COMBINE is a procedure that takes one or more arguments and combines
|
||||
all the alist entries into one value, @code{string-append} or
|
||||
@code{append} are usually good candidates for this.
|
||||
|
||||
See the @code{serialize-alist} procedure in `@code{(gnu home-services
|
||||
version-control}' for an example usage.)}"
|
||||
(apply combine
|
||||
(map (generic-serialize-alist-entry serialize-field) fields)))
|
||||
|
|
@ -0,0 +1,65 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
||||
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU 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.
|
||||
;;;
|
||||
;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu home-services fontutils)
|
||||
#:use-module (gnu home-services)
|
||||
#:use-module (gnu packages fontutils)
|
||||
#:use-module (guix gexp)
|
||||
|
||||
#:export (home-fontconfig-service-type))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; Services related to fonts. home-fontconfig service provides
|
||||
;;; fontconfig configuration, which allows fc-* utilities to find
|
||||
;;; fonts in Guix Home's profile and regenerates font cache on
|
||||
;;; activation.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define (add-fontconfig-config-file he-symlink-path)
|
||||
`(("config/fontconfig/fonts.conf"
|
||||
,(mixed-text-file
|
||||
"fonts.conf"
|
||||
"<?xml version='1.0'?>
|
||||
<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'>
|
||||
<fontconfig>
|
||||
<dir>~/.guix-home/profile/share/fonts</dir>
|
||||
</fontconfig>"))))
|
||||
|
||||
(define (regenerate-font-cache-gexp _)
|
||||
`(("profile/share/fonts"
|
||||
,#~(system* #$(file-append fontconfig "/bin/fc-cache") "-fv"))))
|
||||
|
||||
(define home-fontconfig-service-type
|
||||
(service-type (name 'home-fontconfig)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
home-files-service-type
|
||||
add-fontconfig-config-file)
|
||||
(service-extension
|
||||
home-run-on-change-service-type
|
||||
regenerate-font-cache-gexp)
|
||||
(service-extension
|
||||
home-profile-service-type
|
||||
(const (list fontconfig)))))
|
||||
(default-value #f)
|
||||
(description
|
||||
"Provides configuration file for fontconfig and make
|
||||
fc-* utilities aware of font packages installed in Guix Home's profile.")))
|
||||
|
|
@ -0,0 +1,115 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
||||
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU 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.
|
||||
;;;
|
||||
;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu home-services mcron)
|
||||
#:use-module (gnu packages guile-xyz)
|
||||
#:use-module (gnu home-services)
|
||||
#:use-module (gnu home-services shepherd)
|
||||
#:use-module (gnu services shepherd)
|
||||
#:use-module (guix records)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (ice-9 match)
|
||||
|
||||
#:export (home-mcron-configuration
|
||||
home-mcron-service-type))
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; Service for the GNU mcron cron job manager.
|
||||
;;
|
||||
;; Example configuration, the first job runs mbsync once every ten
|
||||
;; minutes, the second one writes "Mcron service" to ~/mcron-file once
|
||||
;; every minute.
|
||||
;;
|
||||
;; (service home-mcron-service-type
|
||||
;; (home-mcron-configuration
|
||||
;; (jobs (list #~(job '(next-minute
|
||||
;; (range 0 60 10))
|
||||
;; (lambda ()
|
||||
;; (system* "mbsync" "--all")))
|
||||
;; #~(job next-minute-from
|
||||
;; (lambda ()
|
||||
;; (call-with-output-file (string-append (getenv "HOME")
|
||||
;; "/mcron-file")
|
||||
;; (lambda (port)
|
||||
;; (display "Mcron service" port)))))))))
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(define-record-type* <home-mcron-configuration> home-mcron-configuration
|
||||
make-home-mcron-configuration
|
||||
home-mcron-configuration?
|
||||
(package home-mcron-configuration-package ; package
|
||||
(default mcron))
|
||||
(jobs home-mcron-configuration-jobs ; list of jobs
|
||||
(default '())))
|
||||
|
||||
(define job-files (@@ (gnu services mcron) job-files))
|
||||
(define shepherd-schedule-action
|
||||
(@@ (gnu services mcron) shepherd-schedule-action))
|
||||
|
||||
(define home-mcron-shepherd-services
|
||||
(match-lambda
|
||||
(($ <home-mcron-configuration> mcron '()) ; no jobs to run
|
||||
'())
|
||||
(($ <home-mcron-configuration> mcron jobs)
|
||||
(let ((files (job-files mcron jobs)))
|
||||
(list (shepherd-service
|
||||
(documentation "User cron jobs.")
|
||||
(provision '(mcron))
|
||||
(modules `((srfi srfi-1)
|
||||
(srfi srfi-26)
|
||||
(ice-9 popen) ; for the 'schedule' action
|
||||
(ice-9 rdelim)
|
||||
(ice-9 match)
|
||||
,@%default-modules))
|
||||
(start #~(make-forkexec-constructor
|
||||
(list #$(file-append mcron "/bin/mcron") #$@files)
|
||||
#:log-file (string-append
|
||||
(or (getenv "XDG_LOG_HOME")
|
||||
(format #f "~a/.local/var/log"
|
||||
(getenv "HOME")))
|
||||
"/mcron.log")))
|
||||
(stop #~(make-kill-destructor))
|
||||
(actions
|
||||
(list (shepherd-schedule-action mcron files)))))))))
|
||||
|
||||
(define home-mcron-profile (compose list home-mcron-configuration-package))
|
||||
|
||||
(define (home-mcron-extend config jobs)
|
||||
(home-mcron-configuration
|
||||
(inherit config)
|
||||
(jobs (append (home-mcron-configuration-jobs config)
|
||||
jobs))))
|
||||
|
||||
(define home-mcron-service-type
|
||||
(service-type (name 'home-mcron)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
home-shepherd-service-type
|
||||
home-mcron-shepherd-services)
|
||||
(service-extension
|
||||
home-profile-service-type
|
||||
home-mcron-profile)))
|
||||
(compose concatenate)
|
||||
(extend home-mcron-extend)
|
||||
(default-value (home-mcron-configuration))
|
||||
(description
|
||||
"Install and configure the GNU mcron cron job manager.")))
|
||||
|
|
@ -0,0 +1,634 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
||||
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU 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.
|
||||
;;;
|
||||
;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu home-services shells)
|
||||
#:use-module (gnu services configuration)
|
||||
#:use-module (gnu home-services configuration)
|
||||
#:use-module (gnu home-services utils)
|
||||
#:use-module (gnu home-services)
|
||||
#:use-module (gnu packages shells)
|
||||
#:use-module (gnu packages bash)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (ice-9 match)
|
||||
|
||||
#:export (home-shell-profile-service-type
|
||||
home-shell-profile-configuration
|
||||
|
||||
home-bash-service-type
|
||||
home-bash-configuration
|
||||
home-bash-extension
|
||||
|
||||
home-zsh-service-type
|
||||
home-zsh-configuration
|
||||
home-zsh-extension
|
||||
|
||||
home-fish-service-type
|
||||
home-fish-configuration
|
||||
home-fish-extension))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; This module contains shell related services like Zsh.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
|
||||
;;;
|
||||
;;; Shell profile.
|
||||
;;;
|
||||
|
||||
(define path? string?)
|
||||
(define (serialize-path field-name val) val)
|
||||
|
||||
(define-configuration home-shell-profile-configuration
|
||||
(profile
|
||||
(text-config '())
|
||||
"\
|
||||
@code{home-shell-profile} is instantiated automatically by
|
||||
@code{home-environment}, DO NOT create this service manually, it can
|
||||
only be extended.
|
||||
|
||||
@code{profile} is a list of strings or gexps, which will go to
|
||||
@file{~/.profile}. By default @file{~/.profile} contains the
|
||||
initialization code, which have to be evaluated by login shell to make
|
||||
home-environment's profile avaliable to the user, but other commands
|
||||
can be added to the file if it is really necessary.
|
||||
|
||||
In most cases shell's configuration files are preferred places for
|
||||
user's customizations. Extend home-shell-profile service only if you
|
||||
really know what you do."))
|
||||
|
||||
(define (add-shell-profile-file config)
|
||||
`(("profile"
|
||||
,(mixed-text-file
|
||||
"shell-profile"
|
||||
"\
|
||||
HOME_ENVIRONMENT=$HOME/.guix-home
|
||||
. $HOME_ENVIRONMENT/setup-environment
|
||||
$HOME_ENVIRONMENT/on-first-login\n"
|
||||
(serialize-configuration
|
||||
config
|
||||
(filter-configuration-fields
|
||||
home-shell-profile-configuration-fields '(profile)))))))
|
||||
|
||||
(define (add-profile-extensions config extensions)
|
||||
(home-shell-profile-configuration
|
||||
(inherit config)
|
||||
(profile
|
||||
(append (home-shell-profile-configuration-profile config)
|
||||
extensions))))
|
||||
|
||||
(define home-shell-profile-service-type
|
||||
(service-type (name 'home-shell-profile)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
home-files-service-type
|
||||
add-shell-profile-file)))
|
||||
(compose concatenate)
|
||||
(extend add-profile-extensions)
|
||||
(default-value (home-shell-profile-configuration))
|
||||
(description "Create @file{~/.profile}, which is used
|
||||
for environment initialization of POSIX compliant login shells. This
|
||||
service type can be extended with a list of strings or gexps.")))
|
||||
|
||||
(define (serialize-boolean field-name val) "")
|
||||
(define (serialize-posix-env-vars field-name val)
|
||||
#~(string-append
|
||||
#$@(map
|
||||
(match-lambda
|
||||
((key . #f)
|
||||
"")
|
||||
((key . #t)
|
||||
#~(string-append "export " #$key "\n"))
|
||||
((key . value)
|
||||
#~(string-append "export " #$key "=" #$value "\n")))
|
||||
val)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Zsh.
|
||||
;;;
|
||||
|
||||
(define-configuration home-zsh-configuration
|
||||
(package
|
||||
(package zsh)
|
||||
"The Zsh package to use.")
|
||||
(xdg-flavor?
|
||||
(boolean #t)
|
||||
"Place all the configs to @file{$XDG_CONFIG_HOME/zsh}. Makes
|
||||
@file{~/.zshenv} to set @env{ZDOTDIR} to @file{$XDG_CONFIG_HOME/zsh}.
|
||||
Shell startup process will continue with
|
||||
@file{$XDG_CONFIG_HOME/zsh/.zshenv}.")
|
||||
(environment-variables
|
||||
(alist '())
|
||||
"Association list of environment variables to set for the Zsh session."
|
||||
serialize-posix-env-vars)
|
||||
(zshenv
|
||||
(text-config '())
|
||||
"List of strings or gexps, which will be added to @file{.zshenv}.
|
||||
Used for setting user's shell environment variables. Must not contain
|
||||
commands assuming the presence of tty or producing output. Will be
|
||||
read always. Will be read before any other file in @env{ZDOTDIR}.")
|
||||
(zprofile
|
||||
(text-config '())
|
||||
"List of strings or gexps, which will be added to @file{.zprofile}.
|
||||
Used for executing user's commands at start of login shell (In most
|
||||
cases the shell started on tty just after login). Will be read before
|
||||
@file{.zlogin}.")
|
||||
(zshrc
|
||||
(text-config '())
|
||||
"List of strings or gexps, which will be added to @file{.zshrc}.
|
||||
Used for executing user's commands at start of interactive shell (The
|
||||
shell for interactive usage started by typing @code{zsh} or by
|
||||
terminal app or any other program).")
|
||||
(zlogin
|
||||
(text-config '())
|
||||
"List of strings or gexps, which will be added to @file{.zlogin}.
|
||||
Used for executing user's commands at the end of starting process of
|
||||
login shell.")
|
||||
(zlogout
|
||||
(text-config '())
|
||||
"List of strings or gexps, which will be added to @file{.zlogout}.
|
||||
Used for executing user's commands at the exit of login shell. It
|
||||
won't be read in some cases (if the shell terminates by exec'ing
|
||||
another process for example)."))
|
||||
|
||||
(define (add-zsh-configuration config)
|
||||
(let* ((xdg-flavor? (home-zsh-configuration-xdg-flavor? config)))
|
||||
|
||||
(define prefix-file
|
||||
(cut string-append
|
||||
(if xdg-flavor?
|
||||
"config/zsh/."
|
||||
"") <>))
|
||||
|
||||
(define (filter-fields field)
|
||||
(filter-configuration-fields home-zsh-configuration-fields
|
||||
(list field)))
|
||||
|
||||
(define (serialize-field field)
|
||||
(serialize-configuration
|
||||
config
|
||||
(filter-fields field)))
|
||||
|
||||
(define (file-if-not-empty field)
|
||||
(let ((file-name (symbol->string field))
|
||||
(field-obj (car (filter-fields field))))
|
||||
(if (not (null? ((configuration-field-getter field-obj) config)))
|
||||
`(,(prefix-file file-name)
|
||||
,(mixed-text-file
|
||||
file-name
|
||||
(serialize-field field)))
|
||||
'())))
|
||||
|
||||
(filter
|
||||
(compose not null?)
|
||||
`(,(if xdg-flavor?
|
||||
`("zshenv"
|
||||
,(mixed-text-file
|
||||
"auxiliary-zshenv"
|
||||
(if xdg-flavor?
|
||||
"source ${XDG_CONFIG_HOME:-$HOME/.config}/zsh/.zshenv\n"
|
||||
"")))
|
||||
'())
|
||||
(,(prefix-file "zshenv")
|
||||
,(mixed-text-file
|
||||
"zshenv"
|
||||
(if xdg-flavor?
|
||||
"export ZDOTDIR=${XDG_CONFIG_HOME:-$HOME/.config}/zsh\n"
|
||||
"")
|
||||
(serialize-field 'zshenv)
|
||||
(serialize-field 'environment-variables)))
|
||||
(,(prefix-file "zprofile")
|
||||
,(mixed-text-file
|
||||
"zprofile"
|
||||
"\
|
||||
# Setups system and user profiles and related variables
|
||||
source /etc/profile
|
||||
# Setups home environment profile
|
||||
source ~/.profile
|
||||
|
||||
# It's only necessary if zsh is a login shell, otherwise profiles will
|
||||
# be already sourced by bash
|
||||
"
|
||||
(serialize-field 'zprofile)))
|
||||
|
||||
,@(list (file-if-not-empty 'zshrc)
|
||||
(file-if-not-empty 'zlogin)
|
||||
(file-if-not-empty 'zlogout))))))
|
||||
|
||||
(define (add-zsh-packages config)
|
||||
(list (home-zsh-configuration-package config)))
|
||||
|
||||
(define-configuration/no-serialization home-zsh-extension
|
||||
(environment-variables
|
||||
(alist '())
|
||||
"Association list of environment variables to set.")
|
||||
(zshrc
|
||||
(text-config '())
|
||||
"List of strings or gexps.")
|
||||
(zshenv
|
||||
(text-config '())
|
||||
"List of strings or gexps.")
|
||||
(zprofile
|
||||
(text-config '())
|
||||
"List of strings or gexps.")
|
||||
(zlogin
|
||||
(text-config '())
|
||||
"List of strings or gexps.")
|
||||
(zlogout
|
||||
(text-config '())
|
||||
"List of strings or gexps."))
|
||||
|
||||
(define (home-zsh-extensions original-config extension-configs)
|
||||
(home-zsh-configuration
|
||||
(inherit original-config)
|
||||
(environment-variables
|
||||
(append (home-zsh-configuration-environment-variables original-config)
|
||||
(append-map
|
||||
home-zsh-extension-environment-variables extension-configs)))
|
||||
(zshrc
|
||||
(append (home-zsh-configuration-zshrc original-config)
|
||||
(append-map
|
||||
home-zsh-extension-zshrc extension-configs)))
|
||||
(zshenv
|
||||
(append (home-zsh-configuration-zshenv original-config)
|
||||
(append-map
|
||||
home-zsh-extension-zshenv extension-configs)))
|
||||
(zprofile
|
||||
(append (home-zsh-configuration-zprofile original-config)
|
||||
(append-map
|
||||
home-zsh-extension-zprofile extension-configs)))
|
||||
(zlogin
|
||||
(append (home-zsh-configuration-zlogin original-config)
|
||||
(append-map
|
||||
home-zsh-extension-zlogin extension-configs)))
|
||||
(zlogout
|
||||
(append (home-zsh-configuration-zlogout original-config)
|
||||
(append-map
|
||||
home-zsh-extension-zlogout extension-configs)))))
|
||||
|
||||
(define home-zsh-service-type
|
||||
(service-type (name 'home-zsh)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
home-files-service-type
|
||||
add-zsh-configuration)
|
||||
(service-extension
|
||||
home-profile-service-type
|
||||
add-zsh-packages)))
|
||||
(compose identity)
|
||||
(extend home-zsh-extensions)
|
||||
(default-value (home-zsh-configuration))
|
||||
(description "Install and configure Zsh.")))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Bash.
|
||||
;;;
|
||||
|
||||
(define-configuration home-bash-configuration
|
||||
(package
|
||||
(package bash)
|
||||
"The Bash package to use.")
|
||||
(guix-defaults?
|
||||
(boolean #t)
|
||||
"Add sane defaults like reading @file{/etc/bashrc}, coloring output
|
||||
for @code{ls} provided by guix to @file{.bashrc}.")
|
||||
(environment-variables
|
||||
(alist '())
|
||||
"Association list of environment variables to set for the Bash session."
|
||||
serialize-posix-env-vars)
|
||||
(bash-profile
|
||||
(text-config '())
|
||||
"List of strings or gexps, which will be added to @file{.bash_profile}.
|
||||
Used for executing user's commands at start of login shell (In most
|
||||
cases the shell started on tty just after login). @file{.bash_login}
|
||||
won't be ever read, because @file{.bash_profile} always present.")
|
||||
(bashrc
|
||||
(text-config '())
|
||||
"List of strings or gexps, which will be added to @file{.bashrc}.
|
||||
Used for executing user's commands at start of interactive shell (The
|
||||
shell for interactive usage started by typing @code{bash} or by
|
||||
terminal app or any other program).")
|
||||
(bash-logout
|
||||
(text-config '())
|
||||
"List of strings or gexps, which will be added to @file{.bash_logout}.
|
||||
Used for executing user's commands at the exit of login shell. It
|
||||
won't be read in some cases (if the shell terminates by exec'ing
|
||||
another process for example)."))
|
||||
|
||||
;; TODO: Use value from (gnu system shadow)
|
||||
(define guix-bashrc
|
||||
"\
|
||||
# Bash initialization for interactive non-login shells and
|
||||
# for remote shells (info \"(bash) Bash Startup Files\").
|
||||
|
||||
# Export 'SHELL' to child processes. Programs such as 'screen'
|
||||
# honor it and otherwise use /bin/sh.
|
||||
export SHELL
|
||||
|
||||
if [[ $- != *i* ]]
|
||||
then
|
||||
# We are being invoked from a non-interactive shell. If this
|
||||
# is an SSH session (as in \"ssh host command\"), source
|
||||
# /etc/profile so we get PATH and other essential variables.
|
||||
[[ -n \"$SSH_CLIENT\" ]] && source /etc/profile
|
||||
|
||||
# Don't do anything else.
|
||||
return
|
||||
fi
|
||||
|
||||
# Source the system-wide file.
|
||||
source /etc/bashrc
|
||||
|
||||
# Adjust the prompt depending on whether we're in 'guix environment'.
|
||||
if [ -n \"$GUIX_ENVIRONMENT\" ]
|
||||
then
|
||||
PS1='\\u@\\h \\w [env]\\$ '
|
||||
else
|
||||
PS1='\\u@\\h \\w\\$ '
|
||||
fi
|
||||
alias ls='ls -p --color=auto'
|
||||
alias ll='ls -l'
|
||||
alias grep='grep --color=auto'\n")
|
||||
|
||||
(define (add-bash-configuration config)
|
||||
(define (filter-fields field)
|
||||
(filter-configuration-fields home-bash-configuration-fields
|
||||
(list field)))
|
||||
|
||||
(define (serialize-field field)
|
||||
(serialize-configuration
|
||||
config
|
||||
(filter-fields field)))
|
||||
|
||||
(define* (file-if-not-empty field #:optional (extra-content #f))
|
||||
(let ((file-name (symbol->string field))
|
||||
(field-obj (car (filter-fields field))))
|
||||
(if (or extra-content
|
||||
(not (null? ((configuration-field-getter field-obj) config))))
|
||||
`(,(object->snake-case-string file-name)
|
||||
,(mixed-text-file
|
||||
(object->snake-case-string file-name)
|
||||
(if extra-content extra-content "")
|
||||
(serialize-field field)))
|
||||
'())))
|
||||
|
||||
(filter
|
||||
(compose not null?)
|
||||
`(("bash_profile"
|
||||
,(mixed-text-file
|
||||
"bash_profile"
|
||||
"\
|
||||
# Setups system and user profiles and related variables
|
||||
# /etc/profile will be sourced by bash automatically
|
||||
# Setups home environment profile
|
||||
if [ -f ~/.profile ]; then source ~/.profile; fi
|
||||
|
||||
# Honor per-interactive-shell startup file
|
||||
if [ -f ~/.bashrc ]; then source ~/.bashrc; fi
|
||||
"
|
||||
(serialize-field 'bash-profile)
|
||||
(serialize-field 'environment-variables)))
|
||||
|
||||
,@(list (file-if-not-empty
|
||||
'bashrc
|
||||
(if (home-bash-configuration-guix-defaults? config)
|
||||
guix-bashrc
|
||||
#f))
|
||||
(file-if-not-empty 'bash-logout)))))
|
||||
|
||||
(define (add-bash-packages config)
|
||||
(list (home-bash-configuration-package config)))
|
||||
|
||||
(define-configuration/no-serialization home-bash-extension
|
||||
(environment-variables
|
||||
(alist '())
|
||||
"Association list of environment variables to set.")
|
||||
(bash-profile
|
||||
(text-config '())
|
||||
"List of strings or gexps.")
|
||||
(bashrc
|
||||
(text-config '())
|
||||
"List of strings or gexps.")
|
||||
(bash-logout
|
||||
(text-config '())
|
||||
"List of strings or gexps."))
|
||||
|
||||
(define (home-bash-extensions original-config extension-configs)
|
||||
(home-bash-configuration
|
||||
(inherit original-config)
|
||||
(environment-variables
|
||||
(append (home-bash-configuration-environment-variables original-config)
|
||||
(append-map
|
||||
home-bash-extension-environment-variables extension-configs)))
|
||||
(bash-profile
|
||||
(append (home-bash-configuration-bash-profile original-config)
|
||||
(append-map
|
||||
home-bash-extension-bash-profile extension-configs)))
|
||||
(bashrc
|
||||
(append (home-bash-configuration-bashrc original-config)
|
||||
(append-map
|
||||
home-bash-extension-bashrc extension-configs)))
|
||||
(bash-logout
|
||||
(append (home-bash-configuration-bash-logout original-config)
|
||||
(append-map
|
||||
home-bash-extension-bash-logout extension-configs)))))
|
||||
|
||||
(define home-bash-service-type
|
||||
(service-type (name 'home-bash)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
home-files-service-type
|
||||
add-bash-configuration)
|
||||
(service-extension
|
||||
home-profile-service-type
|
||||
add-bash-packages)))
|
||||
(compose identity)
|
||||
(extend home-bash-extensions)
|
||||
(default-value (home-bash-configuration))
|
||||
(description "Install and configure GNU Bash.")))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Fish.
|
||||
;;;
|
||||
|
||||
(define (serialize-fish-aliases field-name val)
|
||||
#~(string-append
|
||||
#$@(map (match-lambda
|
||||
((key . value)
|
||||
#~(string-append "alias " #$key " \"" #$value "\"\n"))
|
||||
(_ ""))
|
||||
val)))
|
||||
|
||||
(define (serialize-fish-abbreviations field-name val)
|
||||
#~(string-append
|
||||
#$@(map (match-lambda
|
||||
((key . value)
|
||||
#~(string-append "abbr --add " #$key " " #$value "\n"))
|
||||
(_ ""))
|
||||
val)))
|
||||
|
||||
(define (serialize-fish-env-vars field-name val)
|
||||
#~(string-append
|
||||
#$@(map (match-lambda
|
||||
((key . #f)
|
||||
"")
|
||||
((key . #t)
|
||||
#~(string-append "set " #$key "\n"))
|
||||
((key . value)
|
||||
#~(string-append "set " #$key " " #$value "\n")))
|
||||
val)))
|
||||
|
||||
(define-configuration home-fish-configuration
|
||||
(package
|
||||
(package fish)
|
||||
"The Fish package to use.")
|
||||
(config
|
||||
(text-config '())
|
||||
"List of strings or gexps, which will be added to
|
||||
@file{$XDG_CONFIG_HOME/fish/config.fish}.")
|
||||
(environment-variables
|
||||
(alist '())
|
||||
"Association list of environment variables to set in Fish."
|
||||
serialize-fish-env-vars)
|
||||
(aliases
|
||||
(alist '())
|
||||
"Association list of aliases for Fish, both the key and the value
|
||||
should be a string. An alias is just a simple function that wraps a
|
||||
command, If you want something more akin to @dfn{aliases} in POSIX
|
||||
shells, see the @code{abbreviations} field."
|
||||
serialize-fish-aliases)
|
||||
(abbreviations
|
||||
(alist '())
|
||||
"Association list of abbreviations for Fish. These are words that,
|
||||
when typed in the shell, will automatically expand to the full text."
|
||||
serialize-fish-abbreviations))
|
||||
|
||||
(define (fish-files-service config)
|
||||
`(("config/fish/config.fish"
|
||||
,(mixed-text-file
|
||||
"fish-config.fish"
|
||||
#~(string-append "\
|
||||
# if we haven't sourced the login config, do it
|
||||
status --is-login; and not set -q __fish_login_config_sourced
|
||||
and begin
|
||||
|
||||
set --prepend fish_function_path "
|
||||
#$fish-foreign-env
|
||||
"/share/fish/functions
|
||||
fenv source $HOME/.profile
|
||||
set -e fish_function_path[1]
|
||||
|
||||
set -g __fish_login_config_sourced 1
|
||||
|
||||
end\n\n")
|
||||
(serialize-configuration
|
||||
config
|
||||
home-fish-configuration-fields)))))
|
||||
|
||||
(define (fish-profile-service config)
|
||||
(list (home-fish-configuration-package config)))
|
||||
|
||||
(define-configuration/no-serialization home-fish-extension
|
||||
(config
|
||||
(text-config '())
|
||||
"List of strings or gexps for extending the Fish initialization file.")
|
||||
(environment-variables
|
||||
(alist '())
|
||||
"Association list of environment variables to set.")
|
||||
(aliases
|
||||
(alist '())
|
||||
"Association list of Fish aliases.")
|
||||
(abbreviations
|
||||
(alist '())
|
||||
"Association list of Fish abbreviations."))
|
||||
|
||||
(define (home-fish-extensions original-config extension-configs)
|
||||
(home-fish-configuration
|
||||
(inherit original-config)
|
||||
(config
|
||||
(append (home-fish-configuration-config original-config)
|
||||
(append-map
|
||||
home-fish-extension-config extension-configs)))
|
||||
(environment-variables
|
||||
(append (home-fish-configuration-environment-variables original-config)
|
||||
(append-map
|
||||
home-fish-extension-environment-variables extension-configs)))
|
||||
(aliases
|
||||
(append (home-fish-configuration-aliases original-config)
|
||||
(append-map
|
||||
home-fish-extension-aliases extension-configs)))
|
||||
(abbreviations
|
||||
(append (home-fish-configuration-abbreviations original-config)
|
||||
(append-map
|
||||
home-fish-extension-abbreviations extension-configs)))))
|
||||
|
||||
;; TODO: Support for generating completion files
|
||||
;; TODO: Support for installing plugins
|
||||
(define home-fish-service-type
|
||||
(service-type (name 'home-fish)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
home-files-service-type
|
||||
fish-files-service)
|
||||
(service-extension
|
||||
home-profile-service-type
|
||||
fish-profile-service)))
|
||||
(compose identity)
|
||||
(extend home-fish-extensions)
|
||||
(default-value (home-fish-configuration))
|
||||
(description "\
|
||||
Install and configure Fish, the friendly interactive shell.")))
|
||||
|
||||
|
||||
(define (generate-home-shell-profile-documentation)
|
||||
(generate-documentation
|
||||
`((home-shell-profile-configuration
|
||||
,home-shell-profile-configuration-fields))
|
||||
'home-shell-profile-configuration))
|
||||
|
||||
(define (generate-home-bash-documentation)
|
||||
(generate-documentation
|
||||
`((home-bash-configuration
|
||||
,home-bash-configuration-fields))
|
||||
'home-bash-configuration))
|
||||
|
||||
(define (generate-home-zsh-documentation)
|
||||
(generate-documentation
|
||||
`((home-zsh-configuration
|
||||
,home-zsh-configuration-fields))
|
||||
'home-zsh-configuration))
|
||||
|
||||
(define (generate-home-fish-documentation)
|
||||
(string-append
|
||||
(generate-documentation
|
||||
`((home-fish-configuration
|
||||
,home-fish-configuration-fields))
|
||||
'home-fish-configuration)
|
||||
"\n\n"
|
||||
(generate-documentation
|
||||
`((home-fish-extension
|
||||
,home-fish-extension-fields))
|
||||
'home-fish-extension)))
|
||||
|
|
@ -0,0 +1,134 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
||||
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU 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.
|
||||
;;;
|
||||
;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu home-services shepherd)
|
||||
#:use-module (gnu home-services)
|
||||
#:use-module (gnu packages admin)
|
||||
#:use-module (gnu services shepherd)
|
||||
#:use-module (guix sets)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix records)
|
||||
|
||||
#:use-module (srfi srfi-1)
|
||||
|
||||
#:export (home-shepherd-service-type
|
||||
home-shepherd-configuration)
|
||||
#:re-export (shepherd-service
|
||||
shepherd-action))
|
||||
|
||||
(define-record-type* <home-shepherd-configuration>
|
||||
home-shepherd-configuration make-home-shepherd-configuration
|
||||
home-shepherd-configuration?
|
||||
(shepherd home-shepherd-configuration-shepherd
|
||||
(default shepherd)) ; package
|
||||
(auto-start? home-shepherd-configuration-auto-start?
|
||||
(default #t))
|
||||
(services home-shepherd-configuration-services
|
||||
(default '())))
|
||||
|
||||
(define (home-shepherd-configuration-file services shepherd)
|
||||
"Return the shepherd configuration file for SERVICES. SHEPHERD is used
|
||||
as shepherd package."
|
||||
(assert-valid-graph services)
|
||||
|
||||
(let ((files (map shepherd-service-file services))
|
||||
;; TODO: Add compilation of services, it can improve start
|
||||
;; time.
|
||||
;; (scm->go (cute scm->go <> shepherd))
|
||||
)
|
||||
(define config
|
||||
#~(begin
|
||||
(use-modules (srfi srfi-34)
|
||||
(system repl error-handling))
|
||||
(apply
|
||||
register-services
|
||||
(map
|
||||
(lambda (file) (load file))
|
||||
'#$files))
|
||||
(action 'root 'daemonize)
|
||||
(format #t "Starting services...~%")
|
||||
(for-each
|
||||
(lambda (service) (start service))
|
||||
'#$(append-map shepherd-service-provision
|
||||
(filter shepherd-service-auto-start?
|
||||
services)))
|
||||
(newline)))
|
||||
|
||||
(scheme-file "shepherd.conf" config)))
|
||||
|
||||
(define (launch-shepherd-gexp config)
|
||||
(let* ((shepherd (home-shepherd-configuration-shepherd config))
|
||||
(services (home-shepherd-configuration-services config)))
|
||||
(if (home-shepherd-configuration-auto-start? config)
|
||||
(with-imported-modules '((guix build utils))
|
||||
#~(let ((log-dir (or (getenv "XDG_LOG_HOME")
|
||||
(format #f "~a/.local/var/log" (getenv "HOME")))))
|
||||
((@ (guix build utils) mkdir-p) log-dir)
|
||||
(system*
|
||||
#$(file-append shepherd "/bin/shepherd")
|
||||
"--logfile"
|
||||
(string-append
|
||||
log-dir
|
||||
"/shepherd.log")
|
||||
"--config"
|
||||
#$(home-shepherd-configuration-file services shepherd))))
|
||||
#~"")))
|
||||
|
||||
(define (reload-configuration-gexp config)
|
||||
(let* ((shepherd (home-shepherd-configuration-shepherd config))
|
||||
(services (home-shepherd-configuration-services config)))
|
||||
#~(system*
|
||||
#$(file-append shepherd "/bin/herd")
|
||||
"load" "root"
|
||||
#$(home-shepherd-configuration-file services shepherd))))
|
||||
|
||||
(define (ensure-shepherd-gexp config)
|
||||
#~(if (file-exists?
|
||||
(string-append
|
||||
(or (getenv "XDG_RUNTIME_DIR")
|
||||
(format #f "/run/user/~a" (getuid)))
|
||||
"/shepherd/socket"))
|
||||
#$(reload-configuration-gexp config)
|
||||
#$(launch-shepherd-gexp config)))
|
||||
|
||||
(define-public home-shepherd-service-type
|
||||
(service-type (name 'home-shepherd)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
home-run-on-first-login-service-type
|
||||
launch-shepherd-gexp)
|
||||
(service-extension
|
||||
home-activation-service-type
|
||||
ensure-shepherd-gexp)
|
||||
(service-extension
|
||||
home-profile-service-type
|
||||
(lambda (config)
|
||||
`(,(home-shepherd-configuration-shepherd config))))))
|
||||
(compose concatenate)
|
||||
(extend
|
||||
(lambda (config extra-services)
|
||||
(home-shepherd-configuration
|
||||
(inherit config)
|
||||
(services
|
||||
(append (home-shepherd-configuration-services config)
|
||||
extra-services)))))
|
||||
(default-value (home-shepherd-configuration))
|
||||
(description "Configure and install userland Shepherd.")))
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,247 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
||||
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU 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.
|
||||
;;;
|
||||
;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu home-services symlink-manager)
|
||||
#:use-module (gnu home-services)
|
||||
#:use-module (guix gexp)
|
||||
|
||||
#:export (home-symlink-manager-service-type))
|
||||
|
||||
;;; Comment:
|
||||
;;;
|
||||
;;; symlink-manager cares about configuration files: it backs up files
|
||||
;;; created by user, removes symlinks and directories created by a
|
||||
;;; previous generation, and creates new directories and symlinks to
|
||||
;;; configuration files according to the content of files/ directory
|
||||
;;; (created by home-files-service) of the current home environment
|
||||
;;; generation.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define (update-symlinks-script)
|
||||
(program-file
|
||||
"update-symlinks"
|
||||
#~(begin
|
||||
(use-modules (ice-9 ftw)
|
||||
(ice-9 curried-definitions)
|
||||
(ice-9 match)
|
||||
(srfi srfi-1))
|
||||
(define ((simplify-file-tree parent) file)
|
||||
"Convert the result produced by `file-system-tree' to less
|
||||
verbose and more suitable for further processing format.
|
||||
|
||||
Extract dir/file info from stat and compose a relative path to the
|
||||
root of the file tree.
|
||||
|
||||
Sample output:
|
||||
|
||||
((dir . \".\")
|
||||
((dir . \"config\")
|
||||
((dir . \"config/fontconfig\")
|
||||
(file . \"config/fontconfig/fonts.conf\"))
|
||||
((dir . \"config/isync\")
|
||||
(file . \"config/isync/mbsyncrc\"))))
|
||||
"
|
||||
(match file
|
||||
((name stat) `(file . ,(string-append parent name)))
|
||||
((name stat children ...)
|
||||
(cons `(dir . ,(string-append parent name))
|
||||
(map (simplify-file-tree
|
||||
(if (equal? name ".")
|
||||
""
|
||||
(string-append parent name "/")))
|
||||
children)))))
|
||||
|
||||
(define ((file-tree-traverse preordering) node)
|
||||
"Traverses the file tree in different orders, depending on PREORDERING.
|
||||
|
||||
if PREORDERING is @code{#t} resulting list will contain directories
|
||||
before files located in those directories, otherwise directory will
|
||||
appear only after all nested items already listed."
|
||||
(let ((prepend (lambda (a b) (append b a))))
|
||||
(match node
|
||||
(('file . path) (list node))
|
||||
((('dir . path) . rest)
|
||||
((if preordering append prepend)
|
||||
(list (cons 'dir path))
|
||||
(append-map (file-tree-traverse preordering) rest))))))
|
||||
|
||||
(use-modules (guix build utils))
|
||||
|
||||
(let* ((config-home (or (getenv "XDG_CONFIG_HOME")
|
||||
(string-append (getenv "HOME") "/.config")))
|
||||
|
||||
(he-path (string-append (getenv "HOME") "/.guix-home"))
|
||||
(new-he-path (string-append he-path ".new"))
|
||||
(new-home (getenv "GUIX_NEW_HOME"))
|
||||
(old-home (getenv "GUIX_OLD_HOME"))
|
||||
|
||||
(new-files-path (string-append new-home "/files"))
|
||||
;; Trailing dot is required, because files itself is symlink and
|
||||
;; to make file-system-tree works it should be a directory.
|
||||
(new-files-dir-path (string-append new-files-path "/."))
|
||||
|
||||
(home-path (getenv "HOME"))
|
||||
(backup-dir (string-append home-path "/"
|
||||
(number->string (current-time))
|
||||
"-guix-home-legacy-configs-backup"))
|
||||
|
||||
(old-tree (if old-home
|
||||
((simplify-file-tree "")
|
||||
(file-system-tree
|
||||
(string-append old-home "/files/.")))
|
||||
#f))
|
||||
(new-tree ((simplify-file-tree "")
|
||||
(file-system-tree new-files-dir-path)))
|
||||
|
||||
(get-source-path
|
||||
(lambda (path)
|
||||
(readlink (string-append new-files-path "/" path))))
|
||||
|
||||
(get-target-path
|
||||
(lambda (path)
|
||||
(string-append home-path "/." path)))
|
||||
|
||||
(get-backup-path
|
||||
(lambda (path)
|
||||
(string-append backup-dir "/." path)))
|
||||
|
||||
(directory?
|
||||
(lambda (path)
|
||||
(equal? (stat:type (stat path)) 'directory)))
|
||||
|
||||
(empty-directory?
|
||||
(lambda (dir)
|
||||
(equal? (scandir dir) '("." ".."))))
|
||||
|
||||
(symlink-to-store?
|
||||
(lambda (path)
|
||||
(and
|
||||
(equal? (stat:type (lstat path)) 'symlink)
|
||||
(store-file-name? (readlink path)))))
|
||||
|
||||
(backup-file
|
||||
(lambda (path)
|
||||
(mkdir-p backup-dir)
|
||||
(format #t "Backing up ~a..." (get-target-path path))
|
||||
(mkdir-p (dirname (get-backup-path path)))
|
||||
(rename-file (get-target-path path) (get-backup-path path))
|
||||
(display " done\n")))
|
||||
|
||||
(cleanup-symlinks
|
||||
(lambda ()
|
||||
(let ((to-delete ((file-tree-traverse #f) old-tree)))
|
||||
(display
|
||||
"Cleaning up symlinks from previous home-environment.\n\n")
|
||||
(map
|
||||
(match-lambda
|
||||
(('dir . ".")
|
||||
(display "Cleanup finished.\n\n"))
|
||||
|
||||
(('dir . path)
|
||||
(if (and
|
||||
(file-exists? (get-target-path path))
|
||||
(directory? (get-target-path path))
|
||||
(empty-directory? (get-target-path path)))
|
||||
(begin
|
||||
(format #t "Removing ~a..."
|
||||
(get-target-path path))
|
||||
(rmdir (get-target-path path))
|
||||
(display " done\n"))
|
||||
(format
|
||||
#t "Skipping ~a (not an empty directory)... done\n"
|
||||
(get-target-path path))))
|
||||
|
||||
(('file . path)
|
||||
(when (file-exists? (get-target-path path))
|
||||
;; DO NOT remove the file if it is no longer
|
||||
;; a symlink to the store, it will be backed
|
||||
;; up later during create-symlinks phase.
|
||||
(if (symlink-to-store? (get-target-path path))
|
||||
(begin
|
||||
(format #t "Removing ~a..." (get-target-path path))
|
||||
(delete-file (get-target-path path))
|
||||
(display " done\n"))
|
||||
(format
|
||||
#t
|
||||
"Skipping ~a (not a symlink to store)... done\n"
|
||||
(get-target-path path))))))
|
||||
to-delete))))
|
||||
|
||||
(create-symlinks
|
||||
(lambda ()
|
||||
(let ((to-create ((file-tree-traverse #t) new-tree)))
|
||||
(map
|
||||
(match-lambda
|
||||
(('dir . ".")
|
||||
(display
|
||||
"New symlinks to home-environment will be created soon.\n")
|
||||
(format
|
||||
#t "All conflicting files will go to ~a.\n\n" backup-dir))
|
||||
|
||||
(('dir . path)
|
||||
(let ((target-path (get-target-path path)))
|
||||
(when (and (file-exists? target-path)
|
||||
(not (directory? target-path)))
|
||||
(backup-file path))
|
||||
|
||||
(if (file-exists? target-path)
|
||||
(format
|
||||
#t "Skipping ~a (directory already exists)... done\n"
|
||||
target-path)
|
||||
(begin
|
||||
(format #t "Creating ~a..." target-path)
|
||||
(mkdir target-path)
|
||||
(display " done\n")))))
|
||||
|
||||
(('file . path)
|
||||
(when (file-exists? (get-target-path path))
|
||||
(backup-file path))
|
||||
(format #t "Symlinking ~a -> ~a..."
|
||||
(get-target-path path) (get-source-path path))
|
||||
(symlink (get-source-path path) (get-target-path path))
|
||||
(display " done\n")))
|
||||
to-create)))))
|
||||
|
||||
(when old-tree
|
||||
(cleanup-symlinks))
|
||||
|
||||
(create-symlinks)
|
||||
|
||||
(symlink new-home new-he-path)
|
||||
(rename-file new-he-path he-path)
|
||||
|
||||
(display " done\nFinished updating symlinks.\n\n")))))
|
||||
|
||||
|
||||
(define (update-symlinks-gexp _)
|
||||
#~(primitive-load #$(update-symlinks-script)))
|
||||
|
||||
(define home-symlink-manager-service-type
|
||||
(service-type (name 'home-symlink-manager)
|
||||
(extensions
|
||||
(list
|
||||
(service-extension
|
||||
home-activation-service-type
|
||||
update-symlinks-gexp)))
|
||||
(default-value #f)
|
||||
(description "Provide an @code{update-symlinks}
|
||||
script, which creates symlinks to configuration files and directories
|
||||
on every activation. If an existing file would be overwritten by a
|
||||
symlink, backs up that file first.")))
|
||||
|
|
@ -0,0 +1,77 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU 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.
|
||||
;;;
|
||||
;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu home-services utils)
|
||||
#:use-module (ice-9 string-fun)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
|
||||
#:export (maybe-object->string
|
||||
object->snake-case-string
|
||||
object->camel-case-string))
|
||||
|
||||
(define (maybe-object->string object)
|
||||
"Like @code{object->string} but don't do anyting if OBJECT already is
|
||||
a string."
|
||||
(if (string? object)
|
||||
object
|
||||
(object->string object)))
|
||||
|
||||
;; Snake case: <https://en.wikipedia.org/wiki/Snake_case>
|
||||
(define* (object->snake-case-string object #:optional (style 'lower))
|
||||
"Convert the object OBJECT to the equivalent string in ``snake
|
||||
case''. STYLE can be three `@code{lower}', `@code{upper}', or
|
||||
`@code{capitalize}', defaults to `@code{lower}'.
|
||||
|
||||
@example
|
||||
(object->snake-case-string 'variable-name 'upper)
|
||||
@result{} \"VARIABLE_NAME\" @end example"
|
||||
(if (not (member style '(lower upper capitalize)))
|
||||
(error 'invalid-style (format #f "~a is not a valid style" style))
|
||||
(let ((stringified (maybe-object->string object)))
|
||||
(string-replace-substring
|
||||
(cond
|
||||
((equal? style 'lower) stringified)
|
||||
((equal? style 'upper) (string-upcase stringified))
|
||||
(else (string-capitalize stringified)))
|
||||
"-" "_"))))
|
||||
|
||||
(define* (object->camel-case-string object #:optional (style 'lower))
|
||||
"Convert the object OBJECT to the equivalent string in ``camel case''.
|
||||
STYLE can be three `@code{lower}', `@code{upper}', defaults to
|
||||
`@code{lower}'.
|
||||
|
||||
@example
|
||||
(object->camel-case-string 'variable-name 'upper)
|
||||
@result{} \"VariableName\"
|
||||
@end example"
|
||||
(if (not (member style '(lower upper)))
|
||||
(error 'invalid-style (format #f "~a is not a valid style" style))
|
||||
(let ((stringified (maybe-object->string object)))
|
||||
(cond
|
||||
((eq? style 'upper)
|
||||
(string-concatenate
|
||||
(map string-capitalize
|
||||
(string-split stringified (cut eqv? <> #\-)))))
|
||||
((eq? style 'lower)
|
||||
(let ((splitted-string (string-split stringified (cut eqv? <> #\-))))
|
||||
(string-concatenate
|
||||
(cons (first splitted-string)
|
||||
(map string-capitalize
|
||||
(cdr splitted-string))))))))))
|
||||
|
|
@ -0,0 +1,476 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
||||
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU 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.
|
||||
;;;
|
||||
;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu home-services xdg)
|
||||
#:use-module (gnu services configuration)
|
||||
#:use-module (gnu home-services configuration)
|
||||
#:use-module (gnu home-services)
|
||||
#:use-module (gnu packages freedesktop)
|
||||
#:use-module (gnu home-services utils)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix records)
|
||||
#:use-module (guix i18n)
|
||||
#:use-module (guix diagnostics)
|
||||
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (rnrs enums)
|
||||
|
||||
#:export (home-xdg-base-directories-service-type
|
||||
home-xdg-base-directories-configuration
|
||||
home-xdg-base-directories-configuration?
|
||||
|
||||
home-xdg-user-directories-service-type
|
||||
home-xdg-user-directories-configuration
|
||||
home-xdg-user-directories-configuration?
|
||||
|
||||
xdg-desktop-action
|
||||
xdg-desktop-entry
|
||||
home-xdg-mime-applications-service-type
|
||||
home-xdg-mime-applications-configuration))
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This module contains services related to XDG directories and
|
||||
;; applications.
|
||||
;;
|
||||
;; - XDG base directories
|
||||
;; - XDG user directories
|
||||
;; - XDG MIME applications
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
|
||||
;;;
|
||||
;;; XDG base directories.
|
||||
;;;
|
||||
|
||||
(define (serialize-path field-name val) "")
|
||||
(define path? string?)
|
||||
|
||||
(define-configuration home-xdg-base-directories-configuration
|
||||
(cache-home
|
||||
(path "$HOME/.cache")
|
||||
"Base directory for programs to store user-specific non-essential
|
||||
(cached) data. Files in this directory can be deleted anytime without
|
||||
loss of important data.")
|
||||
(config-home
|
||||
(path "$HOME/.config")
|
||||
"Base directory for programs to store configuration files.
|
||||
Some programs store here log or state files, but it's not desired,
|
||||
this directory should contain static configurations.")
|
||||
(data-home
|
||||
(path "$HOME/.local/share")
|
||||
"Base directory for programs to store architecture independent
|
||||
read-only shared data, analogus to @file{/usr/share}, but for user.")
|
||||
(runtime-dir
|
||||
(path "${XDG_RUNTIME_DIR:-/run/user/$UID}")
|
||||
"Base directory for programs to store user-specific runtime files,
|
||||
like sockets.")
|
||||
(log-home
|
||||
(path "$HOME/.local/var/log")
|
||||
"Base directory for programs to store log files, analogus to
|
||||
@file{/var/log}, but for user. It is not a part of XDG Base Directory
|
||||
Specification, but helps to make implementation of home services more
|
||||
consistent.")
|
||||
(state-home
|
||||
(path "$HOME/.local/var/lib")
|
||||
"Base directory for programs to store state files, like databases,
|
||||
analogus to @file{/var/lib}, but for user. It is not a part of XDG
|
||||
Base Directory Specification, but helps to make implementation of home
|
||||
services more consistent."))
|
||||
|
||||
(define (home-xdg-base-directories-environment-variables-service config)
|
||||
(map
|
||||
(lambda (field)
|
||||
(cons (format
|
||||
#f "XDG_~a"
|
||||
(object->snake-case-string (configuration-field-name field) 'upper))
|
||||
((configuration-field-getter field) config)))
|
||||
home-xdg-base-directories-configuration-fields))
|
||||
|
||||
(define (ensure-xdg-base-dirs-on-activation config)
|
||||
#~(map (lambda (xdg-base-dir-variable)
|
||||
((@@ (guix build utils) mkdir-p)
|
||||
(getenv
|
||||
xdg-base-dir-variable)))
|
||||
'#$(map (lambda (field)
|
||||
(format
|
||||
#f "XDG_~a"
|
||||
(object->snake-case-string
|
||||
(configuration-field-name field) 'upper)))
|
||||
home-xdg-base-directories-configuration-fields)))
|
||||
|
||||
(define (last-extension-or-cfg config extensions)
|
||||
"Picks configuration value from last provided extension. If there
|
||||
are no extensions use configuration instead."
|
||||
(or (and (not (null? extensions)) (last extensions)) config))
|
||||
|
||||
(define home-xdg-base-directories-service-type
|
||||
(service-type (name 'home-xdg-base-directories)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
home-environment-variables-service-type
|
||||
home-xdg-base-directories-environment-variables-service)
|
||||
(service-extension
|
||||
home-activation-service-type
|
||||
ensure-xdg-base-dirs-on-activation)))
|
||||
(default-value (home-xdg-base-directories-configuration))
|
||||
(compose identity)
|
||||
(extend last-extension-or-cfg)
|
||||
(description "Configure XDG base directories. This
|
||||
service introduces two additional variables @env{XDG_STATE_HOME},
|
||||
@env{XDG_LOG_HOME}. They are not a part of XDG specification, at
|
||||
least yet, but are convinient to have, it improves the consistency
|
||||
between different home services. The services of this service-type is
|
||||
instantiated by default, to provide non-default value, extend the
|
||||
service-type (using @code{simple-service} for example).")))
|
||||
|
||||
(define (generate-home-xdg-base-directories-documentation)
|
||||
(generate-documentation
|
||||
`((home-xdg-base-directories-configuration
|
||||
,home-xdg-base-directories-configuration-fields))
|
||||
'home-xdg-base-directories-configuration))
|
||||
|
||||
|
||||
;;;
|
||||
;;; XDG user directories.
|
||||
;;;
|
||||
|
||||
(define (serialize-string field-name val)
|
||||
;; The path has to be quoted
|
||||
(format #f "XDG_~a_DIR=\"~a\"\n"
|
||||
(object->snake-case-string field-name 'upper) val))
|
||||
|
||||
(define-configuration home-xdg-user-directories-configuration
|
||||
(desktop
|
||||
(string "$HOME/Desktop")
|
||||
"Default ``desktop'' directory, this is what you see on your
|
||||
desktop when using a desktop environment,
|
||||
e.g. GNOME (@pxref{XWindow,,,guix.info}).")
|
||||
(documents
|
||||
(string "$HOME/Documents")
|
||||
"Default directory to put documents like PDFs.")
|
||||
(download
|
||||
(string "$HOME/Downloads")
|
||||
"Default directory downloaded files, this is where your Web-broser
|
||||
will put downloaded files in.")
|
||||
(music
|
||||
(string "$HOME/Music")
|
||||
"Default directory for audio files.")
|
||||
(pictures
|
||||
(string "$HOME/Pictures")
|
||||
"Default directory for pictures and images.")
|
||||
(publicshare
|
||||
(string "$HOME/Public")
|
||||
"Default directory for shared files, which can be accessed by other
|
||||
users on local machine or via network.")
|
||||
(templates
|
||||
(string "$HOME/Templates")
|
||||
"Default directory for templates. They can be used by graphical
|
||||
file manager or other apps for creating new files with some
|
||||
pre-populated content.")
|
||||
(videos
|
||||
(string "$HOME/Videos")
|
||||
"Default directory for videos."))
|
||||
|
||||
(define (home-xdg-user-directories-files-service config)
|
||||
`(("config/user-dirs.conf"
|
||||
,(mixed-text-file
|
||||
"user-dirs.conf"
|
||||
"enabled=False\n"))
|
||||
("config/user-dirs.dirs"
|
||||
,(mixed-text-file
|
||||
"user-dirs.dirs"
|
||||
(serialize-configuration
|
||||
config
|
||||
home-xdg-user-directories-configuration-fields)))))
|
||||
|
||||
(define (home-xdg-user-directories-activation-service config)
|
||||
(let ((dirs (map (lambda (field)
|
||||
((configuration-field-getter field) config))
|
||||
home-xdg-user-directories-configuration-fields)))
|
||||
#~(let ((ensure-dir
|
||||
(lambda (path)
|
||||
(mkdir-p
|
||||
((@@ (ice-9 string-fun) string-replace-substring)
|
||||
path "$HOME" (getenv "HOME"))))))
|
||||
(display "Creating XDG user directories...")
|
||||
(map ensure-dir '#$dirs)
|
||||
(display " done\n"))))
|
||||
|
||||
(define home-xdg-user-directories-service-type
|
||||
(service-type (name 'home-xdg-user-directories)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
home-files-service-type
|
||||
home-xdg-user-directories-files-service)
|
||||
(service-extension
|
||||
home-activation-service-type
|
||||
home-xdg-user-directories-activation-service)))
|
||||
(default-value (home-xdg-user-directories-configuration))
|
||||
(description "Configure XDG user directories. To
|
||||
disable a directory, point it to the $HOME.")))
|
||||
|
||||
(define (generate-home-xdg-user-directories-documentation)
|
||||
(generate-documentation
|
||||
`((home-xdg-user-directories-configuration
|
||||
,home-xdg-user-directories-configuration-fields))
|
||||
'home-xdg-user-directories-configuration))
|
||||
|
||||
|
||||
;;;
|
||||
;;; XDG MIME applications.
|
||||
;;;
|
||||
|
||||
;; Example config
|
||||
;;
|
||||
;; (home-xdg-mime-applications-configuration
|
||||
;; (added '((x-scheme-handler/magnet . torrent.desktop)))
|
||||
;; (default '((inode/directory . file.desktop)))
|
||||
;; (removed '((inode/directory . thunar.desktop)))
|
||||
;; (desktop-entries
|
||||
;; (list (xdg-desktop-entry
|
||||
;; (file "file")
|
||||
;; (name "File manager")
|
||||
;; (type 'application)
|
||||
;; (config
|
||||
;; '((exec . "emacsclient -c -a emacs %u"))))
|
||||
;; (xdg-desktop-entry
|
||||
;; (file "text")
|
||||
;; (name "Text editor")
|
||||
;; (type 'application)
|
||||
;; (config
|
||||
;; '((exec . "emacsclient -c -a emacs %u")))
|
||||
;; (actions
|
||||
;; (list (xdg-desktop-action
|
||||
;; (action 'create)
|
||||
;; (name "Create an action")
|
||||
;; (config
|
||||
;; '((exec . "echo hi"))))))))))
|
||||
|
||||
;; See
|
||||
;; <https://specifications.freedesktop.org/shared-mime-info-spec/shared-mime-info-spec-latest.html>
|
||||
;; <https://specifications.freedesktop.org/mime-apps-spec/mime-apps-spec-latest.html>
|
||||
|
||||
(define (serialize-alist field-name val)
|
||||
(define (serialize-mimelist-entry key val)
|
||||
(let ((val (cond
|
||||
((list? val)
|
||||
(string-join (map maybe-object->string val) ";"))
|
||||
((or (string? val) (symbol? val))
|
||||
val)
|
||||
(else (raise (formatted-message
|
||||
(G_ "\
|
||||
The value of an XDG MIME entry must be a list, string or symbol, was given ~a")
|
||||
val))))))
|
||||
(format #f "~a=~a\n" key val)))
|
||||
|
||||
(define (merge-duplicates alist acc)
|
||||
"Merge values that have the same key.
|
||||
|
||||
@example
|
||||
(merge-duplicates '((key1 . value1)
|
||||
(key2 . value2)
|
||||
(key1 . value3)
|
||||
(key1 . value4)) '())
|
||||
|
||||
@result{} ((key1 . (value4 value3 value1)) (key2 . value2))
|
||||
@end example"
|
||||
(cond
|
||||
((null? alist) acc)
|
||||
(else (let* ((head (first alist))
|
||||
(tail (cdr alist))
|
||||
(key (first head))
|
||||
(value (cdr head))
|
||||
(duplicate? (assoc key acc)))
|
||||
(if duplicate?
|
||||
;; XXX: This will change the order of things,
|
||||
;; though, it shouldn't be a problem for XDG MIME.
|
||||
(merge-duplicates
|
||||
tail
|
||||
(alist-cons key
|
||||
(cons value (maybe-list (cdr duplicate?)))
|
||||
(alist-delete key acc)))
|
||||
(merge-duplicates tail (cons head acc)))))))
|
||||
|
||||
(string-append (if (equal? field-name 'default)
|
||||
"\n[Default Applications]\n"
|
||||
(format #f "\n[~a Associations]\n"
|
||||
(string-capitalize (symbol->string field-name))))
|
||||
(generic-serialize-alist string-append
|
||||
serialize-mimelist-entry
|
||||
(merge-duplicates val '()))))
|
||||
|
||||
(define xdg-desktop-types (make-enumeration
|
||||
'(application
|
||||
link
|
||||
directory)))
|
||||
|
||||
(define (xdg-desktop-type? type)
|
||||
(unless (enum-set-member? type xdg-desktop-types)
|
||||
(raise (formatted-message
|
||||
(G_ "XDG desktop type must be of of ~a, was given: ~a")
|
||||
(list->human-readable-list (enum-set->list xdg-desktop-types))
|
||||
type))))
|
||||
|
||||
;; TODO: Add proper docs for this
|
||||
;; XXX: 'define-configuration' require that fields have a default
|
||||
;; value.
|
||||
(define-record-type* <xdg-desktop-action>
|
||||
xdg-desktop-action make-xdg-desktop-action
|
||||
xdg-desktop-action?
|
||||
(action xdg-desktop-action-action) ; symbol
|
||||
(name xdg-desktop-action-name) ; string
|
||||
(config xdg-desktop-action-config ; alist
|
||||
(default '())))
|
||||
|
||||
(define-record-type* <xdg-desktop-entry>
|
||||
xdg-desktop-entry make-xdg-desktop-entry
|
||||
xdg-desktop-entry?
|
||||
;; ".desktop" will automatically be added
|
||||
(file xdg-desktop-entry-file) ; string
|
||||
(name xdg-desktop-entry-name) ; string
|
||||
(type xdg-desktop-entry-type) ; xdg-desktop-type
|
||||
(config xdg-desktop-entry-config ; alist
|
||||
(default '()))
|
||||
(actions xdg-desktop-entry-actions ; list of <xdg-desktop-action>
|
||||
(default '())))
|
||||
|
||||
(define desktop-entries? (list-of xdg-desktop-entry?))
|
||||
(define (serialize-desktop-entries field-name val) "")
|
||||
|
||||
(define (serialize-xdg-desktop-entry entry)
|
||||
"Return a tuple of the file name for ENTRY and the serialized
|
||||
configuration."
|
||||
(define (format-config key val)
|
||||
(let ((val (cond
|
||||
((list? val)
|
||||
(string-join (map maybe-object->string val) ";"))
|
||||
((boolean? val)
|
||||
(if val "true" "false"))
|
||||
(else val)))
|
||||
(key (string-capitalize (maybe-object->string key))))
|
||||
(list (if (string-suffix? key "?")
|
||||
(string-drop-right key (- (string-length key) 1))
|
||||
key)
|
||||
"=" val "\n")))
|
||||
|
||||
(define (serialize-alist config)
|
||||
(generic-serialize-alist identity format-config config))
|
||||
|
||||
(define (serialize-xdg-desktop-action action)
|
||||
(match action
|
||||
(($ <xdg-desktop-action> action name config)
|
||||
`(,(format #f "[Desktop Action ~a]\n"
|
||||
(string-capitalize (maybe-object->string action)))
|
||||
,(format #f "Name=~a\n" name)
|
||||
,@(serialize-alist config)))))
|
||||
|
||||
(match entry
|
||||
(($ <xdg-desktop-entry> file name type config actions)
|
||||
(list (if (string-suffix? file ".desktop")
|
||||
file
|
||||
(string-append file ".desktop"))
|
||||
`("[Desktop Entry]\n"
|
||||
,(format #f "Name=~a\n" name)
|
||||
,(format #f "Type=~a\n"
|
||||
(string-capitalize (symbol->string type)))
|
||||
,@(serialize-alist config)
|
||||
,@(append-map serialize-xdg-desktop-action actions))))))
|
||||
|
||||
(define-configuration home-xdg-mime-applications-configuration
|
||||
(added
|
||||
(alist '())
|
||||
"An association list of MIME types and desktop entries which indicate
|
||||
that the application should used to open the specified MIME type. The
|
||||
value has to be string, symbol, or list of strings or symbols, this
|
||||
applies to the `@code{default}', and `@code{removed}' fields as well.")
|
||||
(default
|
||||
(alist '())
|
||||
"An association list of MIME types and desktop entries which indicate
|
||||
that the application should be the default for opening the specified
|
||||
MIME type.")
|
||||
(removed
|
||||
(alist '())
|
||||
"An association list of MIME types and desktop entries which indicate
|
||||
that the application cannot open the specified MIME type.")
|
||||
(desktop-entries
|
||||
(desktop-entries '())
|
||||
"A list of XDG desktop entries to create. See
|
||||
@code{xdg-desktop-entry}."))
|
||||
|
||||
(define (home-xdg-mime-applications-files-service config)
|
||||
(define (add-xdg-desktop-entry-file entry)
|
||||
(let ((file (first entry))
|
||||
(config (second entry)))
|
||||
(list (format #f "local/share/applications/~a" file)
|
||||
(apply mixed-text-file
|
||||
(format #f "xdg-desktop-~a-entry" file)
|
||||
config))))
|
||||
|
||||
(append
|
||||
`(("config/mimeapps.list"
|
||||
,(mixed-text-file
|
||||
"xdg-mime-appplications"
|
||||
(serialize-configuration
|
||||
config
|
||||
home-xdg-mime-applications-configuration-fields))))
|
||||
(map (compose add-xdg-desktop-entry-file serialize-xdg-desktop-entry)
|
||||
(home-xdg-mime-applications-configuration-desktop-entries config))))
|
||||
|
||||
(define (home-xdg-mime-applications-extension old-config extension-configs)
|
||||
(define (extract-fields config)
|
||||
;; return '(added default removed desktop-entries)
|
||||
(list (home-xdg-mime-applications-configuration-added config)
|
||||
(home-xdg-mime-applications-configuration-default config)
|
||||
(home-xdg-mime-applications-configuration-removed config)
|
||||
(home-xdg-mime-applications-configuration-desktop-entries config)))
|
||||
|
||||
(define (append-configs elem acc)
|
||||
(list (append (first elem) (first acc))
|
||||
(append (second elem) (second acc))
|
||||
(append (third elem) (third acc))
|
||||
(append (fourth elem) (fourth acc))))
|
||||
|
||||
;; TODO: Implement procedure to check for duplicates without
|
||||
;; sacrificing performance.
|
||||
;;
|
||||
;; Combine all the alists from 'added', 'default' and 'removed'
|
||||
;; into one big alist.
|
||||
(let ((folded-configs (fold append-configs
|
||||
(extract-fields old-config)
|
||||
(map extract-fields extension-configs))))
|
||||
(home-xdg-mime-applications-configuration
|
||||
(added (first folded-configs))
|
||||
(default (second folded-configs))
|
||||
(removed (third folded-configs))
|
||||
(desktop-entries (fourth folded-configs)))))
|
||||
|
||||
(define home-xdg-mime-applications-service-type
|
||||
(service-type (name 'home-xdg-mime-applications)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
home-files-service-type
|
||||
home-xdg-mime-applications-files-service)))
|
||||
(compose identity)
|
||||
(extend home-xdg-mime-applications-extension)
|
||||
(default-value (home-xdg-mime-applications-configuration))
|
||||
(description
|
||||
"Configure XDG MIME applications, and XDG desktop entries.")))
|
||||
|
|
@ -0,0 +1,106 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU 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.
|
||||
;;;
|
||||
;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu home)
|
||||
#:use-module (gnu home-services)
|
||||
#:use-module (gnu home-services symlink-manager)
|
||||
#:use-module (gnu home-services shells)
|
||||
#:use-module (gnu home-services xdg)
|
||||
#:use-module (gnu home-services fontutils)
|
||||
#:use-module (gnu services)
|
||||
#:use-module (guix records)
|
||||
#:use-module (guix diagnostics)
|
||||
|
||||
#:export (home-environment
|
||||
home-environment?
|
||||
this-home-environment
|
||||
|
||||
home-environment-derivation
|
||||
home-environment-user-services
|
||||
home-environment-essential-services
|
||||
home-environment-services
|
||||
home-environment-location
|
||||
|
||||
home-environment-with-provenance))
|
||||
|
||||
;;; Comment:
|
||||
;;;
|
||||
;;; This module provides a <home-environment> record for managing
|
||||
;;; per-user packages and configuration files in the similar way as
|
||||
;;; <operating-system> do for system packages and configuration files.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define-record-type* <home-environment> home-environment
|
||||
make-home-environment
|
||||
home-environment?
|
||||
this-home-environment
|
||||
|
||||
(packages home-environment-packages ; list of (PACKAGE OUTPUT...)
|
||||
(default '()))
|
||||
|
||||
(essential-services home-environment-essential-services ; list of services
|
||||
(thunked)
|
||||
(default (home-environment-default-essential-services
|
||||
this-home-environment)))
|
||||
|
||||
(services home-environment-user-services
|
||||
(default '()))
|
||||
|
||||
(location home-environment-location ; <location>
|
||||
(default (and=> (current-source-location)
|
||||
source-properties->location))
|
||||
(innate)))
|
||||
|
||||
(define (home-environment-default-essential-services he)
|
||||
"Return the list of essential services for home environment."
|
||||
(list
|
||||
(service home-run-on-first-login-service-type)
|
||||
(service home-activation-service-type)
|
||||
(service home-environment-variables-service-type)
|
||||
|
||||
(service home-symlink-manager-service-type)
|
||||
|
||||
(service home-fontconfig-service-type)
|
||||
(service home-xdg-base-directories-service-type)
|
||||
(service home-shell-profile-service-type)
|
||||
|
||||
(service home-service-type)
|
||||
(service home-profile-service-type (home-environment-packages he))))
|
||||
|
||||
(define* (home-environment-services he)
|
||||
"Return all the services of home environment."
|
||||
(instantiate-missing-services
|
||||
(append (home-environment-user-services he)
|
||||
(home-environment-essential-services he))))
|
||||
|
||||
(define* (home-environment-derivation he)
|
||||
"Return a derivation that builds OS."
|
||||
(let* ((services (home-environment-services he))
|
||||
(home (fold-services services
|
||||
#:target-type home-service-type)))
|
||||
(service-value home)))
|
||||
|
||||
(define* (home-environment-with-provenance he config-file)
|
||||
"Return a variant of HE that stores its own provenance information,
|
||||
including CONFIG-FILE, if available. This is achieved by adding an instance
|
||||
of HOME-PROVENANCE-SERVICE-TYPE to its services."
|
||||
(home-environment
|
||||
(inherit he)
|
||||
(services (cons (service home-provenance-service-type config-file)
|
||||
(home-environment-user-services he)))))
|
||||
11
gnu/local.mk
11
gnu/local.mk
|
|
@ -44,6 +44,7 @@
|
|||
# Copyright © 2021 Arun Isaac <arunisaac@systemreboot.net>
|
||||
# Copyright © 2021 Sharlatan Hellseher <sharlatanus@gmail.com>
|
||||
# Copyright © 2021 Dmitry Polyakov <polyakov@liltechdude.xyz>
|
||||
# Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
||||
#
|
||||
# This file is part of GNU Guix.
|
||||
#
|
||||
|
|
@ -72,6 +73,16 @@ GNU_SYSTEM_MODULES = \
|
|||
%D%/bootloader/u-boot.scm \
|
||||
%D%/bootloader/depthcharge.scm \
|
||||
%D%/ci.scm \
|
||||
%D%/home.scm \
|
||||
%D%/home-services.scm \
|
||||
%D%/home-services/symlink-manager.scm \
|
||||
%D%/home-services/fontutils.scm \
|
||||
%D%/home-services/configuration.scm \
|
||||
%D%/home-services/shells.scm \
|
||||
%D%/home-services/shepherd.scm \
|
||||
%D%/home-services/mcron.scm \
|
||||
%D%/home-services/utils.scm \
|
||||
%D%/home-services/xdg.scm \
|
||||
%D%/image.scm \
|
||||
%D%/packages.scm \
|
||||
%D%/packages/abduco.scm \
|
||||
|
|
|
|||
|
|
@ -0,0 +1,512 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
||||
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU 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.
|
||||
;;;
|
||||
;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (guix scripts home)
|
||||
#:use-module (gnu packages admin)
|
||||
#:use-module ((gnu services) #:hide (delete))
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu home)
|
||||
#:use-module (gnu home-services)
|
||||
#:use-module (guix channels)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module (guix ui)
|
||||
#:use-module (guix grafts)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix profiles)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (guix scripts)
|
||||
#:use-module (guix scripts package)
|
||||
#:use-module (guix scripts build)
|
||||
#:use-module (guix scripts system search)
|
||||
#:autoload (guix scripts pull) (channel-commit-hyperlink)
|
||||
#:use-module (guix scripts home import)
|
||||
#:use-module ((guix status) #:select (with-status-verbosity))
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix monads)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-35)
|
||||
#:use-module (srfi srfi-37)
|
||||
#:use-module (ice-9 match)
|
||||
#:export (guix-home))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Options.
|
||||
;;;
|
||||
|
||||
(define %user-module
|
||||
(make-user-module '((gnu home))))
|
||||
|
||||
(define %guix-home
|
||||
(string-append %profile-directory "/guix-home"))
|
||||
|
||||
(define (show-help)
|
||||
(display (G_ "Usage: guix home [OPTION ...] ACTION [ARG ...] [FILE]
|
||||
Build the home environment declared in FILE according to ACTION.
|
||||
Some ACTIONS support additional ARGS.\n"))
|
||||
(newline)
|
||||
(display (G_ "The valid values for ACTION are:\n"))
|
||||
(newline)
|
||||
(display (G_ "\
|
||||
search search for existing service types\n"))
|
||||
(display (G_ "\
|
||||
reconfigure switch to a new home environment configuration\n"))
|
||||
(display (G_ "\
|
||||
roll-back switch to the previous home environment configuration\n"))
|
||||
(display (G_ "\
|
||||
describe describe the current home environment\n"))
|
||||
(display (G_ "\
|
||||
list-generations list the home environment generations\n"))
|
||||
(display (G_ "\
|
||||
switch-generation switch to an existing home environment configuration\n"))
|
||||
(display (G_ "\
|
||||
delete-generations delete old home environment generations\n"))
|
||||
(display (G_ "\
|
||||
build build the home environment without installing anything\n"))
|
||||
(display (G_ "\
|
||||
import generates a home environment definition from dotfiles\n"))
|
||||
|
||||
(show-build-options-help)
|
||||
(display (G_ "
|
||||
-v, --verbosity=LEVEL use the given verbosity LEVEL"))
|
||||
(newline)
|
||||
(display (G_ "
|
||||
-h, --help display this help and exit"))
|
||||
(display (G_ "
|
||||
-V, --version display version information and exit"))
|
||||
(newline)
|
||||
(show-bug-report-information))
|
||||
|
||||
(define (verbosity-level opts)
|
||||
"Return the verbosity level based on OPTS, the alist of parsed options."
|
||||
(or (assoc-ref opts 'verbosity)
|
||||
(if (eq? (assoc-ref opts 'action) 'build)
|
||||
2 1)))
|
||||
|
||||
(define %options
|
||||
;; Specification of the command-line options.
|
||||
(cons* (option '(#\h "help") #f #f
|
||||
(lambda args
|
||||
(show-help)
|
||||
(exit 0)))
|
||||
(option '(#\V "version") #f #f
|
||||
(lambda args
|
||||
(show-version-and-exit "guix show")))
|
||||
(option '(#\v "verbosity") #t #f
|
||||
(lambda (opt name arg result)
|
||||
(let ((level (string->number* arg)))
|
||||
(alist-cons 'verbosity level
|
||||
(alist-delete 'verbosity result)))))
|
||||
%standard-build-options))
|
||||
|
||||
(define %default-options
|
||||
`((build-mode . ,(build-mode normal))
|
||||
(graft? . #t)
|
||||
(substitutes? . #t)
|
||||
(offload? . #t)
|
||||
(print-build-trace? . #t)
|
||||
(print-extended-build-trace? . #t)
|
||||
(multiplexed-build-output? . #t)
|
||||
(verbosity . 3)
|
||||
(debug . 0)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Actions.
|
||||
;;;
|
||||
|
||||
(define* (perform-action action he
|
||||
#:key
|
||||
dry-run?
|
||||
derivations-only?
|
||||
use-substitutes?)
|
||||
"Perform ACTION for home environment. "
|
||||
|
||||
(define println
|
||||
(cut format #t "~a~%" <>))
|
||||
|
||||
(mlet* %store-monad
|
||||
((he-drv (home-environment-derivation he))
|
||||
(drvs (mapm/accumulate-builds lower-object (list he-drv)))
|
||||
(% (if derivations-only?
|
||||
(return
|
||||
(for-each (compose println derivation-file-name) drvs))
|
||||
(built-derivations drvs)))
|
||||
|
||||
(he-out-path -> (derivation->output-path he-drv)))
|
||||
(if (or dry-run? derivations-only?)
|
||||
(return #f)
|
||||
(begin
|
||||
(for-each (compose println derivation->output-path) drvs)
|
||||
|
||||
(case action
|
||||
((reconfigure)
|
||||
(let* ((number (generation-number %guix-home))
|
||||
(generation (generation-file-name
|
||||
%guix-home (+ 1 number))))
|
||||
|
||||
(switch-symlinks generation he-out-path)
|
||||
(switch-symlinks %guix-home generation)
|
||||
(setenv "GUIX_NEW_HOME" he-out-path)
|
||||
(primitive-load (string-append he-out-path "/activate"))
|
||||
(setenv "GUIX_NEW_HOME" #f)
|
||||
(return he-out-path)))
|
||||
(else
|
||||
(newline)
|
||||
(return he-out-path)))))))
|
||||
|
||||
(define (process-action action args opts)
|
||||
"Process ACTION, a sub-command, with the arguments are listed in ARGS.
|
||||
ACTION must be one of the sub-commands that takes a home environment
|
||||
declaration as an argument (a file name.) OPTS is the raw alist of options
|
||||
resulting from command-line parsing."
|
||||
(define (ensure-home-environment file-or-exp obj)
|
||||
(unless (home-environment? obj)
|
||||
(leave (G_ "'~a' does not return a home environment ~%")
|
||||
file-or-exp))
|
||||
obj)
|
||||
|
||||
(let* ((file (match args
|
||||
(() #f)
|
||||
((x . _) x)))
|
||||
(expr (assoc-ref opts 'expression))
|
||||
(system (assoc-ref opts 'system))
|
||||
|
||||
(transform (lambda (obj)
|
||||
(home-environment-with-provenance obj file)))
|
||||
|
||||
(home-environment
|
||||
(transform
|
||||
(ensure-home-environment
|
||||
(or file expr)
|
||||
(cond
|
||||
((and expr file)
|
||||
(leave
|
||||
(G_ "both file and expression cannot be specified~%")))
|
||||
(expr
|
||||
(read/eval expr))
|
||||
(file
|
||||
(load* file %user-module
|
||||
#:on-error (assoc-ref opts 'on-error)))
|
||||
(else
|
||||
(leave (G_ "no configuration specified~%")))))))
|
||||
|
||||
(dry? (assoc-ref opts 'dry-run?)))
|
||||
|
||||
(with-store store
|
||||
(set-build-options-from-command-line store opts)
|
||||
(with-build-handler (build-notifier #:use-substitutes?
|
||||
(assoc-ref opts 'substitutes?)
|
||||
#:verbosity
|
||||
(verbosity-level opts)
|
||||
#:dry-run?
|
||||
(assoc-ref opts 'dry-run?))
|
||||
|
||||
(run-with-store store
|
||||
(mbegin %store-monad
|
||||
(set-guile-for-build (default-guile))
|
||||
|
||||
(case action
|
||||
(else
|
||||
(perform-action action home-environment
|
||||
#:dry-run? dry?
|
||||
#:derivations-only? (assoc-ref opts 'derivations-only?)
|
||||
#:use-substitutes? (assoc-ref opts 'substitutes?))
|
||||
))))))
|
||||
(warn-about-disk-space)))
|
||||
|
||||
|
||||
(define (process-command command args opts)
|
||||
"Process COMMAND, one of the 'guix home' sub-commands. ARGS is its
|
||||
argument list and OPTS is the option alist."
|
||||
(define-syntax-rule (with-store* store exp ...)
|
||||
(with-store store
|
||||
(set-build-options-from-command-line store opts)
|
||||
exp ...))
|
||||
(case command
|
||||
;; The following commands do not need to use the store, and they do not need
|
||||
;; an home environment file.
|
||||
((search)
|
||||
(apply search args))
|
||||
((import)
|
||||
(let* ((profiles (delete-duplicates
|
||||
(match (filter-map (match-lambda
|
||||
(('profile . p) p)
|
||||
(_ #f))
|
||||
opts)
|
||||
(() (list %current-profile))
|
||||
(lst (reverse lst)))))
|
||||
(manifest (concatenate-manifests
|
||||
(map profile-manifest profiles))))
|
||||
(import-manifest manifest (current-output-port))))
|
||||
((describe)
|
||||
(match (generation-number %guix-home)
|
||||
(0
|
||||
(error (G_ "no home environment generation, nothing to describe~%")))
|
||||
(generation
|
||||
(display-home-environment-generation generation))))
|
||||
((list-generations)
|
||||
(let ((pattern (match args
|
||||
(() #f)
|
||||
((pattern) pattern)
|
||||
(x (leave (G_ "wrong number of arguments~%"))))))
|
||||
(list-generations pattern)))
|
||||
((switch-generation)
|
||||
(let ((pattern (match args
|
||||
((pattern) pattern)
|
||||
(x (leave (G_ "wrong number of arguments~%"))))))
|
||||
(with-store* store
|
||||
(switch-to-home-environment-generation store pattern))))
|
||||
((roll-back)
|
||||
(let ((pattern (match args
|
||||
(() "")
|
||||
(x (leave (G_ "wrong number of arguments~%"))))))
|
||||
(with-store* store
|
||||
(roll-back-home-environment store))))
|
||||
((delete-generations)
|
||||
(let ((pattern (match args
|
||||
(() #f)
|
||||
((pattern) pattern)
|
||||
(x (leave (G_ "wrong number of arguments~%"))))))
|
||||
(with-store*
|
||||
store
|
||||
(delete-matching-generations store %guix-home pattern))))
|
||||
(else (process-action command args opts))))
|
||||
|
||||
(define-command (guix-home . args)
|
||||
(synopsis "build and deploy home environments")
|
||||
|
||||
(define (parse-sub-command arg result)
|
||||
;; Parse sub-command ARG and augment RESULT accordingly.
|
||||
(if (assoc-ref result 'action)
|
||||
(alist-cons 'argument arg result)
|
||||
(let ((action (string->symbol arg)))
|
||||
(case action
|
||||
((build
|
||||
reconfigure
|
||||
extension-graph shepherd-graph
|
||||
list-generations describe
|
||||
delete-generations roll-back
|
||||
switch-generation search
|
||||
import)
|
||||
(alist-cons 'action action result))
|
||||
(else (leave (G_ "~a: unknown action~%") action))))))
|
||||
|
||||
(define (match-pair car)
|
||||
;; Return a procedure that matches a pair with CAR.
|
||||
(match-lambda
|
||||
((head . tail)
|
||||
(and (eq? car head) tail))
|
||||
(_ #f)))
|
||||
|
||||
(define (option-arguments opts)
|
||||
;; Extract the plain arguments from OPTS.
|
||||
(let* ((args (reverse (filter-map (match-pair 'argument) opts)))
|
||||
(count (length args))
|
||||
(action (assoc-ref opts 'action))
|
||||
(expr (assoc-ref opts 'expression)))
|
||||
(define (fail)
|
||||
(leave (G_ "wrong number of arguments for action '~a'~%")
|
||||
action))
|
||||
|
||||
(unless action
|
||||
(format (current-error-port)
|
||||
(G_ "guix home: missing command name~%"))
|
||||
(format (current-error-port)
|
||||
(G_ "Try 'guix home --help' for more information.~%"))
|
||||
(exit 1))
|
||||
|
||||
(case action
|
||||
((build reconfigure)
|
||||
(unless (or (= count 1)
|
||||
(and expr (= count 0)))
|
||||
(fail)))
|
||||
((init)
|
||||
(unless (= count 2)
|
||||
(fail))))
|
||||
args))
|
||||
|
||||
(with-error-handling
|
||||
(let* ((opts (parse-command-line args %options
|
||||
(list %default-options)
|
||||
#:argument-handler
|
||||
parse-sub-command))
|
||||
(args (option-arguments opts))
|
||||
(command (assoc-ref opts 'action)))
|
||||
(parameterize ((%graft? (assoc-ref opts 'graft?)))
|
||||
(with-status-verbosity (verbosity-level opts)
|
||||
(process-command command args opts))))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Searching.
|
||||
;;;
|
||||
|
||||
(define service-type-name*
|
||||
(compose symbol->string service-type-name))
|
||||
|
||||
(define (service-type-description-string type)
|
||||
"Return the rendered and localised description of TYPE, a service type."
|
||||
(and=> (service-type-description type)
|
||||
(compose texi->plain-text P_)))
|
||||
|
||||
(define %service-type-metrics
|
||||
;; Metrics used to estimate the relevance of a search result.
|
||||
`((,service-type-name* . 3)
|
||||
(,service-type-description-string . 2)
|
||||
(,(lambda (type)
|
||||
(match (and=> (service-type-location type) location-file)
|
||||
((? string? file)
|
||||
(basename file ".scm"))
|
||||
(#f
|
||||
"")))
|
||||
. 1)))
|
||||
|
||||
(define (find-service-types regexps)
|
||||
"Return a list of service type/score pairs: service types whose name or
|
||||
description matches REGEXPS sorted by relevance, and their score."
|
||||
(let ((matches (fold-home-service-types
|
||||
(lambda (type result)
|
||||
(match (relevance type regexps
|
||||
%service-type-metrics)
|
||||
((? zero?)
|
||||
result)
|
||||
(score
|
||||
(cons (cons type score) result))))
|
||||
'())))
|
||||
(sort matches
|
||||
(lambda (m1 m2)
|
||||
(match m1
|
||||
((type1 . score1)
|
||||
(match m2
|
||||
((type2 . score2)
|
||||
(if (= score1 score2)
|
||||
(string>? (service-type-name* type1)
|
||||
(service-type-name* type2))
|
||||
(> score1 score2))))))))))
|
||||
|
||||
(define (search . args)
|
||||
(with-error-handling
|
||||
(let* ((regexps (map (cut make-regexp* <> regexp/icase) args))
|
||||
(matches (find-service-types regexps)))
|
||||
(leave-on-EPIPE
|
||||
(display-search-results matches (current-output-port)
|
||||
#:print service-type->recutils
|
||||
#:command "guix home search")))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Generations.
|
||||
;;;
|
||||
|
||||
(define* (display-home-environment-generation
|
||||
number
|
||||
#:optional (profile %guix-home))
|
||||
"Display a summary of home-environment generation NUMBER in a
|
||||
human-readable format."
|
||||
(define (display-channel channel)
|
||||
(format #t " ~a:~%" (channel-name channel))
|
||||
(format #t (G_ " repository URL: ~a~%") (channel-url channel))
|
||||
(when (channel-branch channel)
|
||||
(format #t (G_ " branch: ~a~%") (channel-branch channel)))
|
||||
(format #t (G_ " commit: ~a~%")
|
||||
(if (supports-hyperlinks?)
|
||||
(channel-commit-hyperlink channel)
|
||||
(channel-commit channel))))
|
||||
|
||||
(unless (zero? number)
|
||||
(let* ((generation (generation-file-name profile number)))
|
||||
(define-values (channels config-file)
|
||||
;; The function will work for home environments too, we just
|
||||
;; need to keep provenance file.
|
||||
(system-provenance generation))
|
||||
|
||||
(display-generation profile number)
|
||||
(format #t (G_ " file name: ~a~%") generation)
|
||||
(format #t (G_ " canonical file name: ~a~%") (readlink* generation))
|
||||
;; TRANSLATORS: Please preserve the two-space indentation.
|
||||
|
||||
(unless (null? channels)
|
||||
;; TRANSLATORS: Here "channel" is the same terminology as used in
|
||||
;; "guix describe" and "guix pull --channels".
|
||||
(format #t (G_ " channels:~%"))
|
||||
(for-each display-channel channels))
|
||||
(when config-file
|
||||
(format #t (G_ " configuration file: ~a~%")
|
||||
(if (supports-hyperlinks?)
|
||||
(file-hyperlink config-file)
|
||||
config-file))))))
|
||||
|
||||
(define* (list-generations pattern #:optional (profile %guix-home))
|
||||
"Display in a human-readable format all the home environment
|
||||
generations matching PATTERN, a string. When PATTERN is #f, display
|
||||
all the home environment generations."
|
||||
(cond ((not (file-exists? profile)) ; XXX: race condition
|
||||
(raise (condition (&profile-not-found-error
|
||||
(profile profile)))))
|
||||
((not pattern)
|
||||
(for-each display-home-environment-generation (profile-generations profile)))
|
||||
((matching-generations pattern profile)
|
||||
=>
|
||||
(lambda (numbers)
|
||||
(if (null-list? numbers)
|
||||
(exit 1)
|
||||
(leave-on-EPIPE
|
||||
(for-each display-home-environment-generation numbers)))))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Switch generations.
|
||||
;;;
|
||||
|
||||
;; TODO: Make it public in (guix scripts system)
|
||||
(define-syntax-rule (unless-file-not-found exp)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
exp)
|
||||
(lambda args
|
||||
(if (= ENOENT (system-error-errno args))
|
||||
#f
|
||||
(apply throw args)))))
|
||||
|
||||
(define (switch-to-home-environment-generation store spec)
|
||||
"Switch the home-environment profile to the generation specified by
|
||||
SPEC. STORE is an open connection to the store."
|
||||
(let* ((number (relative-generation-spec->number %guix-home spec))
|
||||
(generation (generation-file-name %guix-home number))
|
||||
(activate (string-append generation "/activate")))
|
||||
(if number
|
||||
(begin
|
||||
(setenv "GUIX_NEW_HOME" (readlink generation))
|
||||
(switch-to-generation* %guix-home number)
|
||||
(unless-file-not-found (primitive-load activate))
|
||||
(setenv "GUIX_NEW_HOME" #f))
|
||||
(leave (G_ "cannot switch to home environment generation '~a'~%") spec))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Roll-back.
|
||||
;;;
|
||||
|
||||
(define (roll-back-home-environment store)
|
||||
"Roll back the home-environment profile to its previous generation.
|
||||
STORE is an open connection to the store."
|
||||
(switch-to-home-environment-generation store "-1"))
|
||||
|
|
@ -0,0 +1,241 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU 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.
|
||||
;;;
|
||||
;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (guix scripts home import)
|
||||
#:use-module (guix profiles)
|
||||
#:use-module (guix ui)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 pretty-print)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:export (import-manifest))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; This module provides utilities for generating home service
|
||||
;;; configurations from existing "dotfiles".
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
|
||||
(define (generate-bash-module+configuration)
|
||||
(let ((rc (string-append (getenv "HOME") "/.bashrc"))
|
||||
(profile (string-append (getenv "HOME") "/.bash_profile"))
|
||||
(logout (string-append (getenv "HOME") "/.bash_logout")))
|
||||
`((gnu home-services bash)
|
||||
(service home-bash-service-type
|
||||
(home-bash-configuration
|
||||
,@(if (file-exists? rc)
|
||||
`((bashrc
|
||||
(list (slurp-file-gexp (local-file ,rc)))))
|
||||
'())
|
||||
,@(if (file-exists? profile)
|
||||
`((bash-profile
|
||||
(list (slurp-file-gexp
|
||||
(local-file ,profile)))))
|
||||
'())
|
||||
,@(if (file-exists? logout)
|
||||
`((bash-logout
|
||||
(list (slurp-file-gexp
|
||||
(local-file ,logout)))))
|
||||
'()))))))
|
||||
|
||||
|
||||
(define %files-configurations-alist
|
||||
`((".bashrc" . ,generate-bash-module+configuration)
|
||||
(".bash_profile" . ,generate-bash-module+configuration)
|
||||
(".bash_logout" . ,generate-bash-module+configuration)))
|
||||
|
||||
(define (modules+configurations)
|
||||
(let ((configurations (delete-duplicates
|
||||
(filter-map (match-lambda
|
||||
((file . proc)
|
||||
(if (file-exists?
|
||||
(string-append (getenv "HOME") "/" file))
|
||||
proc
|
||||
#f)))
|
||||
%files-configurations-alist)
|
||||
(lambda (x y)
|
||||
(equal? (procedure-name x) (procedure-name y))))))
|
||||
(map (lambda (proc) (proc)) configurations)))
|
||||
|
||||
;; Based on `manifest->code' from (guix profiles)
|
||||
;; MAYBE: Upstream it?
|
||||
(define* (manifest->code manifest
|
||||
#:key
|
||||
(entry-package-version (const ""))
|
||||
(home-environment? #f))
|
||||
"Return an sexp representing code to build an approximate version of
|
||||
MANIFEST; the code is wrapped in a top-level 'begin' form. If
|
||||
HOME-ENVIRONMENT? is #t, return an <home-environment> definition.
|
||||
Call ENTRY-PACKAGE-VERSION to determine the version number to use in
|
||||
the spec for a given entry; it can be set to 'manifest-entry-version'
|
||||
for fully-specified version numbers, or to some other procedure to
|
||||
disambiguate versions for packages for which several versions are
|
||||
available."
|
||||
(define (entry-transformations entry)
|
||||
;; Return the transformations that apply to ENTRY.
|
||||
(assoc-ref (manifest-entry-properties entry) 'transformations))
|
||||
|
||||
(define transformation-procedures
|
||||
;; List of transformation options/procedure name pairs.
|
||||
(let loop ((entries (manifest-entries manifest))
|
||||
(counter 1)
|
||||
(result '()))
|
||||
(match entries
|
||||
(() result)
|
||||
((entry . tail)
|
||||
(match (entry-transformations entry)
|
||||
(#f
|
||||
(loop tail counter result))
|
||||
(options
|
||||
(if (assoc-ref result options)
|
||||
(loop tail counter result)
|
||||
(loop tail (+ 1 counter)
|
||||
(alist-cons options
|
||||
(string->symbol
|
||||
(format #f "transform~a" counter))
|
||||
result)))))))))
|
||||
|
||||
(define (qualified-name entry)
|
||||
;; Return the name of ENTRY possibly with "@" followed by a version.
|
||||
(match (entry-package-version entry)
|
||||
("" (manifest-entry-name entry))
|
||||
(version (string-append (manifest-entry-name entry)
|
||||
"@" version))))
|
||||
|
||||
(if (null? transformation-procedures)
|
||||
(let ((specs (map (lambda (entry)
|
||||
(match (manifest-entry-output entry)
|
||||
("out" (qualified-name entry))
|
||||
(output (string-append (qualified-name entry)
|
||||
":" output))))
|
||||
(manifest-entries manifest))))
|
||||
(if home-environment?
|
||||
(let ((modules+configurations (modules+configurations)))
|
||||
`(begin
|
||||
(use-modules (gnu home)
|
||||
(gnu packages)
|
||||
,@(map first modules+configurations))
|
||||
,(home-environment-template
|
||||
#:specs specs
|
||||
#:services (map second modules+configurations))))
|
||||
`(begin
|
||||
(use-modules (gnu packages))
|
||||
|
||||
(specifications->manifest
|
||||
(list ,@specs)))))
|
||||
(let* ((transform (lambda (options exp)
|
||||
(if (not options)
|
||||
exp
|
||||
(let ((proc (assoc-ref transformation-procedures
|
||||
options)))
|
||||
`(,proc ,exp)))))
|
||||
(packages (map (lambda (entry)
|
||||
(define options
|
||||
(entry-transformations entry))
|
||||
|
||||
(define name
|
||||
(qualified-name entry))
|
||||
|
||||
(match (manifest-entry-output entry)
|
||||
("out"
|
||||
(transform options
|
||||
`(specification->package ,name)))
|
||||
(output
|
||||
`(list ,(transform
|
||||
options
|
||||
`(specification->package ,name))
|
||||
,output))))
|
||||
(manifest-entries manifest)))
|
||||
(transformations (map (match-lambda
|
||||
((options . name)
|
||||
`(define ,name
|
||||
(options->transformation ',options))))
|
||||
transformation-procedures)))
|
||||
(if home-environment?
|
||||
(let ((modules+configurations (modules+configurations)))
|
||||
`(begin
|
||||
(use-modules (guix transformations)
|
||||
(gnu home)
|
||||
(gnu packages)
|
||||
,@(map first modules+configurations))
|
||||
|
||||
,@transformations
|
||||
|
||||
,(home-environment-template
|
||||
#:packages packages
|
||||
#:services (map second modules+configurations))))
|
||||
`(begin
|
||||
(use-modules (guix transformations)
|
||||
(gnu packages))
|
||||
|
||||
,@transformations
|
||||
|
||||
(packages->manifest
|
||||
(list ,@packages)))))))
|
||||
|
||||
(define* (home-environment-template #:key (packages #f) (specs #f) services)
|
||||
"Return an S-exp containing a <home-environment> declaration
|
||||
containing PACKAGES, or SPECS (package specifications), and SERVICES."
|
||||
`(home-environment
|
||||
(packages
|
||||
,@(if packages
|
||||
`((list ,@packages))
|
||||
`((map specification->package
|
||||
(list ,@specs)))))
|
||||
(services (list ,@services))))
|
||||
|
||||
(define* (import-manifest
|
||||
manifest
|
||||
#:optional (port (current-output-port)))
|
||||
"Write to PORT a <home-environment> corresponding to MANIFEST."
|
||||
(define (version-spec entry)
|
||||
(let ((name (manifest-entry-name entry)))
|
||||
(match (map package-version (find-packages-by-name name))
|
||||
((_)
|
||||
;; A single version of NAME is available, so do not specify the
|
||||
;; version number, even if the available version doesn't match ENTRY.
|
||||
"")
|
||||
(versions
|
||||
;; If ENTRY uses the latest version, don't specify any version.
|
||||
;; Otherwise return the shortest unique version prefix. Note that
|
||||
;; this is based on the currently available packages, which could
|
||||
;; differ from the packages available in the revision that was used
|
||||
;; to build MANIFEST.
|
||||
(let ((current (manifest-entry-version entry)))
|
||||
(if (every (cut version>? current <>)
|
||||
(delete current versions))
|
||||
""
|
||||
(version-unique-prefix (manifest-entry-version entry)
|
||||
versions)))))))
|
||||
|
||||
(match (manifest->code manifest
|
||||
#:entry-package-version version-spec
|
||||
#:home-environment? #t)
|
||||
(('begin exp ...)
|
||||
(format port (G_ "\
|
||||
;; This \"home-environment\" file can be passed to 'guix home reconfigure'
|
||||
;; to reproduce the content of your profile. This is \"symbolic\": it only
|
||||
;; specifies package names. To reproduce the exact same profile, you also
|
||||
;; need to capture the channels being used, as returned by \"guix describe\".
|
||||
;; See the \"Replicating Guix\" section in the manual.\n"))
|
||||
(for-each (lambda (exp)
|
||||
(newline port)
|
||||
(pretty-print exp port))
|
||||
exp))))
|
||||
|
|
@ -958,13 +958,23 @@ itself."
|
|||
#:guile-for-build
|
||||
guile-for-build))
|
||||
|
||||
(define *home-modules*
|
||||
(scheme-node "guix-home"
|
||||
`((gnu home)
|
||||
(gnu home-services)
|
||||
,@(scheme-modules* source "gnu/home-services"))
|
||||
(list *core-package-modules* *package-modules*
|
||||
*extra-modules* *core-modules* *system-modules*)
|
||||
#:extensions dependencies
|
||||
#:guile-for-build guile-for-build))
|
||||
|
||||
(define *cli-modules*
|
||||
(scheme-node "guix-cli"
|
||||
(append (scheme-modules* source "/guix/scripts")
|
||||
`((gnu ci)))
|
||||
(list *core-modules* *extra-modules*
|
||||
*core-package-modules* *package-modules*
|
||||
*system-modules*)
|
||||
*system-modules* *home-modules*)
|
||||
#:extensions dependencies
|
||||
#:guile-for-build guile-for-build))
|
||||
|
||||
|
|
@ -1012,6 +1022,7 @@ itself."
|
|||
*cli-modules*
|
||||
*system-test-modules*
|
||||
*system-modules*
|
||||
*home-modules*
|
||||
*package-modules*
|
||||
*core-package-modules*
|
||||
*extra-modules*
|
||||
|
|
|
|||
Loading…
Reference in New Issue