hugo-minimalist-theme - Minimalist theme for hugo

diff options

Diffstat (limited to 'makefile')

-rw-r--r--

1 files changed, 7 insertions, 7 deletions

#!/usr/bin/guile \ -e main -s !# (use-modules (ice-9 and-let-star) (ice-9 ftw) (ice-9 match) (ice-9 popen) (ice-9 regex) (logging logger) (logging port-log) (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) ((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 ((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")) (level (if dry-run 'INFO 'WARN))) (log-msg level (format #f "~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) (log-msg 'WARN (format #f "~a: ~a: ~a~%" errno name (strerror errno))) result) (file-system-fold enter? leaf down up skip error (list 0) path)) (define (replace str pattern new) (regexp-substitute/global #f pattern str 'pre new 'post)) (define (make-dir-parents dir-path) (unless (access? dir-path F_OK) (make-dir-parents (dirname dir-path)) (mkdir dir-path))) (define (dot-replace str) (replace str "dot-" ".")) (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)) (rm-tree target-path dry-run) (make-dir-parents (dirname target-path)) (symlink src-path target-path) (log-msg 'OK (string-append " Symlink " src " <- " target-path))))) (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 (target-subfile path) (->> (substring path src-len) (string-append target-path) dot-replace expand-file)) (define (enter? name stat result) (->> (target-subfile name) lstat stat:type (eq? 'directory) false-if-exception)) (define (leaf name stat result) (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 ((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) ;; Ignore unreadable files/directories but warn the user. (define (error name stat errno result) (log-msg 'WARN (format #f "~a: ~a: ~a~%" errno name (strerror errno))) result) (file-system-fold enter? leaf down up skip error (list 0) file-name)) (define (format-config-entry item) (format #t "[~a]~%" (car item)) (format #t "~:{~a=~@{~a~^;~}~%~}~%" (cdr item))) (define (mail-config) (log-msg 'INFO "Configuring mail") (log-msg 'INFO " Symlink mbsync") (config-links "mail/dot-mbsyncrc.personal" "~/.mbsyncrc" #f) (let* ((notmuch-config-file (expand-file "~/.notmuch-config")) (emails (list "hi@oscarnajera.com" "hello@oscarnajera.com" "najera.oscar@gmail.com" )) (user-mail "hi@oscarnajera.com") ;; setting up notmuch config (config `((database (path ,(expand-file "~/.mail"))) (user (name "Oscar Najera") (primary_email ,user-mail) ,(cons 'other_email (delete user-mail emails))) (new (tags new) (ignore .uidvalidity .mbsyncstate .directory)) (search (exclude_tags deleted spam)) (maildir (synchronize_flags true)) (crypto (gpg_path gpg))))) (clean-file notmuch-config-file #f) (with-output-to-file notmuch-config-file (lambda () (display "# -*- mode: conf-unix -*-\n# managed by dotfiles install\n") (for-each format-config-entry config))) (chmod notmuch-config-file #o400))) (define (main args) (setup-logging) (log-msg 'INFO "Symlink PIM") (config-links "calendars.conf" "~/.calendars.conf" #f) (symlink-tree "home-dots" "~/") (config-links "gnupg/gpg.conf" "~/.gnupg/gpg.conf" #f) (config-links "gnupg/gpg-agent.conf" "~/.gnupg/gpg-agent.conf" #f) (symlink-tree "config" "~/.config") (mail-config) (shutdown-logging))


context:
space:
mode: