From c872b952c527cb42766654d12059d5ea5224ca6c Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 6 Apr 2019 23:05:27 +0200
Subject: profiles: Add 'generation-profile'.

* guix/profiles.scm (%profile-generation-rx): New variable.
(generation-profile): New procedure.
---
 guix/profiles.scm | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

(limited to 'guix')

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 6564526aee..dfc9ba1ca0 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -118,6 +118,7 @@ (define-module (guix profiles)
             profile-search-paths
 
             generation-number
+            generation-profile
             generation-numbers
             profile-generations
             relative-generation-spec->number
@@ -1552,6 +1553,20 @@ (define (generation-number profile)
              (compose string->number (cut match:substring <> 1)))
       0))
 
+(define %profile-generation-rx
+  ;; Regexp that matches profile generation.
+  (make-regexp "(.*)-([0-9]+)-link$"))
+
+(define (generation-profile file)
+  "If FILE is a profile generation GC root such as \"guix-profile-42-link\",
+return its corresponding profile---e.g., \"guix-profile\".  Otherwise return
+#f."
+  (match (regexp-exec %profile-generation-rx file)
+    (#f #f)
+    (m  (let ((profile (match:substring m 1)))
+          (and (file-exists? (string-append profile "/manifest"))
+               profile)))))
+
 (define (generation-numbers profile)
   "Return the sorted list of generation numbers of PROFILE, or '(0) if no
 former profiles were found."
-- 
cgit v1.2.3