From bf02f467c4c3f4d9fc71aed705986ca8774f5caf 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:36:25 +0100
Subject: Install a complete tree

---
 walk.scm | 114 ---------------------------------------------------------------
 1 file changed, 114 deletions(-)
 delete mode 100755 walk.scm

(limited to 'walk.scm')

diff --git a/walk.scm b/walk.scm
deleted file mode 100755
index c244bf3..0000000
--- a/walk.scm
+++ /dev/null
@@ -1,114 +0,0 @@
-#!/usr/bin/guile \
--s
-!#
-(use-modules (ice-9 popen)
-             (logging logger)
-             (logging port-log)
-             (ice-9 ftw)
-             (ice-9 match)
-             (ice-9 and-let-star)
-             (oop goops)
-             (term ansi-color))
-
-(define (expand-file f)
-  ;; https://irreal.org/blog/?p=83
-  (cond ((absolute-file-name? f) f)
-        ((string=? (substring f 0 2) "~/")
-         (let ((prefix (passwd:dir (getpwuid (geteuid)))))
-           (string-append prefix (substring f 1 (string-length f)))))
-        ((char=? (string-ref f 0) #\~)
-         (let* ((user-end (string-index f #\/))
-                (user (substring f 1 user-end))
-                (prefix (passwd:dir (getpwnam user))))
-           (string-append prefix (substring f user-end (string-length f)))))
-        (else (string-append (getcwd) "/" f))))
-
-(define (symlink? path)
-  (false-if-exception
-   (eq? 'symlink (stat:type (lstat path)))))
-
-(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)
-
-  (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))
-      (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 src-len (string-length file-name))
-
-  (define (enter? name stat result)
-    (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))))))
-
-  (define (leaf name stat result)
-    (let* ((subfile (substring name src-len))
-           (target-subfile (string-append target-path subfile)))
-      (config-links name target-subfile #f))
-
-    (set-car! result (1+ (car result)))
-    result)
-
-  (define (down name stat result)
-    (cons 0 result))
-  (define (up name stat result)
-    (let* ((subdir (substring name src-len))
-           (target-subdir (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)))
-    (cdr result))
-  ;; Likewise for skipped directories.
-  (define skip leaf)
-
-  ;; Ignore unreadable files/directories but warn the user.
-  (define (error name stat errno result)
-    (format (current-error-port) "warning: ~a: ~a~%"
-            name (strerror errno))
-    result)
-
-  (file-system-fold enter? leaf down up skip error
-                    (list 0)
-                    file-name))
-
-
-(symlink-tree "config" "/home/titan/.config")
-- 
cgit v1.2.3