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.

1 files 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)