;;;; directory-utils.dotted.scm
;;;; Kon Lovett, Mar '24
;;;; Kon Lovett, Aug '10

;; Issues
;;
;; - Need a routine that provides filename and stat info to the fold func.
;; stat info: Posix + platform specific:
;; Windows Hidden attribute ...
;; macOS birthtime ...
;;
;; - Windows support is bit of a joke.
;;
;; - minimal dotted via "type-punning"

(module (directory-utils dotted)

(;export
  ;
  dot-prefix-dirname? dot-suffix-dirname?
  ;
  dot-pathname? dot-dirname? dot-filename?
  remove-dotfiles)

(import scheme utf8)
(import (chicken base))
(import (chicken type))
(import (only (chicken pathname)
  pathname-file decompose-pathname decompose-directory))
(import (only (srfi 1) remove member any))
(import (only utf8-srfi-13 string-prefix?))
(import (only (check-errors sys) check-list))

(include-relative "directory-utils.types")

(define-type pathnames (list-of pathname))

(: dot-prefix-dirname? (pathname --> boolean))

(: dot-filename? (* #!optional (list-of filename) --> boolean))
(: dot-dirname? (* #!optional (list-of filename) --> boolean))
(: dot-pathname? (* #!optional (list-of filename) --> boolean))

(: remove-dotfiles (pathnames --> pathnames))

;; (not sure how useful ;-)

;no . or .. since system dirname
(define HIDDEN-DOTTED '("." ".."))

(define (*excluded-name? str exs)
  (member str exs string=?) )

(define (*dot-filename-prefix? str exs)
  (and (string-prefix? "." str)
       (not (*excluded-name? str exs))) )

(define (*dot-dirname? dn exs)
  (receive (org dir elts) (decompose-directory dn)
    (and elts
         (any (cut *excluded-name? <> exs) elts))) )

;;

(define (dot-prefix-dirname? dn)
  (and (string? dn)
       (receive (org dir elts) (decompose-directory dn)
         (and (not (null? elts))
              (*excluded-name? (car elts) HIDDEN-DOTTED))) ) )

(define (dot-suffix-dirname? dn)
  (and (string? dn)
       (not (dot-prefix-dirname? (pathname-file dn)))) )

(define (dot-filename? obj #!optional (exs HIDDEN-DOTTED))
  (and (string? obj)
       (*dot-filename-prefix? obj (check-list 'dot-filename? exs))) )

; Any dirname component a dot-filename?
(define (dot-dirname? obj #!optional (exs HIDDEN-DOTTED))
  (and (string? obj)
       (*dot-dirname? obj (check-list 'dot-dirname? exs))) )

; Any pathname component a dot-filename?
(define (dot-pathname? obj #!optional (exs HIDDEN-DOTTED))
  (and (string? obj)
       (receive (dir fil ext) (decompose-pathname obj)
          (or (and fil (*dot-filename-prefix? fil (check-list 'dot-pathname? exs)))
              (let-values (((org dir elts) (decompose-directory dir)))
                (and elts
                     (any (cut *dot-filename-prefix? <> exs) elts)))))) )

;;

; Remove dot files from a directory list
(define (remove-dotfiles files)
  (remove (lambda (pn) (dot-filename? (pathname-file pn))) files) )

) ;(directory-utils dotted)