#!/usr/bin/guile --no-auto-compile
!#

(use-modules (ice-9 ftw)
             (ice-9 i18n)
             (ice-9 match)
             (srfi srfi-1)
             (srfi srfi-11)
             (srfi srfi-26))

(define (recursive-scandir dir)
  "Return a list of all the file names in DIR, recursively."
  (define (components file)
    (string-split file #\/))

  (define suffix
    (let ((prefix-length (length (components dir))))
      (lambda (file)
        (string-join (drop (components file) prefix-length) "/"))))

  (define enter? (const #t))

  (define (leaf name stat result)
    (cons (suffix name) result))

  ;; No-op
  (define (down name stat result) result)
  (define (up name stat result) result)
  (define (skip name stat result) result)
  (define (error name stat errno result) result)

  (let-values (((files discard)
                (file-system-fold enter? leaf down up skip error '() dir)))
    (sort files string-locale<?)))

(define (mkdir-p dir)
  "Create directory DIR and all its ancestors."
  (define absolute?
    (string-prefix? "/" dir))

  (define not-slash
    (char-set-complement (char-set #\/)))

  (let loop ((components (string-tokenize dir not-slash))
             (root       (if absolute?
                             ""
                             ".")))
    (match components
      ((head tail ...)
       (let ((path (string-append root "/" head)))
         (catch 'system-error
           (lambda ()
             (mkdir path)
             (loop tail path))
           (lambda args
             (if (= EEXIST (system-error-errno args))
                 (loop tail path)
                 (apply throw args))))))
      (() #t))))

(define (symlink? file)
  "Return #t if FILE is a symbolic link."
  (eq? (stat:type (lstat file)) 'symlink))

(define (already-linked? src-file dest-file)
  "Return #t if SRC-FILE is a symbolic link to DEST-FILE."
  (and (symlink? dest-file)
       (string=? (readlink dest-file) src-file)))

(define %home (getenv "HOME"))

(define %dotfiles-dir
  (string-append (getcwd) "/dotfiles"))

(define (install-dotfile file)
  "Create a symlink to FILE in the current user's home directory."
  (let ((src-file (string-append %dotfiles-dir "/" file))
        (dest-file (string-append %home "/" file)))
    (cond
     ((not (file-exists? dest-file))
      (format #t "~a → ~a~%" file dest-file)
      (mkdir-p (dirname dest-file))
      (symlink src-file dest-file))
     ((already-linked? src-file dest-file)
      (format #t "~a already installed~%" file))
     (else
      (error "destination file already exists: " dest-file)))))

(define %dotfiles
  (recursive-scandir "dotfiles"))

(for-each install-dotfile %dotfiles)