guix-patches
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[bug#55653] [PATCH] guix: Add syntactic sugar for profile generation.


From: Liliana Marie Prikler
Subject: [bug#55653] [PATCH] guix: Add syntactic sugar for profile generation.
Date: Thu, 26 May 2022 11:01:02 +0200

* guix/profiles.scm (%profile, package-compatibility-helper): New variables.
(profile): Implement in terms of package-compatibility-helper.
---
Hi Guix,

this is a first step towards managing multiple profiles via Guix Home.
It makes it so that regular Guix profiles can more easily be specified, though
I'm not quite sure whether the mlet of packages->profile-entry should not also
be used here.

In any case, with this it should now be relatively easy for users to specify
profiles such as
  (profile (name "emacs") (packages emacs emacs-magit emacs-org ...))
  (profile (name "r") (packages r r-plyr emacs emacs-ess ...))
  (profile (name "python") (packages python python-beautifulsoup4 ...))
  ...
What's still missing is a way to link them up with /var/guix/profiles/per-user
and $HOME – for the latter, there would be a home-*-service-type.

WDYT?

 guix/profiles.scm  | 23 ++++++++++++++++++++++-
 tests/profiles.scm | 16 ++++++++++++++++
 2 files changed, 38 insertions(+), 1 deletion(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index bf50c00a1e..fbc343c456 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1974,7 +1974,7 @@ (define builder
                                            (manifest-entries manifest))))))))
 
 ;; Declarative profile.
-(define-record-type* <profile> profile make-profile
+(define-record-type* <profile> %profile make-profile
   profile?
   (name               profile-name (default "profile")) ;string
   (content            profile-content)                  ;<manifest>
@@ -1987,6 +1987,27 @@ (define-record-type* <profile> profile make-profile
   (relative-symlinks? profile-relative-symlinks?  ;Boolean
                       (default #f)))
 
+(define-syntax package-compatibility-helper
+  (syntax-rules (packages manifest)
+    ((_ () (fields ...))
+     (%profile fields ...))
+    ((_ ((packages exp) rest ...) (others ...))
+     (package-compatibility-helper
+      (rest ...)
+      (others ... (content (packages->manifest
+                            (delete-duplicates exp eq?))))))
+    ((_ ((manifest exp) rest ...) (others ...))
+     (package-compatibility-helper
+      (rest ...)
+      (others ... (content exp))))
+    ((_ (field rest ...) (others ...))
+     (package-compatibility-helper (rest ...) (others ... field)))))
+
+(define-syntax-rule (profile fields ...)
+  "Build a <profile> record, automatically converting 'packages' or 'manifest '
+field specifications to 'content'."
+  (package-compatibility-helper (fields ...) ()))
+
 (define-gexp-compiler (profile-compiler (profile <profile>) system target)
   "Compile PROFILE to a derivation."
   (match profile
diff --git a/tests/profiles.scm b/tests/profiles.scm
index d59d75985f..970a34b6cc 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -272,6 +272,22 @@ (define transform1
                                   (manifest-pattern (name name))))
            '("gcc" "binutils" "glibc" "coreutils" "grep" "sed"))))
 
+(test-assert "profile syntax sugar"
+  (let ((p1 (dummy-package "p1"))
+        (p2 (dummy-package "p2")))
+    (define (profile=? . profiles)
+      (define (manifest=? . manifests)
+        ;; Since we're using the same packages, we could also compare via eq?
+        (apply list= manifest-entry=? (map manifest-entries manifests)))
+      (apply manifest=? (map profile-content profiles)))
+
+    (profile=?
+     (profile (content (manifest
+                        (map package->manifest-entry (list p1 p2)))))
+     (profile (content (packages->manifest (list p1 p2))))
+     (profile (manifest (packages->manifest (list p1 p2))))
+     (profile (packages (list p1 p2))))))
+
 (test-assertm "profile-derivation"
   (mlet* %store-monad
       ((entry ->   (package->manifest-entry %bootstrap-guile))
-- 
2.36.1






reply via email to

[Prev in Thread] Current Thread [Next in Thread]