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

home: Add 'home-generation-base'.

Browse source 
* gnu/home.scm (%profile-generation-rx): New variable.
(home-generation-base): New procedure.
This commit is contained in:
Ludovic Courtès 2022-07-17 17:10:06 +02:00
parent ff94f9dfde
commit 5df8f7802e
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 24 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
gnu/home.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -27,7 +28,8 @@ (define-module (gnu home)
#:use-module (guix diagnostics)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:export (home-environment
home-environment?
this-home-environment
@ -38,7 +40,9 @@ (define-module (gnu home)
home-environment-services
home-environment-location
home-environment-with-provenance))
home-environment-with-provenance
home-generation-base))
;;; Comment:
;;;
@ -114,3 +118,21 @@ (define-gexp-compiler (home-environment-compiler (he <home-environment>)
(run-with-store store (home-environment-derivation he)
#:system system
#:target target)))))
(define %profile-generation-rx
;; Regexp that matches profile generation.
(make-regexp "(.*)-([0-9]+)-link$"))
(define (home-generation-base file)
"If FILE is a Home generation GC root such as \"guix-home-42-link\",
return its corresponding base---e.g., \"guix-home\". Otherwise return #f.
This is similar to the 'generation-profile' procedure but applied to Home
generations."
(match (regexp-exec %profile-generation-rx file)
(#f #f)
(m (let ((profile (match:substring m 1)))
;; Distinguish from a "real" profile and from a system generation.
(and (file-exists? (string-append profile "/on-first-login"))
(file-exists? (string-append profile "/profile/manifest"))
profile)))))