tests/home-import.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
   3 ;;; Copyright © 2022 Arjan Adriaanse <arjan@adriaan.se>
   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'.
  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
  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 "guile@2.0.9" "gcc:lib" "glibc@2.19")))
 117      ('services
 118       ('list)))))
 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 "guile@2.0.9"))
 132              ('list ('specification->package "gcc") "lib")
 133              ('specification->package "glibc@2.19")))
 134      ('services ('list)))))
 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       ('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
 158       ('specifications->packages ('list)))
 159      ('services
 160       ('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
 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
 178       ('specifications->packages ('list)))
 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
 190
 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
 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
 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
 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
 227 (test-end "home-import")