From b48072aca0edf714cb0386ce4a82eb13c274e960 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C3=93scar=20N=C3=A1jera?= <hi@oscarnajera.com>
Date: Wed, 20 Apr 2022 13:33:01 +0200
Subject: Quick fix dotfiles copy-symlink-deltree

The folder deletion should take place only when subfolders are also
ready for deletion and link. Otherwise when going up don't register the
folder. This is only tested for my own setup on one nested level.
---
 install.scm | 46 +++++++++++++++++++++++++++-------------------
 1 file changed, 27 insertions(+), 19 deletions(-)

diff --git a/install.scm b/install.scm
index 605a8f6..05dd0bc 100755
--- a/install.scm
+++ b/install.scm
@@ -13,6 +13,12 @@
  (oop goops)
  (term ansi-color))
 
+(define-syntax ->>
+  (syntax-rules ()
+    ((_ value) value)
+    ((_ value (f ...) rest ...) (->> (f ... value) rest ...))
+    ((_ value f rest ...) (->> (f value) rest ...))))
+
 (define (ansi-color-log-formatter lvl time str)
   (let ((color (cond ((eq? lvl 'CRITICAL) 'RED)
                      ((eq? lvl 'WARN) 'YELLOW)
@@ -102,7 +108,8 @@
 (define (config-links src target dry-run)
   (let ((src-path (expand-file src))
         (target-path (dot-replace (expand-file target))))
-    (unless (and (symlink? target-path) (equal? (readlink target-path) src-path))
+    (unless (and (symlink? target-path)
+                 (equal? (readlink target-path) src-path))
       (rm-tree target-path dry-run)
       (make-dir-parents (dirname target-path))
       (symlink src-path target-path)
@@ -114,35 +121,36 @@
   then symlink the files not the dir"
 
   (define src-len (string-length file-name))
+  (define (target-subfile path)
+    (->> (substring path src-len)
+         (string-append target-path)
+         dot-replace
+         expand-file))
 
   (define (enter? name stat result)
-    (let* ((subdir (substring name src-len))
-           (target-subdir (expand-file (dot-replace (string-append target-path subdir)))))
-      (false-if-exception (eq? 'directory (stat:type (lstat target-subdir))))))
+    (->> (target-subfile name)
+         lstat
+         stat:type
+         (eq? 'directory)
+         false-if-exception))
 
   (define (leaf name stat result)
-    (let* ((subfile (substring name src-len))
-           (target-subfile (string-append target-path subfile)))
-      (config-links name target-subfile #f))
-
+    (config-links name (target-subfile name) #f)
     (set-car! result (1+ (car result)))
     result)
 
   (define (down name stat result)
     (log-msg 'INFO (format #f "Inspecting ~a" name ))
     (cons 0 result))
+
   (define (up name stat result)
-    (let* ((subdir (substring name src-len))
-           (target-subdir (expand-file (dot-replace (string-append target-path subdir))))
-           (target-subdir-file-count (length (scandir target-subdir
-                                                      (lambda (x)
-                                                        (not (member x (list "." ".."))))))))
-      ;(format #t " up on ~a ~a ~a ~a ~%" result name target-subdir target-subdir-file-count)
-      (when (= (car result) target-subdir-file-count)
-        ;(format #t "~% Clear ~a because is identical to source" name)
-        (leaf name stat result)))
-
-    (list-set! result 1 (1+ (cadr result)))
+    (let ((should-clear (->> (scandir (target-subfile name)
+                                      (lambda (x)
+                                        (not (member x (list "." "..")))))
+                             (length)
+                             (= (car result)))))
+      (when should-clear (leaf name stat result))
+      (list-set! result 1 (+ (cadr result) (if should-clear 1 0))))
     (cdr result))
   ;; Likewise for skipped directories.
   (define skip leaf)
-- 
cgit v1.2.3