;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021 Xinglu Chen ;;; Copyright © 2022 Arjan Adriaanse ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (test-home-import) #:use-module (guix scripts home import) #:use-module (guix utils) #:use-module (guix build utils) #:use-module (guix packages) #:use-module (ice-9 match) #:use-module ((guix read-print) #:select (blank?)) #:use-module ((guix profiles) #:hide (manifest->code)) #:use-module ((guix build syscalls) #:select (mkdtemp!)) #:use-module ((guix scripts package) #:select (manifest-entry-version-prefix)) #:use-module (gnu packages) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64)) ;; Test the (guix scripts home import) tools. (test-begin "home-import") ;; Example manifest entries. (define guile-2.0.9 (manifest-entry (name "guile") (version "2.0.9") (item "/gnu/store/..."))) (define glibc (manifest-entry (name "glibc") (version "2.19") (item "/gnu/store/..."))) (define gcc (manifest-entry (name "gcc") (version "") (output "lib") (item "/gnu/store/..."))) ;; Helpers for checking and generating home environments. (define %destination-directory "/tmp/guix-config") (mkdir-p %destination-directory) (define %temporary-home-directory (mkdtemp! "/tmp/guix-home-import.XXXXXX")) (define-syntax-rule (define-home-environment-matcher name pattern) (define (name obj) (match obj (pattern #t) (x (pk 'fail x #f))))) (define (create-temporary-home files-alist) "Create a temporary home directory in '%temporary-home-directory'. FILES-ALIST is an association list of files and the content of the corresponding file." (define (create-file file content) (let ((absolute-path (string-append %temporary-home-directory "/" file))) (unless (file-exists? absolute-path) (mkdir-p (dirname absolute-path))) (call-with-output-file absolute-path (cut display content <>)))) (for-each (match-lambda ((file . content) (create-file file content))) files-alist)) (define (remove-recursively pred sexp) "Like SRFI-1 'remove', but recurse within SEXP." (let loop ((sexp sexp)) (match sexp ((lst ...) (map loop (remove pred lst))) (x x)))) (define (eval-test-with-home-environment files-alist manifest matcher) (create-temporary-home files-alist) (setenv "HOME" %temporary-home-directory) (mkdir-p %temporary-home-directory) (let* ((home-environment (manifest+configuration-files->code manifest %destination-directory)) (result (matcher (remove-recursively blank? home-environment)))) (delete-file-recursively %temporary-home-directory) result)) (define-home-environment-matcher match-home-environment-no-services ('begin ('use-modules ('gnu 'home) ('gnu 'packages) ('gnu 'services)) ('home-environment ('packages ('specifications->packages ('list "guile@2.0.9" "gcc:lib" "glibc@2.19"))) ('services ('list))))) (define-home-environment-matcher match-home-environment-transformations ('begin ('use-modules ('gnu 'home) ('gnu 'packages) ('gnu 'services) ('guix 'transformations))2016-04-14gnu: packages: Use 'search-patches' everywhere....Alex Kost 2016-02-23gnu: Add rdmd....Roel Janssen 2016-01-06gnu: ldc: Fix license....Ludovic Courtès 2016-01-05gnu: Add LDC....Roel Janssen
    'home 'services 'shells)) ('home-environment ('packages ('specifications->packages ('list))) ('services ('list ('service 'home-bash-service-type ('home-bash-configuration ('aliases ('quote (("grep" . "grep --exclude-from=\"$HOME/.grep-exclude\"") ("ls" . "ls -p")))) ('bashrc ('list ('local-file "/tmp/guix-config/.bashrc" "bashrc")))))))))) (test-assert "manifest->code: No services" (eval-test-with-home-environment '() (make-manifest (list guile-2.0.9 gcc glibc)) match-home-environment-no-services)) (test-assert "manifest->code: No services, package transformations" (eval-test-with-home-environment '() (make-manifest (list (manifest-entry (inherit guile-2.0.9) (properties `((transformations . ((foo . "bar")))))) gcc glibc)) match-home-environment-transformations)) (test-assert "manifest->code: No packages nor services" (eval-test-with-home-environment '() (make-manifest '()) match-home-environment-no-services-nor-packages)) (test-assert "manifest->code: Bash service" (eval-test-with-home-environment '((".bashrc" . "echo 'hello guix'")) (make-manifest '()) match-home-environment-bash-service)) (test-assert "manifest->code: Bash service with aliases" (eval-test-with-home-environment '((".bashrc" . "# Aliases alias ls=\"ls -p\"; alias grep='grep --exclude-from=\"$HOME/.grep-exclude\"'\n")) (make-manifest '()) match-home-environment-bash-service-with-alias)) (test-end "home-import")