203 lines
7.9 KiB
Scheme
203 lines
7.9 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
|
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
|
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
|
|
;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org>
|
|
;;; Copyright © 2022 Arjan Adriaanse <arjan@adriaan.se>
|
|
;;; Copyright © 2022 Antero Mejr <antero@mailbox.org>
|
|
;;;
|
|
;;; 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 <http://www.gnu.org/licenses/>.
|
|
|
|
(define-module (guix scripts home import)
|
|
#:use-module (guix profiles)
|
|
#:use-module (guix ui)
|
|
#:use-module (guix utils)
|
|
#:use-module (guix packages)
|
|
#:autoload (guix scripts package) (manifest-entry-version-prefix)
|
|
#:use-module (guix read-print)
|
|
#:use-module (gnu packages)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (ice-9 rdelim)
|
|
#:use-module (ice-9 regex)
|
|
#:use-module (ice-9 popen)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-26)
|
|
#:export (import-manifest
|
|
|
|
;; For tests.
|
|
manifest+configuration-files->code))
|
|
|
|
;;; Commentary:
|
|
;;;
|
|
;;; This module provides utilities for generating home service
|
|
;;; configurations from existing "dotfiles".
|
|
;;;
|
|
;;; Code:
|
|
|
|
(define (basename+remove-dots file-name)
|
|
"Remove the dot from the dotfile FILE-NAME; replace the other dots in
|
|
FILE-NAME with \"-\", and return the basename of it."
|
|
(string-map (match-lambda
|
|
(#\. #\-)
|
|
(c c))
|
|
(let ((base (basename file-name)))
|
|
(if (string-prefix? "." base)
|
|
(string-drop base 1)
|
|
base))))
|
|
|
|
(define (generate-bash-configuration+modules destination-directory)
|
|
(define (destination-append path)
|
|
(string-append destination-directory "/" path))
|
|
|
|
(define alias-rx
|
|
(make-regexp "^alias ([^=]+)=[\"'](.+)[\"']$"))
|
|
|
|
(define (bash-alias->pair line)
|
|
(match (regexp-exec alias-rx line)
|
|
(#f #f)
|
|
(matched
|
|
`(,(match:substring matched 1) . ,(match:substring matched 2)))))
|
|
|
|
(define (parse-aliases input)
|
|
(let loop ((result '()))
|
|
(match (read-line input)
|
|
((? eof-object?)
|
|
(reverse result))
|
|
(line
|
|
(match (bash-alias->pair line)
|
|
(#f (loop result))
|
|
(alias (loop (cons alias result))))))))
|
|
|
|
(let ((rc (destination-append ".bashrc"))
|
|
(profile (destination-append ".bash_profile"))
|
|
(logout (destination-append ".bash_logout")))
|
|
`((service home-bash-service-type
|
|
(home-bash-configuration
|
|
,@(if (file-exists? rc)
|
|
`((aliases
|
|
',(let* ((port (open-pipe* OPEN_READ "bash" "-i" "-c" "alias"))
|
|
(alist (parse-aliases port)))
|
|
(close-port port)
|
|
alist)))
|
|
'())
|
|
,@(if (file-exists? rc)
|
|
`((bashrc
|
|
(list (local-file ,rc
|
|
,(basename+remove-dots rc)))))
|
|
'())
|
|
,@(if (file-exists? profile)
|
|
`((bash-profile
|
|
(list (local-file ,profile
|
|
,(basename+remove-dots profile)))))
|
|
'())
|
|
,@(if (file-exists? logout)
|
|
`((bash-logout
|
|
(list (local-file ,logout
|
|
,(basename+remove-dots logout)))))
|
|
'())))
|
|
(guix gexp)
|
|
(gnu home services shells))))
|
|
|
|
(define %files+configurations-alist
|
|
`((".bashrc" . ,generate-bash-configuration+modules)
|
|
(".bash_profile" . ,generate-bash-configuration+modules)
|
|
(".bash_logout" . ,generate-bash-configuration+modules)))
|
|
|
|
(define (configurations+modules configuration-directory)
|
|
"Return a list of procedures which when called, generate code for a home
|
|
service declaration. Copy configuration files to CONFIGURATION-DIRECTORY; the
|
|
generated service declarations will refer to those files that have been saved
|
|
in CONFIGURATION-DIRECTORY."
|
|
(define configurations
|
|
(delete-duplicates
|
|
(filter-map (match-lambda
|
|
((file . proc)
|
|
(let ((absolute-path (string-append (getenv "HOME")
|
|
"/" file)))
|
|
(and (file-exists? absolute-path)
|
|
(begin
|
|
(copy-file absolute-path
|
|
(string-append
|
|
configuration-directory "/" file))
|
|
proc)))))
|
|
%files+configurations-alist)
|
|
eq?))
|
|
|
|
(map (lambda (proc) (proc configuration-directory)) configurations))
|
|
|
|
(define (manifest+configuration-files->code manifest
|
|
configuration-directory)
|
|
"Read MANIFEST and the user's configuration files listed in
|
|
%FILES+CONFIGURATIONS-ALIST, and return a 'home-environment' sexp. Copy the
|
|
user's files to CONFIGURATION-DIRECTORY; the generated sexp refers to them."
|
|
(match (manifest->code manifest
|
|
#:entry-package-version
|
|
manifest-entry-version-prefix)
|
|
(('begin ('use-modules profile-modules ...)
|
|
definitions ... ('packages->manifest packages))
|
|
(match (configurations+modules configuration-directory)
|
|
(((services . modules) ...)
|
|
`(begin
|
|
(use-modules (gnu home)
|
|
(gnu packages)
|
|
(gnu services)
|
|
,@(delete-duplicates
|
|
(append profile-modules (concatenate modules))))
|
|
|
|
,@definitions
|
|
|
|
(home-environment
|
|
(packages ,packages)
|
|
(services (list ,@services)))))))
|
|
(('begin ('specifications->manifest packages))
|
|
(match (configurations+modules configuration-directory)
|
|
(((services . modules) ...)
|
|
`(begin
|
|
(use-modules (gnu home)
|
|
(gnu packages)
|
|
(gnu services)
|
|
,@(delete-duplicates (concatenate modules)))
|
|
|
|
,(vertical-space 1)
|
|
|
|
(home-environment
|
|
,(comment (G_ "\
|
|
;; Below is the list of packages that will show up in your
|
|
;; Home profile, under ~/.guix-home/profile.\n"))
|
|
(packages
|
|
(specifications->packages ,packages))
|
|
|
|
,(vertical-space 1)
|
|
,(comment (G_ "\
|
|
;; Below is the list of Home services. To search for available
|
|
;; services, run 'guix home search KEYWORD' in a terminal.\n"))
|
|
(services (list ,@services)))))))))
|
|
|
|
(define* (import-manifest
|
|
manifest destination-directory
|
|
#:optional (port (current-output-port)))
|
|
"Write to PORT a <home-environment> corresponding to MANIFEST."
|
|
(match (manifest+configuration-files->code manifest
|
|
destination-directory)
|
|
(('begin exp ...)
|
|
(format port (G_ "\
|
|
;; This \"home-environment\" file can be passed to 'guix home reconfigure'
|
|
;; to reproduce the content of your profile. This is \"symbolic\": it only
|
|
;; specifies package names. To reproduce the exact same profile, you also
|
|
;; need to capture the channels being used, as returned by \"guix describe\".
|
|
;; See the \"Replicating Guix\" section in the manual.\n"))
|
|
(newline port)
|
|
(pretty-print-with-comments/splice port exp))))
|