ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-11 13:49:23 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

profiles: Add lowerable <profile> record type.

Browse source 
* guix/profiles.scm (<profile>): New record type.
* tests/profiles.scm ("<profile>"): New test.
This commit is contained in:
Ludovic Courtès 2020-04-22 15:43:43 +02:00
parent 1408e2abeb
commit ef674a24c5
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 48 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
guix/profiles.scm
View file

@ -125,6 +125,15 @@ (define-module (guix profiles)
profile-derivation profile-derivation
profile-search-paths profile-search-paths
profile
profile?
profile-name
profile-content
profile-hooks
profile-locales?
profile-allow-collisions?
profile-relative-symlinks?
generation-number generation-number
generation-profile generation-profile
generation-numbers generation-numbers
@ -1656,6 +1665,33 @@ (define search-paths
. ,(length . ,(length
(manifest-entries manifest)))))))) (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 (define* (profile-search-paths profile
#:optional (manifest (profile-manifest profile)) #:optional (manifest (profile-manifest profile))
#:key (getenv (const #f))) #:key (getenv (const #f)))

13
tests/profiles.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -223,6 +223,17 @@ (define glibc
(string=? (dirname (readlink bindir)) (string=? (dirname (readlink bindir))
(derivation->output-path guile)))))) (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" (test-assertm "profile-derivation relative symlinks, one entry"
(mlet* %store-monad (mlet* %store-monad
((entry -> (package->manifest-entry %bootstrap-guile)) ((entry -> (package->manifest-entry %bootstrap-guile))