[bug#60521] [PATCH] home: Add home-stow-migration-service.

[Giacomo Leidi via Guix-patches via <guix-patches@gnu.org>]

* gnu/home/services.scm (dotfiles-for-app): New variable;
(home-stow-migration-configuration): new variable;
(home-stow-migration-service): new variable.
* doc/guix.texi: Document it.
---
 doc/guix.texi         | 50 +++++++++++++++++++++++++++++++++++++++++++
 gnu/home/services.scm | 49 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 99 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 5c85680831..40c36f65c4 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -109,6 +109,7 @@ Copyright @copyright{} 2022 Reily Siegel@*
 Copyright @copyright{} 2022 Simon Streit@*
 Copyright @copyright{} 2022 (@*
 Copyright @copyright{} 2022 John Kehayias@*
+Copyright @copyright{} 2023 Giacomo Leidi@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -41119,6 +41120,55 @@ to use alternative services to implement more advanced use cases like
 read-only home.  Feel free to experiment and share your results.
 @end defvr
 
+@deffn {Scheme Procedure} home-stow-migration-service
+Return a service which is very similiar to @code{home-files-service-type}
+(and actually extends it), but designed to ease the way into using Guix
+Home for GNU Stow users.  This service allows users to point Guix Home to
+their Stow directory and have their file automatically deployed to their home
+directory just like Stow would, without migrating all of their dotfiles to Guix
+native configurations.
+
+A typical Stow setup consists of a source directory and a target directory.
+The source directory must be structured as follows:
+
+@example
+~$ tree -a .dotfiles/
+.dotfiles/
+├── git
+│   └── .gitconfig
+├── gpg
+│   └── .gnupg
+│       ├── gpg-agent.conf
+│       └── gpg.conf
+├── guile
+│   └── .guile
+├── guix
+│   └── .config
+│       └── guix
+│           ├── channels.scm
+│           └── .gitignore
+├── nix
+│   ├── .config
+│   │   └── nixpkgs
+│   │       └── config.nix
+│   └── .nix-channels
+├── tmux
+│   └── .tmux.conf
+└── vim
+    └── .vimrc
+
+13 directories, 10 files
+@end example
+
+A suitable configuration would then be:
+
+@lisp
+  (home-stow-migration-service
+   (string-append (getenv "HOME")
+                  "/.dotfiles"))
+@end lisp
+@end deffn
+
 @defvr {Scheme Variable} home-xdg-configuration-files-service-type
 The service is very similiar to @code{home-files-service-type} (and
 actually extends it), but used for defining files, which will go to
diff --git a/gnu/home/services.scm b/gnu/home/services.scm
index 99035686f1..996647c592 100644
--- a/gnu/home/services.scm
+++ b/gnu/home/services.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +22,7 @@ (define-module (gnu home services)
   #:use-module (gnu services)
   #:use-module ((gnu packages package-management) #:select (guix))
   #:use-module ((gnu packages base) #:select (coreutils))
+  #:use-module (guix build utils)
   #:use-module (guix channels)
   #:use-module (guix monads)
   #:use-module (guix store)
@@ -33,13 +35,16 @@ (define-module (gnu home services)
   #:use-module (guix i18n)
   #:use-module (guix modules)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 string-fun)
   #:use-module (ice-9 vlist)
 
   #:export (home-service-type
             home-profile-service-type
             home-environment-variables-service-type
             home-files-service-type
+            home-stow-migration-service
             home-xdg-configuration-files-service-type
             home-xdg-data-files-service-type
             home-run-on-first-login-service-type
@@ -49,6 +54,7 @@ (define-module (gnu home services)
 
             environment-variable-shell-definitions
             home-files-directory
+            home-stow-migration-configuration
             xdg-configuration-files-directory
             xdg-data-files-directory
 
@@ -315,6 +321,49 @@ (define home-files-service-type
                 (description "Files that will be put in
 @file{~~/.guix-home/files}, and further processed during activation.")))
 
+(define (dotfiles-for-app app-dir)
+  "Return a list of objects compatible with @{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 APP-DIR and mapping its contents to the
+user's home directory."
+  (let ((app-absolute-path (canonicalize-path app-dir)))
+    (map (lambda (path)
+           (let ((app-file-relative-path
+                  (string-replace-substring path
+                                           (string-append app-absolute-path "/")
+                                           "")))
+             (list app-file-relative-path
+                   (local-file path
+                               (string-append "home-stow-migration-"
+                                              (string-replace-substring
+                                               app-file-relative-path
+                                               "/" "-"))))))
+         (find-files app-absolute-path))))
+
+(define (home-stow-migration-configuration stow-dir)
+  "Return a list of objects compatible with @{home-files-service-type}'s
+value, generated following GNU Stow's algorithm using STOW-DIR as input
+directory."
+  (define (dir-contents dir)
+    (scandir dir
+             (lambda (name)
+               (not (member name '("." ".."))))))
+  (fold append
+        '()
+        (map (lambda (app-dir)
+               (dotfiles-for-app
+                (string-append stow-dir "/" app-dir)))
+             (dir-contents stow-dir))))
+
+(define-public (home-stow-migration-service stow-dir)
+  "Return a service extending @{home-files-service-type} with files from
+STOW-DIR.  Files will be put in the user's home directory following GNU
+Stow's algorithm, and further processed during activation."
+  (simple-service 'home-stow-migration-service
+                  home-files-service-type
+                  (home-stow-migration-configuration stow-dir)))
+
 (define xdg-configuration-files-directory ".config")
 
 (define (xdg-configuration-files files)

base-commit: 473692b812b4ab4267d9bddad0fb27787d2112ff
-- 
2.38.1