From ef674a24c527eaf54801707d34dbf5d12ec139cb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 22 Apr 2020 15:43:43 +0200
Subject: profiles: Add lowerable <profile> record type.

* guix/profiles.scm (<profile>): New record type.
* tests/profiles.scm ("<profile>"): New test.
---
 guix/profiles.scm | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)

(limited to 'guix/profiles.scm')

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 88606fa4ce..ab265cce62 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -125,6 +125,15 @@
             profile-derivation
             profile-search-paths
 
+            profile
+            profile?
+            profile-name
+            profile-content
+            profile-hooks
+            profile-locales?
+            profile-allow-collisions?
+            profile-relative-symlinks?
+
             generation-number
             generation-profile
             generation-numbers
@@ -1656,6 +1665,33 @@ are cross-built for TARGET."
                                        . ,(length
                                            (manifest-entries manifest))))))))
 
+;; Declarative profile.
+(define-record-type* <profile> profile make-profile
+  profile?
+  (name               profile-name (default "profile")) ;string
+  (content            profile-content)                  ;<manifest>
+  (hooks              profile-hooks                     ;list of procedures
+                      (default %default-profile-hooks))
+  (locales?           profile-locales?            ;Boolean
+                      (default #t))
+  (allow-collisions?  profile-allow-collisions?   ;Boolean
+                      (default #f))
+  (relative-symlinks? profile-relative-symlinks?  ;Boolean
+                      (default #f)))
+
+(define-gexp-compiler (profile-compiler (profile <profile>) system target)
+  "Compile PROFILE to a derivation."
+  (match profile
+    (($ <profile> name manifest hooks
+                  locales? allow-collisions? relative-symlinks?)
+     (profile-derivation manifest
+                         #:name name
+                         #:hooks hooks
+                         #:locales? locales?
+                         #:allow-collisions? allow-collisions?
+                         #:relative-symlinks? relative-symlinks?
+                         #:system system #:target target))))
+
 (define* (profile-search-paths profile
                                #:optional (manifest (profile-manifest profile))
                                #:key (getenv (const #f)))
-- 
cgit v1.2.3