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

(;export
  directory-utility-stack
  push-directory
  pop-directory
  pop-toplevel-directory)

(import scheme utf8)
(import (chicken base))
(import (chicken type))
(import (only (chicken process-context) current-directory change-directory))
(import (only (chicken file) create-directory))
(import (only (chicken pathname) pathname-directory))
(import (only utf8-srfi-13 string-null?))
(import (only miscmacros until define-parameter))
(import (only type-checks-basic define-check+error-type))
(import (only stack make-stack stack? stack-empty? stack-push! stack-pop!))
(import (only (directory-utils checks) check-pathname))
(import (only (directory-utils dotted) dot-pathname?))

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

#; ;should be
(include "stack.types")
(define-type stack (struct stack))

(: directory-utility-stack (#!optional stack -> stack))
(: push-directory ((or false pathname) #!optional stack -> void))
(: pop-directory (#!optional stack -> void))
(: pop-toplevel-directory (#!optional stack -> void))

;;(std-prelude)

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

;;(moremacros)

(define-syntax checked-guard
  (er-macro-transformer
    (lambda (frm rnm cmp)
      (##sys#check-syntax 'checked-guard frm '(_ symbol symbol . _))
      (let ((_lambda (rnm 'lambda))
            (_let (rnm 'let))
            (_arg (rnm 'arg))
            (?locnam (cadr frm))
            (?typnam (caddr frm))
            (?body (cdddr frm)) )
        (let ((chknam (symbol-append 'check- (strip-syntax ?typnam)))) ;inject
          `(,_lambda (,_arg)
            (,chknam ',?locnam ,_arg)
            (,_let ((obj ,_arg))
              ,@?body
              obj ) ) ) ) ) ) )

(define-syntax define-checked-parameter
  (syntax-rules ()
    ((define-checked-parameter ?name ?init ?typnam ?body0 ...)
      (define-parameter ?name ?init (checked-guard ?name ?typnam ?body0 ...)) ) ) )

;; Directory Stack

(define-check+error-type stack)

(define-checked-parameter directory-utility-stack (make-stack) stack)

;;

(define (ignored-directory? dir)
  (or (string-null? dir) (string=? "." dir)) )

(define (push-directory dir #!optional (dirstack (directory-utility-stack)))
  (stack-push! dirstack (current-directory))
  ;don't cd unless necessary
  (when (and dir (not (ignored-directory? dir)))
    (change-directory dir) ) )

;FIXME pop is no-op when stack empty

(define (pop-directory #!optional (dirstack (directory-utility-stack)))
  (unless (stack-empty? dirstack)
    (change-directory (stack-pop! dirstack)) ) )

(define (pop-toplevel-directory #!optional (dirstack (directory-utility-stack)))
  ;does a chdir until top - pop till top then chdir?
  (until (stack-empty? dirstack)
    (pop-directory dirstack) ) )

;; 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)) )

) ;(directory-utils stack)