gnu: Add rust-number-prefix-0.4.

[jackhill/guix/guix.git] / gnu / home.scm

diff --git a/gnu/home.scm b/gnu/home.scm
index d813469..c95d1e0 100644 (file)
--- a/gnu/home.scm
+++ b/gnu/home.scm
@@ -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.
 ;;;
@@ -25,7 +26,10 @@
   #:use-module (gnu services)
   #:use-module (guix records)
   #: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
@@ -36,7 +40,9 @@
             home-environment-services
             home-environment-location
 
-            home-environment-with-provenance))
+            home-environment-with-provenance
+
+            home-generation-base))
 
 ;;; Comment:
 ;;;
@@ -90,7 +96,7 @@
            (home-environment-essential-services he))))
 
 (define* (home-environment-derivation he)
-  "Return a derivation that builds OS."
+  "Return a derivation that builds home environment."
   (let* ((services         (home-environment-services he))
          (home (fold-services services
                               #:target-type home-service-type)))
@@ -104,3 +110,29 @@ of HOME-PROVENANCE-SERVICE-TYPE to its services."
     (inherit he)
     (services (cons (service home-provenance-service-type config-file)
                     (home-environment-user-services he)))))
+
+(define-gexp-compiler (home-environment-compiler (he <home-environment>)
+                                                 system target)
+  ((store-lift
+    (lambda (store)
+      (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)))))