[bug#60521] [60521] Add home-dotfiles-service-type - Rebased on master

[Feng Shu <tumashu@163.com>]

paul <goodoldpaul@autistici.org> writes:

> Hello Feng Shu,
>
> Apologies for the delay. I fixed the bug you pointed out for symlinks and spaces in file names. Thank you for
> catching them!
>
> About templating I would suggest you to use mixed-text-file or computed file from (guix gexp) and pass them
> directly to them home-files-service-type. It is possible to use it together with home-dotfiles-service-type.

At the moment, I use the below code, seem to work well:


(service
      home-dotfiles-service-type
      (home-dotfiles-configuration
       (directories
        (list (string-append
               (current-source-directory)
               "/dotfiles")))
       (template-config
        '((".home-dotfiles-template"
           ("var1" . "hello")
           ("var2" . "world"))))))


----------------------------------------------------------


(define-module (gee home services)
  #:use-module (gnu home services)
  #:use-module (guix build utils)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:use-module (srfi srfi-1)
  #:use-module (ice-9 ftw)
  #:use-module (ice-9 regex)
  #:use-module (ice-9 string-fun)
  #:use-module (ice-9 textual-ports)

  #:export (home-dotfiles-service-type
            home-dotfiles-configuration
            home-dotfiles-configuration?
            home-dotfiles-configuration-directories
            home-dotfiles-configuration-excluded))

(define %home-dotfiles-excluded
  '(".*~"
    ".*\\.swp"
    "\\.git"
    "\\.gitignore"))

(define-record-type* <home-dotfiles-configuration>
  home-dotfiles-configuration make-home-dotfiles-configuration
  home-dotfiles-configuration?
  (directories       home-dotfiles-configuration-directories       ;list of strings
                     (default '()))
  (excluded          home-dotfiles-configuration-excluded          ;list of strings
                     (default %home-dotfiles-excluded))
  (template-config   home-dotfiles-configuration-template-config
                     (default '())))

(define* (import-dotfiles directory excluded template-config)
  "Return a list of objects compatible with @code{home-files-service-type}'s
value.  Each object is a pair where the first element is the relative path
of a file and the second is a gexp representing the file content.  Objects are
generated by recursively visiting DIRECTORY and mapping its contents to the
user's home directory, excluding files that match any of the patterns in EXCLUDED."
  (define filtered
    (find-files directory
                (lambda (file stat)
                  (not (string-match
                        (string-append
                         "^.*(" (string-join excluded "|") ")$") file)))))
  (define (strip file)
    (string-drop file (+ 1 (string-length directory))))
  (define (resolve file)
    (if (eq? 'symlink (stat:type (lstat file)))
        (let ((resolved (readlink file)))
          (with-directory-excursion (dirname file)
            (canonicalize-path resolved)))
        file))
  (define (format file)
    (let* ((without-spaces
            (string-replace-substring file " " "_"))
           (without-slashes-and-spaces
            (string-replace-substring without-spaces "/" "-")))
      (string-append "home-dotfiles-" without-slashes-and-spaces)))

  (map (lambda (file)
         (let* ((stripped (strip file))
                (template-vars (assoc-ref template-config stripped)))
           (list stripped
                 (if template-vars
                     (plain-file (format stripped)
                                 (template-generate (resolve file) template-vars))
                     (local-file (resolve file) (format stripped))))))
       filtered))

(define (template-generate template-file template-variables)
  (let ((string (call-with-input-file template-file get-string-all)))
    (map (lambda (x)
           (let ((var (string-append "{{{" (car x) "}}}"))
                 (value (cdr x)))
             (set! string (string-replace-substring string var value))))
         template-variables)
    string))

(define (home-dotfiles-configuration->files config)
  "Return a list of objects compatible with @code{home-files-service-type}'s
value, generated following GNU Stow's algorithm for each of the
directories in CONFIG, excluding files that match any of the patterns configured."
  (define (directory-contents directories)
    (append-map
     (lambda (directory)
       (map
        (lambda (content)
          (with-directory-excursion directory
            (canonicalize-path content)))
        (scandir directory
                 (lambda (name)
                   (not (member name '("." "..")))))))
     directories))
  (append-map
   (lambda (app)
     (import-dotfiles
      app
      (home-dotfiles-configuration-excluded config)
      (home-dotfiles-configuration-template-config config)))
   (directory-contents
    (home-dotfiles-configuration-directories config))))

(define-public home-dotfiles-service-type
  (service-type (name 'home-dotfiles)
                (extensions
                 (list (service-extension home-files-service-type
                                          home-dotfiles-configuration->files)))
                (default-value (home-dotfiles-configuration))
                (description "Files that will be put in the user's home directory
following GNU Stow's algorithm, and further processed during activation.")))




>
> giacomo

--