gnu/home.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
   3 ;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (gnu home)
  21   #:use-module (gnu home services)
  22   #:use-module (gnu home services symlink-manager)
  23   #:use-module (gnu home services shells)
  24   #:use-module (gnu home services xdg)
  25   #:use-module (gnu home services fontutils)
  26   #:use-module (gnu services)
  27   #:use-module (guix records)
  28   #:use-module (guix diagnostics)
  29   #:use-module (guix gexp)
  30   #:use-module (guix store)
  31   #:use-module (ice-9 match)
  32   #:use-module (ice-9 regex)
  33   #:export (home-environment
  34             home-environment?
  35             this-home-environment
  36
  37             home-environment-derivation
  38             home-environment-user-services
  39             home-environment-essential-services
  40             home-environment-services
  41             home-environment-location
  42
  43             home-environment-with-provenance
  44
  45             home-generation-base))
  46
  47 ;;; Comment:
  48 ;;;
  49 ;;; This module provides a <home-environment> record for managing
  50 ;;; per-user packages and configuration files in the similar way as
  51 ;;; <operating-system> do for system packages and configuration files.
  52 ;;;
  53 ;;; Code:
  54
  55 (define-record-type* <home-environment> home-environment
  56   make-home-environment
  57   home-environment?
  58   this-home-environment
  59
  60   (packages           home-environment-packages            ; list of (PACKAGE OUTPUT...)
  61                       (default '()))
  62
  63   (essential-services home-environment-essential-services  ; list of services
  64                       (thunked)
  65                       (default (home-environment-default-essential-services
  66                                 this-home-environment)))
  67
  68   (services           home-environment-user-services
  69                       (default '()))
  70
  71   (location           home-environment-location            ; <location>
  72                       (default (and=> (current-source-location)
  73                                       source-properties->location))
  74                       (innate)))
  75
  76 (define (home-environment-default-essential-services he)
  77   "Return the list of essential services for home environment."
  78   (list
  79    (service home-run-on-first-login-service-type)
  80    (service home-activation-service-type)
  81    (service home-environment-variables-service-type)
  82
  83    (service home-symlink-manager-service-type)
  84
  85    (service home-fontconfig-service-type)
  86    (service home-xdg-base-directories-service-type)
  87    (service home-shell-profile-service-type)
  88
  89    (service home-service-type)
  90    (service home-profile-service-type (home-environment-packages he))))
  91
  92 (define* (home-environment-services he)
  93   "Return all the services of home environment."
  94   (instantiate-missing-services
  95    (append (home-environment-user-services he)
  96            (home-environment-essential-services he))))
  97
  98 (define* (home-environment-derivation he)
  99   "Return a derivation that builds home environment."
 100   (let* ((services         (home-environment-services he))
 101          (home (fold-services services
 102                               #:target-type home-service-type)))
 103     (service-value home)))
 104
 105 (define* (home-environment-with-provenance he config-file)
 106   "Return a variant of HE that stores its own provenance information,
 107 including CONFIG-FILE, if available.  This is achieved by adding an instance
 108 of HOME-PROVENANCE-SERVICE-TYPE to its services."
 109   (home-environment
 110     (inherit he)
 111     (services (cons (service home-provenance-service-type config-file)
 112                     (home-environment-user-services he)))))
 113
 114 (define-gexp-compiler (home-environment-compiler (he <home-environment>)
 115                                                  system target)
 116   ((store-lift
 117     (lambda (store)
 118       (run-with-store store (home-environment-derivation he)
 119                       #:system system
 120                       #:target target)))))
 121
 122 (define %profile-generation-rx
 123   ;; Regexp that matches profile generation.
 124   (make-regexp "(.*)-([0-9]+)-link$"))
 125
 126 (define (home-generation-base file)
 127   "If FILE is a Home generation GC root such as \"guix-home-42-link\",
 128 return its corresponding base---e.g., \"guix-home\".  Otherwise return #f.
 129
 130 This is similar to the 'generation-profile' procedure but applied to Home
 131 generations."
 132   (match (regexp-exec %profile-generation-rx file)
 133     (#f #f)
 134     (m  (let ((profile (match:substring m 1)))
 135           ;; Distinguish from a "real" profile and from a system generation.
 136           (and (file-exists? (string-append profile "/on-first-login"))
 137                (file-exists? (string-append profile "/profile/manifest"))
 138                profile)))))