Commit | Line | Data |
---|---|---|
40acbaf0 XC |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> | |
d7fb57bc | 3 | ;;; Copyright © 2022 Arjan Adriaanse <arjan@adriaan.se> |
40acbaf0 XC |
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) | |
76c58ed5 | 26 | #:use-module ((guix read-print) #:select (blank?)) |
40acbaf0 XC |
27 | #:use-module ((guix profiles) #:hide (manifest->code)) |
28 | #:use-module ((guix build syscalls) #:select (mkdtemp!)) | |
96728c54 LC |
29 | #:use-module ((guix scripts package) |
30 | #:select (manifest-entry-version-prefix)) | |
40acbaf0 XC |
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") | |
d7fb57bc AA |
57 | (version "") |
58 | (output "lib") | |
40acbaf0 XC |
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'. | |
76 | FILES-ALIST is an association list of files and the content of the | |
77 | corresponding 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 | ||
76c58ed5 LC |
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 | ||
40acbaf0 XC |
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) | |
6f4ca787 LC |
101 | (let* ((home-environment (manifest+configuration-files->code |
102 | manifest %destination-directory)) | |
76c58ed5 | 103 | (result (matcher (remove-recursively blank? home-environment)))) |
40acbaf0 XC |
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 | |
7041fe06 AM |
115 | ('specifications->packages |
116 | ('list "guile@2.0.9" "gcc:lib" "glibc@2.19"))) | |
40acbaf0 XC |
117 | ('services |
118 | ('list))))) | |
119 | ||
6f4ca787 LC |
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 "guile@2.0.9")) | |
d7fb57bc | 132 | ('list ('specification->package "gcc") "lib") |
6f4ca787 LC |
133 | ('specification->package "glibc@2.19"))) |
134 | ('services ('list))))) | |
135 | ||
40acbaf0 XC |
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 | |
7041fe06 | 144 | ('specifications->packages ('list))) |
40acbaf0 XC |
145 | ('services |
146 | ('list))))) | |
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 | |
7041fe06 | 158 | ('specifications->packages ('list))) |
40acbaf0 XC |
159 | ('services |
160 | ('list ('service | |
161 | 'home-bash-service-type | |
162 | ('home-bash-configuration | |
f3597658 | 163 | ('aliases ('quote ())) |
40acbaf0 | 164 | ('bashrc |
ea19381b XC |
165 | ('list ('local-file "/tmp/guix-config/.bashrc" |
166 | "bashrc")))))))))) | |
40acbaf0 | 167 | |
6da2a5a5 LC |
168 | (define-home-environment-matcher match-home-environment-bash-service-with-alias |
169 | ('begin | |
170 | ('use-modules | |
171 | ('gnu 'home) | |
172 | ('gnu 'packages) | |
173 | ('gnu 'services) | |
174 | ('guix 'gexp) | |
175 | ('gnu 'home 'services 'shells)) | |
176 | ('home-environment | |
177 | ('packages | |
7041fe06 | 178 | ('specifications->packages ('list))) |
6da2a5a5 LC |
179 | ('services |
180 | ('list ('service | |
181 | 'home-bash-service-type | |
182 | ('home-bash-configuration | |
183 | ('aliases | |
184 | ('quote (("grep" . "grep --exclude-from=\"$HOME/.grep-exclude\"") | |
185 | ("ls" . "ls -p")))) | |
186 | ('bashrc | |
187 | ('list ('local-file "/tmp/guix-config/.bashrc" | |
188 | "bashrc")))))))))) | |
189 | ||
6f4ca787 | 190 | |
40acbaf0 XC |
191 | (test-assert "manifest->code: No services" |
192 | (eval-test-with-home-environment | |
193 | '() | |
194 | (make-manifest (list guile-2.0.9 gcc glibc)) | |
195 | match-home-environment-no-services)) | |
196 | ||
6f4ca787 LC |
197 | (test-assert "manifest->code: No services, package transformations" |
198 | (eval-test-with-home-environment | |
199 | '() | |
200 | (make-manifest (list (manifest-entry | |
201 | (inherit guile-2.0.9) | |
202 | (properties `((transformations | |
203 | . ((foo . "bar")))))) | |
204 | gcc glibc)) | |
205 | match-home-environment-transformations)) | |
206 | ||
40acbaf0 XC |
207 | (test-assert "manifest->code: No packages nor services" |
208 | (eval-test-with-home-environment | |
209 | '() | |
210 | (make-manifest '()) | |
211 | match-home-environment-no-services-nor-packages)) | |
212 | ||
213 | (test-assert "manifest->code: Bash service" | |
214 | (eval-test-with-home-environment | |
215 | '((".bashrc" . "echo 'hello guix'")) | |
216 | (make-manifest '()) | |
217 | match-home-environment-bash-service)) | |
218 | ||
6da2a5a5 LC |
219 | (test-assert "manifest->code: Bash service with aliases" |
220 | (eval-test-with-home-environment | |
221 | '((".bashrc" | |
222 | . "# Aliases | |
223 | alias ls=\"ls -p\"; alias grep='grep --exclude-from=\"$HOME/.grep-exclude\"'\n")) | |
224 | (make-manifest '()) | |
225 | match-home-environment-bash-service-with-alias)) | |
226 | ||
40acbaf0 | 227 | (test-end "home-import") |