#!/usr/bin/guile
!#

(define description
  "group files into directories based on delimiter separated prefixes, if at least two files with the given prefix exist.
   for example, a.1 and a.2 are moved to a/a.1 and a/a.2. the default delimiter is \".\".
   depends on guile and sph-lib")

(use-modules (sph) (sph cli)
  (sph list) (sph list other)
  (sph alist) (ice-9 pretty-print) (srfi srfi-1) (sph filesystem) (sph string))

(define default-delimiter #\.)

(define (prefix-sort-action-data delimiter paths)
  (let*
    ( (paths (map path->full-path paths))
      (prefixes-and-paths
        (let*
          ( (basenames (map basename paths)) (dirnames (map dirname paths))
            (prefixes (map (l (a) (first (string-split a delimiter))) basenames)))
          (filter-map
            (l (prefix dir base)
              (let (prefix-count (count (l (a) (string-equal? prefix a)) prefixes))
                (and (< 1 prefix-count)
                  (let
                    ((target (string-append dir "/" prefix)) (source (string-append dir "/" base)))
                    (and (not (string-equal? target source)) (pair target source))))))
            prefixes dirnames basenames))))
    (map-apply (l (target . sources) (pair target (map tail sources)))
      (group prefixes-and-paths first))))

(define (dry-run-f name) (l a (pretty-print (pair name a))))

(define (prefix-sort dry-run? delimiter paths)
  (let
    ( (rename-file (if dry-run? (dry-run-f (q rename-file)) rename-file))
      (mkdir (if dry-run? (dry-run-f (q mkdir)) mkdir)))
    (each
      (l (target-and-sources)
        (catch #t
          (nullary
            (let (target (first target-and-sources))
              (if (not (file-exists? target)) (mkdir target))
              (each (l (source) (rename-file source (string-append target "/" (basename source))))
                (tail target-and-sources))))
          (l a (display-line (append a target-and-sources)))))
      (prefix-sort-action-data delimiter paths))))

(define (prefix-sort-cli)
  (let*
    ( (cli
        (cli-create #:options
          (q ((delimiter #:names #\d #:value-required? #t) (dry-run) ((paths ...)))) #:description
          description))
      (arguments (cli))
      (delimiter
        (let (a (alist-ref-q arguments delimiter))
          (if (and (string? a) (= 1 (string-length a))) (string-ref a 0) default-delimiter))))
    (prefix-sort (alist-ref-q arguments dry-run) delimiter
      (any->list (alist-ref-q arguments paths)))))

(prefix-sort-cli)