From b1bbcaaf3cae88c56a104e3e340b3eb59efd239f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C3=93scar=20N=C3=A1jera?= <hi@oscarnajera.com>
Date: Sun, 25 Oct 2020 16:11:55 +0100
Subject: symlink a tree

---
 walk.scm | 67 ++++++++++++++++++++++++++++++++++++++--------------------------
 1 file changed, 40 insertions(+), 27 deletions(-)

(limited to 'walk.scm')

diff --git a/walk.scm b/walk.scm
index 4e53dca..c244bf3 100755
--- a/walk.scm
+++ b/walk.scm
@@ -6,6 +6,7 @@
              (logging port-log)
              (ice-9 ftw)
              (ice-9 match)
+             (ice-9 and-let-star)
              (oop goops)
              (term ansi-color))
 
@@ -26,45 +27,62 @@
   (false-if-exception
    (eq? 'symlink (stat:type (lstat path)))))
 
-(define (clean-file full-dest)
-  (when (false-if-exception (lstat full-dest))
-    (display (string-append "\nDeleting previous file: " full-dest))
-    ;(delete-file full-dest)
-    ))
+(define (clean-file full-dest dry-run)
+  (and-let* ((info (false-if-exception (lstat full-dest)))
+             (type (stat:type info))
+             (deleter (if (eq? type 'directory) rmdir delete-file))
+             (task (if dry-run "Would delete" "Deleting")))
+    (format #t "~a ~a: ~a~%" task type full-dest)
+    (unless dry-run (deleter full-dest))))
+
+(define (rm-tree path dry-run)
+  (define (enter? a b c) #t)
+  (define (down name stat result) result)
+  (define (leaf name stat result)
+    (clean-file name dry-run)
+    result)
+  (define up leaf)
+  (define skip leaf)
+  ;; Ignore unreadable files/directories but warn the user.
+  (define (error name stat errno result)
+    (format (current-error-port) "warning~a: ~a: ~a~%"
+            errno name (strerror errno))
+    result)
 
-(define (config-links src target)
+  (file-system-fold enter? leaf down up skip error
+                    (list 0)
+                    path))
+
+(define (config-links src target dry-run)
   (let ((src-path (expand-file src))
         (target-path (expand-file target)))
     (unless (and (symlink? target-path) (equal? (readlink target-path) src-path))
-      (clean-file target-path)
-      ;(symlink src-path target-path)
-      (display (string-append "\n  Symlink: " src " -> " target)))))
+      (rm-tree target-path dry-run)
+      (symlink src-path target-path)
+      (format #t "  Symlink: ~a -> ~a~%" src target))))
+
+(define (symlink-tree file-name target-path)
+  "Tree recursively symlinks target-path->file-name. The goal is to
+  have few symlinks, yet if in the target space there are some files
+  then symlink the files not the dir"
 
-(define (total-file-size file-name target-path)
-  "Return the size in bytes of the files under FILE-NAME (similar
-          to `du --apparent-size' with GNU Coreutils.)"
   (define src-len (string-length file-name))
 
   (define (enter? name stat result)
-    ;; Skip version control directories.
     (let* ((subdir (substring name src-len))
            (target-subdir (string-append target-path subdir)))
-      (format #t "~%~a: ~a | ~a ~a" name subdir target-subdir (stat:type stat))
-      (false-if-exception (eq? 'directory (stat:type (lstat target-subdir))))
-      ))
+      (format #t "~a: ~a | ~a ~a~%" name subdir target-subdir (stat:type stat))
+      (false-if-exception (eq? 'directory (stat:type (lstat target-subdir))))))
 
   (define (leaf name stat result)
-    ;; Return RESULT plus the size of the file at NAME.
     (let* ((subfile (substring name src-len))
            (target-subfile (string-append target-path subfile)))
-      (config-links name target-subfile))
+      (config-links name target-subfile #f))
 
     (set-car! result (1+ (car result)))
     result)
 
-  ;; Count zero bytes for directories.
   (define (down name stat result)
-    (format #t "~% down on ~a" name)
     (cons 0 result))
   (define (up name stat result)
     (let* ((subdir (substring name src-len))
@@ -72,7 +90,7 @@
            (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)
+      (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)))
@@ -93,9 +111,4 @@
                     file-name))
 
 
-(total-file-size "config" "/home/titan/.config")
-
-(let ((di "/home/titan/.config/you"))
-  (false-if-exception (eq? 'directory (stat:type (lstat di)))))
-
-(error "hci" #f)
+(symlink-tree "config" "/home/titan/.config")
-- 
cgit v1.2.3