#!/usr/bin/guile \
-e main -s
!#
(use-modules (ice-9 popen)
             (logging logger)
             (logging port-log)
             (oop goops)
             (term ansi-color))


(define (ansi-color-log-formatter lvl time str)
  (let ((color (cond ((eq? lvl 'CRITICAL) 'RED)
                     ((eq? lvl 'WARN) 'YELLOW)
                     ((eq? lvl 'OK) 'GREEN))))
    (string-append
     (strftime "%F %H:%M:%S" (localtime time))
     (colorize-string
      (string-append " (" (symbol->string lvl) "): ") color 'BOLD)
     str "\n")))


(define (setup-logging)
  (let ((lgr (make <logger>))
        (std (make <port-log>
               #:port (current-output-port)
               #:formatter ansi-color-log-formatter)))

    ;; add the handler to our logger
    (add-handler! lgr std)

    ;; make this the application's default logger
    (set-default-logger! lgr)
    (open-log! lgr)))

(define (shutdown-logging)
  (flush-log)   ;; since no args, it uses the default
  (close-log!)  ;; since no args, it uses the default
  (set-default-logger! #f))


(define (expand-file f)
  ;; https://irreal.org/blog/?p=83
  (cond ((char=? (string-ref f 0) #\/) 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 (clean-file full-dest)
  (when (file-exists? full-dest)
    (log-msg 'WARN (string-append "Deleting previous file: " full-dest))
    (delete-file full-dest))
  full-dest)

(define (config-links title src target)
  (symlink (expand-file src) (clean-file (expand-file target)))
  (log-msg 'OK (string-append title " on " target)))

(define (git-config)
  (log-msg 'INFO "Configuring git")
  (config-links " Symlink global config" "git/global-gitconfig" "~/.gitconfig")
  (config-links " Symlink Tribe29 config" "git/tribe29" "~/git/.gitconfig"))

(define (main args)
  (setup-logging)
  (log-msg 'INFO "Symlink PIM")
  (config-links " Symlink agenda" "calendars.conf" "~/.calendars.conf")
  (git-config)
  (config-links " Symlink guile defaults" "dot-guile" "~/.guile")
  (config-links " Symlink rofi" "rofi" "~/.config/rofi")
  (config-links " Symlink zshrc" "dot-zshrc" "~/.zshrc")

  (shutdown-logging))