all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 54180@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#54180] [PATCH 12/12] home: symlink-manager: Rename "path" to "file" where appropriate.
Date: Sun, 27 Feb 2022 14:53:42 +0100	[thread overview]
Message-ID: <20220227135342.10296-12-ludo@gnu.org> (raw)
In-Reply-To: <20220227135342.10296-1-ludo@gnu.org>

* gnu/home/services/symlink-manager.scm (update-symlinks-script):
[home-path]: Rename to...
[home-directory]: ... this.  Adjust users.
[backup-dir]: Rename to...
[backup-directory]: ... this.  Adjust user.
[get-target-path]: Rename to...
[target-file]: ... this.  Adjust users.
[get-backup-path]: Remove.
[backup-file]: Inline it.
[cleanup-symlinks](get-source-path): Rename to...
(source-file): ... this.  Adjust users.
Rename 'he-path' to 'home' and 'new-he-path' to 'pivot'.
---
 gnu/home/services/symlink-manager.scm | 55 ++++++++++++++-------------
 1 file changed, 28 insertions(+), 27 deletions(-)

diff --git a/gnu/home/services/symlink-manager.scm b/gnu/home/services/symlink-manager.scm
index 16e2e7b772..767b1bdc01 100644
--- a/gnu/home/services/symlink-manager.scm
+++ b/gnu/home/services/symlink-manager.scm
@@ -48,33 +48,35 @@ (define (update-symlinks-script)
                       (guix i18n)
                       (guix build utils))
 
-         (define home-path
+         (define home-directory
            (getenv "HOME"))
 
-         (define backup-dir
-           (string-append home-path "/" (number->string (current-time))
+         (define backup-directory
+           (string-append home-directory "/" (number->string (current-time))
                           "-guix-home-legacy-configs-backup"))
 
-         (define (get-target-path path)
-           (string-append home-path "/." path))
+         (define (target-file file)
+           ;; Return the target of FILE, a config file name sans leading dot
+           ;; such as "config/fontconfig/fonts.conf" or "bashrc".
+           (string-append home-directory "/." file))
 
-         (define (get-backup-path path)
-           (string-append backup-dir "/." path))
-
-         (define (symlink-to-store? path)
+         (define (symlink-to-store? file)
            (catch 'system-error
              (lambda ()
-               (store-file-name? (readlink path)))
+               (store-file-name? (readlink file)))
              (lambda args
                (if (= EINVAL (system-error-errno args))
                    #f
                    (apply throw args)))))
 
-         (define (backup-file path)
-           (mkdir-p backup-dir)
-           (format #t (G_ "Backing up ~a...") (get-target-path path))
-           (mkdir-p (dirname (get-backup-path path)))
-           (rename-file (get-target-path path) (get-backup-path path))
+         (define (backup-file file)
+           (define backup
+             (string-append backup-directory "/." file))
+
+           (mkdir-p backup-directory)
+           (format #t (G_ "Backing up ~a...") (target-file file))
+           (mkdir-p (dirname backup))
+           (rename-file (target-file file) backup)
            (display (G_ " done\n")))
 
          (define (cleanup-symlinks home-generation)
@@ -95,7 +97,7 @@ (define (strip file)
            (file-system-fold
             (const #t)
             (lambda (file stat _)                 ;leaf
-              (let ((file (get-target-path (strip file))))
+              (let ((file (target-file (strip file))))
                 (when (file-exists? file)
                   ;; DO NOT remove the file if it is no longer a symlink to
                   ;; the store, it will be backed up later during
@@ -112,7 +114,7 @@ (define (strip file)
             (const #t)                            ;down
             (lambda (directory stat _)            ;up
               (unless (string=? directory config-file-directory)
-                (let ((directory (get-target-path (strip directory))))
+                (let ((directory (target-file (strip directory))))
                   (catch 'system-error
                     (lambda ()
                       (rmdir directory)
@@ -145,14 +147,14 @@ (define (strip file)
              (string-drop file
                           (+ 1 (string-length config-file-directory))))
 
-           (define (get-source-path path)
-             (readlink (string-append config-file-directory path)))
+           (define (source-file file)
+             (readlink (string-append config-file-directory file)))
 
            (file-system-fold
             (const #t)                            ;enter?
             (lambda (file stat result)            ;leaf
-              (let ((source (get-source-path (strip file)))
-                    (target (get-target-path (strip file))))
+              (let ((source (source-file (strip file)))
+                    (target (target-file (strip file))))
                 (when (file-exists? target)
                   (backup-file (strip file)))
                 (format #t (G_ "Symlinking ~a -> ~a...")
@@ -161,7 +163,7 @@ (define (get-source-path path)
                 (display (G_ " done\n"))))
             (lambda (directory stat result)       ;down
               (unless (string=? directory config-file-directory)
-                (let ((target (get-target-path (strip directory))))
+                (let ((target (target-file (strip directory))))
                   (when (and (file-exists? target)
                              (not (file-is-directory? target)))
                     (backup-file (strip directory)))
@@ -183,18 +185,17 @@ (define (get-source-path path)
 
          #$%initialize-gettext
 
-         (let* ((he-path (string-append (getenv "HOME") "/.guix-home"))
-                (new-he-path (string-append he-path ".new"))
+         (let* ((home     (string-append (getenv "HOME") "/.guix-home"))
+                (pivot    (string-append home ".new"))
                 (new-home (getenv "GUIX_NEW_HOME"))
                 (old-home (getenv "GUIX_OLD_HOME")))
-
            (when old-home
              (cleanup-symlinks old-home))
 
            (create-symlinks new-home)
 
-           (symlink new-home new-he-path)
-           (rename-file new-he-path he-path)
+           (symlink new-home pivot)
+           (rename-file pivot home)
 
            (display (G_" done\nFinished updating symlinks.\n\n")))))))
 
-- 
2.34.0





  parent reply	other threads:[~2022-02-27 14:01 UTC|newest]

Thread overview: 28+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-02-27 13:40 [bug#54180] [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Ludovic Courtès
2022-02-27 13:53 ` [bug#54180] [PATCH 01/12] home: symlink-manager: Clarify module imports Ludovic Courtès
2022-02-27 13:53   ` [bug#54180] [PATCH 02/12] home: symlink-manager: Move helper procedures as top-level defines Ludovic Courtès
2022-02-27 15:58     ` Maxime Devos
2022-03-10 10:28       ` [bug#54180] [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Ludovic Courtès
2022-02-27 13:53   ` [bug#54180] [PATCH 03/12] home: symlink-manager: Use 'for-each' when used for effects Ludovic Courtès
2022-02-27 13:53   ` [bug#54180] [PATCH 04/12] home: symlink-manager: Use 'file-is-directory?' Ludovic Courtès
2022-02-27 13:53   ` [bug#54180] [PATCH 05/12] home: symlink-manager: Remove 'empty-directory?' and avoid TOCTTOU race Ludovic Courtès
2022-02-27 15:54     ` Maxime Devos
2022-03-05 22:19       ` [bug#54180] [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Ludovic Courtès
2022-03-05 22:37         ` Maxime Devos
2022-02-27 13:53   ` [bug#54180] [PATCH 06/12] home: symlink-manager: Avoid extra 'lstat' call Ludovic Courtès
2022-02-27 15:52     ` Maxime Devos
2022-02-27 13:53   ` [bug#54180] [PATCH 07/12] tests: Make sure 'guix home reconfigure' backs up files Ludovic Courtès
2022-02-27 13:53   ` [bug#54180] [PATCH 08/12] tests: Simplify use of 'local-file' in 'tests/guix-home.sh' Ludovic Courtès
2022-02-27 13:53   ` [bug#54180] [PATCH 09/12] tests: Check 'guix home reconfigure' for a second generation Ludovic Courtès
2022-02-27 15:49     ` Maxime Devos
2022-03-05 22:20       ` [bug#54180] [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Ludovic Courtès
2022-03-05 22:27         ` Maxime Devos
2022-03-05 22:38           ` Maxime Devos
2022-03-10 10:24             ` Ludovic Courtès
2022-03-10 10:23           ` Ludovic Courtès
2022-02-27 13:53   ` [bug#54180] [PATCH 10/12] home: symlink-manager: 'cleanup-symlinks' uses 'file-system-fold' Ludovic Courtès
2022-02-27 13:53   ` [bug#54180] [PATCH 11/12] home: symlink-manager: 'create-symlinks' " Ludovic Courtès
2022-02-27 16:00     ` Maxime Devos
2022-02-27 13:53   ` Ludovic Courtès [this message]
2022-02-28  7:53 ` [bug#54180] [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Andrew Tropin
2022-03-10 10:45 ` bug#54180: " Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20220227135342.10296-12-ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=54180@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.