On 2021-08-27 10:55, Jelle Licht wrote:

> Hey Andrew,
>
> some nits, as requested!
>
> Andrew Tropin <andrew@trop.in> writes:
>
>> ---
>> This patch is targeted against wip-guix-home branch.
>>
>> It's not a part of any patch series to make sure it will get enough attention,
>> because it's most unpure part of the Guix Home and operates on user's files.
>>
>>  gnu/home-services/symlink-manager.scm | 248 ++++++++++++++++++++++++++
>>  1 file changed, 248 insertions(+)
>>  create mode 100644 gnu/home-services/symlink-manager.scm
>>
>> diff --git a/gnu/home-services/symlink-manager.scm b/gnu/home-services/symlink-manager.scm
>> new file mode 100644
>> index 0000000000..f13c9f4dbe
>> --- /dev/null
>> +++ b/gnu/home-services/symlink-manager.scm
>> @@ -0,0 +1,248 @@
>> +;;; GNU Guix --- Functional package management for GNU
>> +;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
>> +;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
>> +;;;
>> +;;; 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 (gnu home-services symlink-manager)
>> +  #:use-module (gnu home-services)
>> +  #:use-module (guix gexp)
>> +
>> +  #:export (home-symlink-manager-service-type))
>> +
>> +;;; Comment:
>> +;;;
>> +;;; symlink-manager cares about configuration files: it backups files
>
> s/backups/backs up
>
>> +;;; created by user, removes symlinks and directories created by
> missing the/a
>> +;;; previous generation, and creates new directories and symlinks to
>> +;;; configs according to content of files/ directory of current home
>
> I don't really get the last part of this sentence.
>

Slightly rewrote it, hope now it's easier to understand:

;;; symlink-manager cares about configuration files: it backs up files
;;; created by user, removes symlinks and directories created by a
;;; previous generation, and creates new directories and symlinks to
;;; configuration files according to the content of files/ directory
;;; (created by home-files-service) of the current home environment
;;; generation.

>
>> +;;; environment generation (created by home-files-service).
>> +;;;
>> +;;; Code:
>> +
>> +(define (update-symlinks-script)
>> +  (program-file
>> +   "update-symlinks"
>> +   #~(begin
>> +       (use-modules (ice-9 ftw)
>> +		    (ice-9 curried-definitions)
>> +		    (ice-9 match)
>> +		    (srfi srfi-1))
> The formatting seems off. In addition, I notice there are tab characters
> in the patch for some reason, you should be able to have emacs Do The
> Right Thing if you hack within a Guix git checkout.

Already fixed.

>
>> +       (define ((simplify-file-tree parent) file)
>> +         "Convert the result produced by `file-system-tree' to less
>> +verbose and more suitable for further processing format.
>> +
>> +Extract dir/file info from stat and compose a relative path to the
>> +root of the file tree.
>> +
>> +Sample output:
>> +
>> +((dir . \".\")
>> + ((dir . \"config\")
>> +  ((dir . \"config/fontconfig\")
>> +   (file . \"config/fontconfig/fonts.conf\"))
>> +  ((dir . \"config/isync\")
>> +   (file . \"config/isync/mbsyncrc\"))))
>> +"
>> +	 (match file
>> +	   ((name stat) `(file . ,(string-append parent name)))
>> +	   ((name stat children ...)
>> +	    (cons `(dir . ,(string-append parent name))
>> +		  (map (simplify-file-tree
>> +			(if (equal? name ".")
>> +			    ""
>> +			    (string-append parent name "/")))
>> +		       children)))))
>> +
>> +       (define ((file-tree-traverse preordering) node)
>> +	 "Traverses the file tree in different orders, depending on PREORDERING.
>> +
>> +if PREORDERING is @code{#t} resulting list will contain folders before
>> +files located in those folders, otherwise folders will appear only
>> +after all nested items already listed."
> s/folders/(sub-)directories

Done.

>> +	 (let ((prepend (lambda (a b) (append b a))))
>> +	   (match node
>> +	     (('file . path) (list node))
>> +	     ((('dir . path) . rest)
>> +	      ((if preordering append prepend)
>> +	       (list (cons 'dir path))
>> +	       (append-map (file-tree-traverse preordering) rest))))))
>> +
>> +       (use-modules (guix build utils))
>> +
>> +       (let* ((he-path (string-append (getenv "HOME") "/.guix-home"))
>> +              (new-he-tmp-path (string-append he-path ".new"))
>> +              (new-home (getenv "GUIX_NEW_HOME")))
>> +         (symlink new-home new-he-tmp-path)
>> +         (rename-file new-he-tmp-path he-path))
>> +
>> +       (let* ((config-home    (or (getenv "XDG_CONFIG_HOME")
>> +				  (string-append (getenv "HOME") "/.config")))
>> +
>> +	      (he-path (string-append (getenv "HOME") "/.guix-home"))
>> +              (new-he-tmp-path (string-append he-path ".new"))
>
> This is a path to a transient location for the new home environment,
> correct?

Yup.

> 
> tmp-path, to me at least, evokes a place where temporary files are
> stored, contrasted to a temporary home for important files.
>

Removed tmp suffix.

>
>> +
>> +	      (files-path (string-append he-path "/files"))
>> +	      ;; Leading dot is required, because files itself is symlink and
>> +	      ;; to make file-system-tree works it should be a directory.
>> +	      (files-dir-path (string-append files-path "/."))
>> +	      (new-files-path (string-append new-he-tmp-path "/files"))
>> +	      (new-files-dir-path (string-append files-path "/."))
>> +
>> +	      (home-path (getenv "HOME"))
>> +	      (backup-dir (string-append home-path "/"
>> +					 (number->string (current-time))
>> +					 "-guix-home-legacy-configs-backup"))
>> +
>> +	      (old-tree (if (file-exists? files-dir-path)
>> +                          ((simplify-file-tree "")
>> +			   (file-system-tree files-dir-path))
>> +                          #f))
>> +	      (new-tree ((simplify-file-tree "")
>> +			 (file-system-tree new-files-dir-path)))
>> +
>
>> +	      (get-source-path
>> +	       (lambda (path)
>> +		 (readlink (string-append files-path "/" path))))
>> +
>> +	      (get-target-path
>> +	       (lambda (path)
>> +		 (string-append home-path "/." path)))
>> +
>> +	      (get-backup-path
>> +	       (lambda (path)
>> +		 (string-append backup-dir "/." path)))
>> +
>> +	      (directory?
>> +	       (lambda (path)
>> +		 (equal? (stat:type (stat path)) 'directory)))
>> +
>> +	      (empty-directory?
>> +	       (lambda (dir)
>> +		 (equal? (scandir dir) '("." ".."))))
>> +
>> +	      (symlink-to-store?
>> +	       (lambda (path)
>> +		 (and
>> +		  (equal? (stat:type (lstat path)) 'symlink)
>> +		  (store-file-name? (readlink path)))))
>> +
>> +	      (backup-file
>> +	       (lambda (path)
>> +		 (mkdir-p backup-dir)
>> +		 (format #t "Backing up ~a..." (get-target-path path))
>> +		 (mkdir-p (dirname (get-backup-path path)))
>> +		 (rename-file (get-target-path path) (get-backup-path path))
>> +		 (display " done\n")))
>
> A couple of the previous lambdas could have been `define'd (as a nested
> define) instead of put in this binding form.
>

Yes, but some of them are closures and have to be in the let or deeper
in the tree, so I decided to put them all in the let.

>
>> +
>> +	      (cleanup-symlinks
>> +	       (lambda ()
>> +		 (let ((to-delete ((file-tree-traverse #f) old-tree)))
>> +		   (display
>> +		    "Cleaning up symlinks from previous home-environment.\n\n")
>> +		   (map
>> +		    (match-lambda
>> +		      (('dir . ".")
>> +		       (display "Cleanup finished.\n\n"))
>> +
>> +		      (('dir . path)
>> +		       (if (and
>> +			    (file-exists? (get-target-path path))
>> +			    (directory? (get-target-path path))
>> +			    (empty-directory? (get-target-path path)))
>> +			   (begin
>> +			     (format #t "Removing ~a..."
>> +				     (get-target-path path))
>> +			     (rmdir (get-target-path path))
>> +			     (display " done\n"))
>
> I think a let-binding for (get-target-path path) would work well here.
>
>> +			   (format
>> +			    #t "Skipping ~a (not an empty directory)... done\n"
>> +			    (get-target-path path))))
>> +
>> +		      (('file . path)
>> +		       (when (file-exists? (get-target-path path))
>> +			 ;; DO NOT remove the file if it was modified
>> +			 ;; by user (not a symlink to the /gnu/store
>> +			 ;; anymore) it will be backed up later during
>> +			 ;; create-symlinks phase.
>
> `by user' does not add anything; Referring to modified is slightly
> confusing, as I can change the symlink to point to a different file in
> the store and it will happily be deleted at this point in time.
>
> what about:
> DO NOT remote the file if it is no longer a symblink to the store. It
> will be backed up later during the create-symlinks phase.
>

Sounds good, picked this one.

>
>> +			 (if (symlink-to-store? (get-target-path path))
>> +			     (begin
>> +			       (format #t "Removing ~a..." (get-target-path path))
>> +			       (delete-file (get-target-path path))
>> +			       (display " done\n"))
>> +			     (format
>> +			      #t
>> +			      "Skipping ~a (not a symlink to store)... done\n"
>> +			      (get-target-path path))))))
>> +		    to-delete))))
>> +
>> +	      (create-symlinks
>> +	       (lambda ()
>> +		 (let ((to-create ((file-tree-traverse #t) new-tree)))
>> +		   (map
>> +		    (match-lambda
>> +		      (('dir . ".")
>> +		       (display
>> +			"New symlinks to home-environment will be created soon.\n")
>> +		       (format
>> +			#t "All conflicting files will go to ~a.\n\n" backup-dir))
>> +
>> +		      (('dir . path)
>> +		       (let ((target-path (get-target-path path)))
>> +			 (when (and (file-exists? target-path)
>> +				    (not (directory? target-path)))
>> +			   (backup-file path))
>> +
>> +			 (if (file-exists? target-path)
>> +			     (format
>> +			      #t "Skipping   ~a (directory already exists)... done\n"
>> +			      target-path)
>> +			     (begin
>> +			       (format #t "Creating   ~a..." target-path)
>> +			       (mkdir target-path)
>> +			       (display " done\n")))))
>> +
>> +		      (('file . path)
>> +		       (when (file-exists? (get-target-path path))
>> +			 (backup-file path))
>> +		       (format #t "Symlinking ~a -> ~a..."
>> +			       (get-target-path path) (get-source-path path))
>> +		       (symlink (get-source-path path) (get-target-path path))
>> +		       (display " done\n")))
>> +		    to-create)))))
>> +
>> +	 (when old-tree
>> +	   (cleanup-symlinks))
>> +
>> +	 (create-symlinks)
>> +
>> +	 (display " done\nFinished updating symlinks.\n\n")))))
>> +
>> +
>> +(define (update-symlinks-gexp _)
>> +  #~(primitive-load #$(update-symlinks-script)))
>> +
>> +(define home-symlink-manager-service-type
>> +  (service-type (name 'home-symlink-manager)
>> +                (extensions
>> +                 (list
>> +		  (service-extension
>> +		   home-activation-service-type
>> +                   update-symlinks-gexp)))
>> +		(default-value #f)
>> +                (description "Provide an @code{update-symlinks}
>> +script, which create and remove symlinks on every activation.  If the
> creates,removes.
>> +target is occupied by a file created by user, back it up.")))
> What is target? Why should I care as a user of this service :)?
> Perhaps rather than describing how the service does what it does, something in
> the spirit of;
>
> If an existing file would be overwritten by a symlink, back up
> the exiting file first.

Updated.

>
>> -- 
>> 2.33.0
>
> A nitpick I'm much less certain about is your use of display (and
> format) without using the G_ macro; Perhaps you can try to reach out to
> the folks who are most involved with the translation effort to see if
> there is something that needs to be addressed now, of whether that can
> still easily happen at a later point?
>

Yep, it's very likely that there is a better mechanism for providing
output than display function, but I think it can be easily updated
later.

> 
> Thanks again for working on this!  - Jelle

Cleaned up and updated the script.