ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge branch 'wip-guix-home'

Browse source
This commit is contained in:
Oleg Pykhalov 2021-09-27 17:27:12 +03:00
commit 6ae4644984
No known key found for this signature in database
GPG key ID: 167F8EA5001AFA9C
18 changed files with 4053 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Makefile.am
View file

@ -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
View file

@ -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

24
doc/he-config-bare-bones.scm Normal file
View file

@ -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
View file

@ -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

524
gnu/home-services.scm Normal file
View file

@ -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)))

107
gnu/home-services/configuration.scm Normal file
View file

@ -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)))

65
gnu/home-services/fontutils.scm Normal file
View file

@ -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.")))

115
gnu/home-services/mcron.scm Normal file
View file

@ -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.")))

634
gnu/home-services/shells.scm Normal file
View file

@ -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)))

134
gnu/home-services/shepherd.scm Normal file
View file

@ -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.")))

247
gnu/home-services/symlink-manager.scm Normal file
View file

@ -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.")))

77
gnu/home-services/utils.scm Normal file
View file

@ -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))))))))))

476
gnu/home-services/xdg.scm Normal file
View file

@ -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.")))

106
gnu/home.scm Normal file
View file

@ -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
View file

@ -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 \

512
guix/scripts/home.scm Normal file
View file

@ -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"))

241
guix/scripts/home/import.scm Normal file
View file

@ -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))))

13
guix/self.scm
View file

@ -958,13 +958,23 @@ (define *system-modules*
#: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 @@ (define (built-modules node-subset)
*cli-modules*
*system-test-modules*
*system-modules*
*home-modules*
*package-modules*
*core-package-modules*
*extra-modules*