diff options
| -rwxr-xr-x | install.scm | 46 |
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) |