projects/guix·blob python-team · refs

229 lines · 7.3 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2021 Xinglu Chen <[email protected]>
3;;; Copyright © 2022 Arjan Adriaanse <[email protected]>
4;;;
5;;; This file is part of GNU Guix.
6;;;
7;;; GNU Guix is free software; you can redistribute it and/or modify it
8;;; under the terms of the GNU General Public License as published by
9;;; the Free Software Foundation; either version 3 of the License, or (at
10;;; your option) any later version.
11;;;
12;;; GNU Guix is distributed in the hope that it will be useful, but
13;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;;; GNU General Public License for more details.
16;;;
17;;; You should have received a copy of the GNU General Public License
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19
20(define-module (test-home-import)
21 #:use-module (guix scripts home import)
22 #:use-module (guix utils)
23 #:use-module (guix build utils)
24 #:use-module (guix packages)
25 #:use-module (ice-9 match)
26 #:use-module ((guix read-print) #:select (blank?))
27 #:use-module ((guix profiles) #:hide (manifest->code))
28 #:use-module ((guix build syscalls) #:select (mkdtemp!))
29 #:use-module ((guix scripts package)
30 #:select (manifest-entry-version-prefix))
31 #:use-module (gnu packages)
32 #:use-module (srfi srfi-1)
33 #:use-module (srfi srfi-26)
34 #:use-module (srfi srfi-64))
35
36;; Test the (guix scripts home import) tools.
37
38(test-begin "home-import")
39
40;; Example manifest entries.
41
42(define guile-2.0.9
43 (manifest-entry
44 (name "guile")
45 (version "2.0.9")
46 (item "/gnu/store/...")))
47
48(define glibc
49 (manifest-entry
50 (name "glibc")
51 (version "2.19")
52 (item "/gnu/store/...")))
53
54(define gcc
55 (manifest-entry
56 (name "gcc")
57 (version "")
58 (output "lib")
59 (item "/gnu/store/...")))
60
61;; Helpers for checking and generating home environments.
62
63(define %destination-directory "/tmp/guix-config")
64(mkdir-p %destination-directory)
65
66(define %temporary-home-directory (mkdtemp! "/tmp/guix-home-import.XXXXXX"))
67
68(define-syntax-rule (define-home-environment-matcher name pattern)
69 (define (name obj)
70 (match obj
71 (pattern #t)
72 (x (pk 'fail x #f)))))
73
74(define (create-temporary-home files-alist)
75 "Create a temporary home directory in '%temporary-home-directory'.
76FILES-ALIST is an association list of files and the content of the
77corresponding file."
78 (define (create-file file content)
79 (let ((absolute-path (string-append %temporary-home-directory "/" file)))
80 (unless (file-exists? absolute-path)
81 (mkdir-p (dirname absolute-path)))
82 (call-with-output-file absolute-path
83 (cut display content <>))))
84
85 (for-each (match-lambda
86 ((file . content) (create-file file content)))
87 files-alist))
88
89(define (remove-recursively pred sexp)
90 "Like SRFI-1 'remove', but recurse within SEXP."
91 (let loop ((sexp sexp))
92 (match sexp
93 ((lst ...)
94 (map loop (remove pred lst)))
95 (x x))))
96
97(define (eval-test-with-home-environment files-alist manifest matcher)
98 (create-temporary-home files-alist)
99 (setenv "HOME" %temporary-home-directory)
100 (mkdir-p %temporary-home-directory)
101 (let* ((home-environment (manifest+configuration-files->code
102 manifest %destination-directory))
103 (result (matcher (remove-recursively blank? home-environment))))
104 (delete-file-recursively %temporary-home-directory)
105 result))
106
107(define-home-environment-matcher match-home-environment-no-services
108 ('begin
109 ('use-modules
110 ('gnu 'home)
111 ('gnu 'packages)
112 ('gnu 'services))
113 ('home-environment
114 ('packages
115 ('specifications->packages
116 ('list "[email protected]" "gcc:lib" "[email protected]")))
117 ('services
118 ('append ('list) '%base-home-services)))))
119
120(define-home-environment-matcher match-home-environment-transformations
121 ('begin
122 ('use-modules
123 ('gnu 'home)
124 ('gnu 'packages)
125 ('gnu 'services)
126 ('guix 'transformations))
127
128 ('define transform ('options->transformation _))
129 ('home-environment
130 ('packages
131 ('list (transform ('specification->package "[email protected]"))
132 ('list ('specification->package "gcc") "lib")
133 ('specification->package "[email protected]")))
134 ('services ('append ('list) '%base-home-services)))))
135
136(define-home-environment-matcher match-home-environment-no-services-nor-packages
137 ('begin
138 ('use-modules
139 ('gnu 'home)
140 ('gnu 'packages)
141 ('gnu 'services))
142 ('home-environment
143 ('packages
144 ('specifications->packages ('list)))
145 ('services
146 ('append ('list) '%base-home-services)))))
147
148(define-home-environment-matcher match-home-environment-bash-service
149 ('begin
150 ('use-modules
151 ('gnu 'home)
152 ('gnu 'packages)
153 ('gnu 'services)
154 ('guix 'gexp)
155 ('gnu 'home 'services 'shells))
156 ('home-environment
157 ('packages
158 ('specifications->packages ('list)))
159 ('services
160 (append ('list ('service
161 'home-bash-service-type
162 ('home-bash-configuration
163 ('aliases ('quote ()))
164 ('bashrc
165 ('list ('local-file "/tmp/guix-config/.bashrc"
166 "bashrc"))))))
167 '%base-home-services)))))
168
169(define-home-environment-matcher match-home-environment-bash-service-with-alias
170 ('begin
171 ('use-modules
172 ('gnu 'home)
173 ('gnu 'packages)
174 ('gnu 'services)
175 ('guix 'gexp)
176 ('gnu 'home 'services 'shells))
177 ('home-environment
178 ('packages
179 ('specifications->packages ('list)))
180 ('services
181 ('append ('list ('service
182 'home-bash-service-type
183 ('home-bash-configuration
184 ('aliases
185 ('quote (("grep" . "grep --exclude-from=\"$HOME/.grep-exclude\"")
186 ("ls" . "ls -p"))))
187 ('bashrc
188 ('list ('local-file "/tmp/guix-config/.bashrc"
189 "bashrc"))))))
190 '%base-home-services)))))
191
192
193(test-assert "manifest->code: No services"
194 (eval-test-with-home-environment
195 '()
196 (make-manifest (list guile-2.0.9 gcc glibc))
197 match-home-environment-no-services))
198
199(test-assert "manifest->code: No services, package transformations"
200 (eval-test-with-home-environment
201 '()
202 (make-manifest (list (manifest-entry
203 (inherit guile-2.0.9)
204 (properties `((transformations
205 . ((foo . "bar"))))))
206 gcc glibc))
207 match-home-environment-transformations))
208
209(test-assert "manifest->code: No packages nor services"
210 (eval-test-with-home-environment
211 '()
212 (make-manifest '())
213 match-home-environment-no-services-nor-packages))
214
215(test-assert "manifest->code: Bash service"
216 (eval-test-with-home-environment
217 '((".bashrc" . "echo 'hello guix'"))
218 (make-manifest '())
219 match-home-environment-bash-service))
220
221(test-assert "manifest->code: Bash service with aliases"
222 (eval-test-with-home-environment
223 '((".bashrc"
224 . "# Aliases
225alias ls=\"ls -p\"; alias grep='grep --exclude-from=\"$HOME/.grep-exclude\"'\n"))
226 (make-manifest '())
227 match-home-environment-bash-service-with-alias))
228
229(test-end "home-import")