#!/usr/bin/guile
!#

(define description
  "moves files into directories by using regular expressions on mime-types
   removes unwanted characters from file names
   deletes empty directories")

(import (guile) (ice-9 regex)
  (sph alist) (except (srfi srfi-1) map)
  (ice-9 ftw) (sph filesystem)
  (sph hashtable) (sph io)
  (sph list) (sph number)
  (sph other) (sph process)
  (sph string) (sph vector) (sph) (sph cli) (rnrs exceptions) (sph process) (sph tree))

(load (string-append (getenv "HOME") "/.config/sph/tidyfiles.scm"))
(define trim-char-set (list->char-set (quote (#\newline #\space))))

(define-syntax-rule (filename-extension-case path cond ...)
  (let (t (filename-extension path)) (string-case (or t "") cond ...)))

(define (path->mime-type path)
  (string-trim-both
    (shell-eval->string (string-append "file --brief --mime-type " (string-quote path)))
    trim-char-set))

(define default-file-rename-config
  (map (l (a) (pair (make-regexp (first a)) (tail a)))
    (q (("[^-.öäüa-zA-Z0-9]" . " ") ("\\.htm$" . ".html") (" - " . ".") (" +" . " ")))))

(define (default-file-rename a)
  (fold (l (a r) (regexp-replace r (first a) (tail a))) (string-downcase a)
    default-file-rename-config))

(define (prepare-config-mapping a)
  (map
    (l (a)
      (list->vector
        (pair
          (let (regexp (first a))
            (make-regexp
              (if (list? regexp) (string-append "(" (string-join regexp ")|(") ")") regexp)))
          (tail a))))
    a))

(define target-toplevel-directories (delete-duplicates (map second config-mapping)))

(define (source-path->target-path source-path config-mapping)
  (let (mime-type (path->mime-type source-path))
    (if
      (or (contains? target-toplevel-directories (basename source-path))
        (contains? config-ignore (basename source-path)))
      #f
      (let (config (find (l (a) (regexp-exec (vector-ref a 0) mime-type)) config-mapping))
        (path-append (vector-ref config 1)
          (if (> (vector-length config) 2)
            (let (relative-path (vector-ref config 2))
              (if (procedure? relative-path) (relative-path source-path) relative-path))
            ""))))))

(define (tidyfiles path config dry-run)
  "each directory entry, then delete empty toplevel directories"
  (each
    (l (name)
      (let* ((source-path name) (target-dir (source-path->target-path source-path config)))
        (if target-dir
          (let (target-path (get-unique-path (path-append target-dir (default-file-rename name))))
            (guard (obj (#t (string-append "ignored file \"" name "\"")))
              (if dry-run
                (display
                  (string-append (string-trim-right target-dir #\/) " <- "
                    (if (string-contains source-path " ") (string-quote source-path) source-path)
                    "\n"))
                (begin (ensure-directory-structure target-dir)
                  (rename-file source-path target-path))))))))
    (scandir path (negate dotfile?)))
  (system* "delete-if-empty" path))

(define (tidyfiles-cli)
  (let
    (options
      ( (cli-create #:description "move files into directories by mime type"
          (q ((path))) (q (dry-run)))))
    (alist-bind options (path dry-run)
      (tidyfiles path (prepare-config-mapping config-mapping) dry-run))))

(tidyfiles-cli)