;;;; directory-utils.operations.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.

(module (directory-utils operations)

(;export
  ;
  directory-foldl
  directory-tree-unfold *directory-tree-unfold
  ;
  create-pathname-directory
  make-program-filename
  make-shell-filename
  file-exists-in-directory?
  find-file-pathnames
  find-program-pathnames
  find-command-pathnames
  which-command-pathname
  ;DEPRECATED
  directory-fold
  which-command-pathnames)

(import scheme utf8)
(import (chicken base))
(import (chicken type))
(import (only (chicken format) format))
(import (only (chicken file posix) directory?))
(import (only (chicken process-context) get-environment-variable))
(import (only (chicken pathname)
  make-pathname pathname-directory pathname-extension pathname-file))
(import (only (chicken file) file-exists? directory create-directory))
(import (only (srfi 1) first concatenate! fold filter-map any xcons))
(import (only (check-errors sys) check-procedure))
(import (only (directory-utils checks) check-pathname check-directory))
(import (directory-utils dotted))

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

(define-type pathnames (list-of pathname))
(define-type maybe-pathname (or false pathname))
(define-type maybe-pathnames (or false pathnames))

(define-type filename+ (or filename (list-of filename)))

#| ;FIXME while this is accurate "cons '()" is the downfall
(: directory-foldl (dirname (filename 'a -> 'a) 'a #!optional boolean -> 'a))

(: *directory-tree-unfold (dirname (pathname -> 'a) ('a pathname -> 'a) 'a boolean -> 'a))
(: directory-tree-unfold (#!optional dirname (pathname -> *) ('a pathname -> 'a) 'a boolean -> 'a))
|#

(: directory-foldl (dirname (filename * -> *) * #!optional * -> *))

(: *directory-tree-unfold (dirname (pathname -> *) (* pathname -> *) * * -> *))
(: directory-tree-unfold (#!optional dirname (pathname -> *) (* pathname -> *) * * -> *))

(: create-pathname-directory (pathname -> boolean))

(: make-program-filename (basename --> filename))
(: make-shell-filename (basename -> filename))

(: file-exists-in-directory? (filename #!optional dirname -> (or false pathname)))

(: find-file-pathnames (filename+ #!rest (list-of dirname) -> maybe-pathnames))
(: find-program-pathnames (filename+ #!rest (list-of dirname) -> maybe-pathnames))
(: find-command-pathnames (filename+ #!optional string -> maybe-pathnames))

(: which-command-pathname (filename #!optional string -> maybe-pathname))

;;(std-prelude)

(define (boolean obj) (and obj #t))

(cond-expand
  (windows
    (define PATH-DELIMITER ";") )
  (else
    (define PATH-DELIMITER ":") ) )

;;(list-utils basic)

(define-syntax ensure-list
  (syntax-rules (_obj)
    ((ensure-list ?obj)
      (let ((_obj ?obj))
        (if (list? _obj) _obj
            (list _obj)) ) ) ) )

;;

(define (directory-foldl dir func seed #!optional dotted?)
  ;error ref'ing `foldl' or `directory' shouldn't be confusing
  (foldl func seed (directory dir dotted?)) )

(define (*directory-tree-unfold dir tst? gen seed dotted?)
  (let walk ((seed seed) (dir dir))
    (define (walkdown ls fl)
      (let ((pn (make-pathname dir fl)))
        (if (directory? pn)
            ;then follow subdirectory or not
            (if (tst? pn)
                ;then follow
                (walk ls pn)
                ;else accum w/ directory separator suffix
                (gen ls (make-pathname pn "")))
            ;else accum
            (gen ls pn)) ) )
    (directory-foldl dir walkdown seed dotted?) ) )

(define (directory-tree-unfold #!optional (dir ".")
                                          (tst? dot-suffix-dirname?) (gen xcons) (seed '())
                                          (dotted? #f))
  (*directory-tree-unfold (check-directory 'directory-tree-unfold dir)
                          (check-procedure 'directory-tree-unfold tst?)
                          (check-procedure 'directory-tree-unfold gen)
                          seed
                          dotted?) )


;; Ensure the directory for the specified path exists.

(define (create-pathname-directory pn)
  (boolean
    (create-directory
      (pathname-directory (check-pathname 'create-pathname-directory pn))
      #t)) )

;; Platform specific program filename.

(cond-expand
  (windows
    (define (make-program-filename bn)
      (if (pathname-extension bn) bn
          (make-pathname #f bn "exe")) )
    (define (make-shell-filename bn)
      (if (pathname-extension bn) bn
          (make-pathname #f bn "bat")) ) )
  (else
    (define (make-program-filename bn)
      bn )
    (define (make-shell-filename bn)
      (if (pathname-extension bn) bn
          (make-pathname #f bn "sh")) ) ) )

;; Pathname if file exists in directory.

(define (file-exists-in-directory? fil #!optional (dir #f))
  (let ((path (make-pathname dir fil)))
    (and (file-exists? path)
         path) ) )

;; List of all found pathnames.

(define (*find-file-pathnames fils dirs)
  (filter-map (lambda (dir) (any (cut file-exists-in-directory? <> dir) fils)) dirs) )

(define (find-file-pathnames fil . dirs) (*find-file-pathnames (ensure-list fil) dirs))

;; All found program pathname in directories.

(cond-expand
  (windows
    (define (expand-program-pathnames cmds)
      (concatenate!
       (map
        (lambda (cmd)
          (if (pathname-extension cmd) `(,cmd)
              `(,(make-program-filename cmd) ,(make-shell-filename cmd))) )
        cmds)) ) )
  (else
    (define (expand-program-pathnames cmds)
      cmds) ) )

(define (*find-program-pathnames cmds dirs)
  (*find-file-pathnames (expand-program-pathnames (ensure-list cmds)) dirs) )

(define (find-program-pathnames cmds . dirs) (*find-program-pathnames cmds dirs))

;; All found program pathname in path.

(define (find-command-pathnames cmds #!optional (varnam "PATH"))
  (and-let* ((path (get-environment-variable varnam)))
    (*find-program-pathnames cmds (string-split path PATH-DELIMITER)) ) )

;; First found program pathname in path.

(define (which-command-pathname cmd . opts)
  (and-let* ((ps (apply find-command-pathnames cmd opts))
             ((not (null? ps))) )
    (first ps) ) )

;;

(: which-command-pathnames (deprecated find-command-pathnames))
(define which-command-pathnames find-command-pathnames)

(: directory-fold (deprecated directory-foldl))
(define (directory-fold func seed dir #!key dotfiles?)
  (directory-foldl dir (flip func) seed dotfiles?) )

) ;(directory-utils operations)