[bug#40770] [PATCH 0/5] Add declarative profiles

[bug#40770] [PATCH 0/5] Add declarative profiles

[Ludovic Courtès]

Hello Guix!

This patch set introduces “declarative profiles” or, in other words,
a way to declare a profile and use it in a gexp without calling
‘profile-derivation’, fiddling with ‘%store-monad’ and all that.

The goals are:

  1. To provide a simpler programming interface, reducing the need
     to resort to ‘%store-monad’, and making it usable in a wider
     range of contexts (see for example
     <https://git.savannah.gnu.org/cgit/guix.git/tree/gnu/system/hurd.scm?h=core-updates&id=5084fd38541a5fc233f3299e10a33c3a38a7173f>).

  2. To potentially improve high-level caching in the object cache
     as well as “parallelism” (see <https://bugs.gnu.org/40612>).

Feedback welcome!

Ludo’.

Ludovic Courtès (5):
  profiles: Add lowerable <profile> record type.
  system: 'operating-system-directory-base-entries' uses 'profile'.
  services: profile: Use a declarative profile.
  pack: Use a declarative profile.
  services: system: Initial entries are non-monadic.

 gnu/services.scm               | 13 ++++++------
 gnu/system.scm                 | 27 ++++++++++++-------------
 gnu/system/linux-container.scm |  6 ++----
 guix/profiles.scm              | 36 ++++++++++++++++++++++++++++++++++
 guix/scripts/pack.scm          | 33 +++++++++++++++----------------
 tests/profiles.scm             | 13 +++++++++++-
 6 files changed, 84 insertions(+), 44 deletions(-)

-- 
2.26.0

[bug#40770] [PATCH 1/5] profiles: Add lowerable <profile> record type.

[Ludovic Courtès]

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

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)))
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 21c912a532..055924ba3e 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -223,6 +223,17 @@
                  (string=? (dirname (readlink bindir))
                            (derivation->output-path guile))))))
 
+(test-assertm "<profile>"
+  (mlet* %store-monad
+      ((entry ->   (package->manifest-entry %bootstrap-guile))
+       (profile -> (profile (hooks '()) (locales? #f)
+                            (content (manifest (list entry)))))
+       (drv        (lower-object profile))
+       (profile -> (derivation->output-path drv))
+       (bindir ->  (string-append profile "/bin"))
+       (_          (built-derivations (list drv))))
+    (return (file-exists? (string-append bindir "/guile")))))
+
 (test-assertm "profile-derivation relative symlinks, one entry"
   (mlet* %store-monad
       ((entry ->   (package->manifest-entry %bootstrap-guile))
-- 
2.26.0

[bug#40770] [PATCH 2/5] system: 'operating-system-directory-base-entries' uses 'profile'.

[Ludovic Courtès]

* gnu/system.scm (operating-system-directory-base-entries): Use a
declarative profile instead of 'profile-derivation'.
---
 gnu/system.scm | 20 +++++++++-----------
 1 file changed, 9 insertions(+), 11 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index fb48fedd7f..739b629367 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -475,17 +475,15 @@ OS."
 (define* (operating-system-directory-base-entries os)
   "Return the basic entries of the 'system' directory of OS for use as the
 value of the SYSTEM-SERVICE-TYPE service."
-  (let ((locale (operating-system-locale-directory os)))
-    (mlet* %store-monad ((kernel -> (operating-system-kernel os))
-                         (modules ->
-                          (operating-system-kernel-loadable-modules os))
-                         (kernel
-                          (profile-derivation
-                           (packages->manifest
-                            (cons kernel modules))
-                           #:hooks (list linux-module-database)))
-                         (initrd -> (operating-system-initrd-file os))
-                         (params -> (operating-system-boot-parameters-file os)))
+  (let* ((locale  (operating-system-locale-directory os))
+         (modules (operating-system-kernel-loadable-modules os))
+         (kernel  (profile
+                   (content (packages->manifest
+                             (cons (operating-system-kernel os) modules)))
+                   (hooks (list linux-module-database))))
+         (initrd  (operating-system-initrd-file os))
+         (params  (operating-system-boot-parameters-file os)))
+    (with-monad %store-monad
       (return `(("kernel" ,kernel)
                 ("parameters" ,params)
                 ("initrd" ,initrd)
-- 
2.26.0

[bug#40770] [PATCH 3/5] services: profile: Use a declarative profile.

[Ludovic Courtès]

* gnu/services.scm (packages->profile-entry): Use 'profile' instead of
'profile-derivation'.
---
 gnu/services.scm | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/gnu/services.scm b/gnu/services.scm
index 126e0814eb..ada6268a0b 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -691,10 +691,10 @@ executables, making them setuid-root.")))
 
 (define (packages->profile-entry packages)
   "Return a system entry for the profile containing PACKAGES."
-  (mlet %store-monad ((profile (profile-derivation
-                                (packages->manifest
-                                 (delete-duplicates packages eq?)))))
-    (return `(("profile" ,profile)))))
+  (with-monad %store-monad
+    (return `(("profile" ,(profile
+                           (content (packages->manifest
+                                     (delete-duplicates packages eq?)))))))))
 
 (define profile-service-type
   ;; The service that populates the system's profile---i.e.,
-- 
2.26.0

[bug#40770] [PATCH 4/5] pack: Use a declarative profile.

[Ludovic Courtès]

* guix/scripts/pack.scm (guix-pack): Use a declarative profile instead
of 'profile-derivation'.
---
 guix/scripts/pack.scm | 33 ++++++++++++++++-----------------
 1 file changed, 16 insertions(+), 17 deletions(-)

diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 6d63fb4b90..f3d1b41c6f 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -1071,7 +1071,21 @@ Create a bundle of PACKAGE.\n"))
                    (localstatedir? (assoc-ref opts 'localstatedir?))
                    (entry-point    (assoc-ref opts 'entry-point))
                    (profile-name   (assoc-ref opts 'profile-name))
-                   (gc-root        (assoc-ref opts 'gc-root)))
+                   (gc-root        (assoc-ref opts 'gc-root))
+                   (profile        (profile
+                                    (content manifest)
+
+                                    ;; Always produce relative symlinks for
+                                    ;; Singularity (see
+                                    ;; <https://bugs.gnu.org/34913>).
+                                    (relative-symlinks?
+                                     (or relocatable?
+                                         (eq? 'squashfs pack-format)))
+
+                                    (hooks (if bootstrap?
+                                               '()
+                                               %default-profile-hooks))
+                                    (locales? (not bootstrap?)))))
               (define (lookup-package package)
                 (manifest-lookup manifest (manifest-pattern (name package))))
 
@@ -1085,22 +1099,7 @@ Create a bundle of PACKAGE.\n"))
 to your package list.")))
 
               (run-with-store store
-                (mlet* %store-monad ((profile (profile-derivation
-                                               manifest
-
-                                               ;; Always produce relative
-                                               ;; symlinks for Singularity (see
-                                               ;; <https://bugs.gnu.org/34913>).
-                                               #:relative-symlinks?
-                                               (or relocatable?
-                                                   (eq? 'squashfs pack-format))
-
-                                               #:hooks (if bootstrap?
-                                                           '()
-                                                           %default-profile-hooks)
-                                               #:locales? (not bootstrap?)
-                                               #:target target))
-                                     (drv (build-image name profile
+                (mlet* %store-monad ((drv (build-image name profile
                                                        #:target
                                                        target
                                                        #:compressor
-- 
2.26.0

[bug#40770] [PATCH 5/5] services: system: Initial entries are non-monadic.

[Ludovic Courtès]

* gnu/system.scm (operating-system-directory-base-entries): Return a
regular, non-monadic value.
* gnu/services.scm (system-derivation): Adjust accordingly.
* gnu/system/linux-container.scm (container-essential-services): Likewise.
---
 gnu/services.scm               | 5 ++---
 gnu/system.scm                 | 9 ++++-----
 gnu/system/linux-container.scm | 6 ++----
 3 files changed, 8 insertions(+), 12 deletions(-)

diff --git a/gnu/services.scm b/gnu/services.scm
index ada6268a0b..2e4648bf78 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -318,11 +318,10 @@ This is a shorthand for (map (lambda (svc) ...) %base-services)."
 ;;; Core services.
 ;;;
 
-(define (system-derivation mentries mextensions)
+(define (system-derivation entries mextensions)
   "Return as a monadic value the derivation of the 'system' directory
 containing the given entries."
-  (mlet %store-monad ((entries    mentries)
-                      (extensions (mapm/accumulate-builds identity
+  (mlet %store-monad ((extensions (mapm/accumulate-builds identity
                                                           mextensions)))
     (lower-object
      (file-union "system"
diff --git a/gnu/system.scm b/gnu/system.scm
index 739b629367..1872a2ed61 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -483,11 +483,10 @@ value of the SYSTEM-SERVICE-TYPE service."
                    (hooks (list linux-module-database))))
          (initrd  (operating-system-initrd-file os))
          (params  (operating-system-boot-parameters-file os)))
-    (with-monad %store-monad
-      (return `(("kernel" ,kernel)
-                ("parameters" ,params)
-                ("initrd" ,initrd)
-                ("locale" ,locale))))))   ;used by libc
+    `(("kernel" ,kernel)
+      ("parameters" ,params)
+      ("initrd" ,initrd)
+      ("locale" ,locale))))   ;used by libc
 
 (define (operating-system-default-essential-services os)
   "Return the list of essential services for OS.  These are special services
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index c8807398b3..c5e2e4bf9c 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;;
@@ -53,9 +53,7 @@ from OS that are needed on the bare metal and not in a container."
             (operating-system-default-essential-services os)))
 
   (cons (service system-service-type
-                 (let ((locale (operating-system-locale-directory os)))
-                   (with-monad %store-monad
-                     (return `(("locale" ,locale))))))
+                 `(("locale" ,(operating-system-locale-directory os))))
         ;; If network is to be shared with the host, remove network
         ;; configuration files from etc-service.
         (if shared-network?
-- 
2.26.0

[bug#40770] [PATCH 0/5] Add declarative profiles

[Mathieu Othacehe]

Hey Ludo,

>   2. To potentially improve high-level caching in the object cache
>      as well as “parallelism” (see <https://bugs.gnu.org/40612>).
>
> Feedback welcome!

This is really nice and it all looks good to me. Any reason not to use
it in "package-cache-file" to get rid of the mlet?

Thanks,

Mathieu

[bug#40770] [PATCH 0/5] Add declarative profiles

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 820 bytes --]


Ludovic Courtès <ludo@gnu.org> writes:

> This patch set introduces “declarative profiles” or, in other words,
> a way to declare a profile and use it in a gexp without calling
> ‘profile-derivation’, fiddling with ‘%store-monad’ and all that.
>
> The goals are:
>
>   1. To provide a simpler programming interface, reducing the need
>      to resort to ‘%store-monad’, and making it usable in a wider
>      range of contexts (see for example
>      <https://git.savannah.gnu.org/cgit/guix.git/tree/gnu/system/hurd.scm?h=core-updates&id=5084fd38541a5fc233f3299e10a33c3a38a7173f>).

This sounds great, I use Emacs in a profile for rending .org files with
cgit, and it took a bit of fiddling to get the profile built
properly. This'll probably make it a lot easier!

Thanks,

Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#40770] [PATCH 0/5] Add declarative profiles

[Ludovic Courtès]

Hello,

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

>>   2. To potentially improve high-level caching in the object cache
>>      as well as “parallelism” (see <https://bugs.gnu.org/40612>).
>>
>> Feedback welcome!
>
> This is really nice and it all looks good to me.

Cool, thanks for the quick feedback!

> Any reason not to use it in "package-cache-file" to get rid of the
> mlet?

No good reason, it’s a good candidate.  It’ll still be monadic though,
because of ‘gexp->derivation-in-inferior’, but perhaps we can make that
non-monadic as well eventually.

Thanks,
Ludo’.

bug#40770: [PATCH 0/5] Add declarative profiles

[Ludovic Courtès]

Hey!

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

> This is really nice and it all looks good to me. Any reason not to use
> it in "package-cache-file" to get rid of the mlet?

Done and pushed as ccbc427f9ac8f63478f1692686b042a22c4df2c3.

Christopher Baines <mail@cbaines.net> skribis:

> This sounds great, I use Emacs in a profile for rending .org files with
> cgit, and it took a bit of fiddling to get the profile built
> properly. This'll probably make it a lot easier!

Great!  I think there are many cases where being unable to simply insert
a profile in a gexp was a hindrance.

Ludo’.