#lang scheme/base

(require (for-syntax scheme/base)
         (only-in (lib "etc.ss") this-expression-source-directory)
         scheme/file)

(provide list-permutation?
         keep-new-directories?
         in-new-directory
         in-this-directory)

(define (remove-first x ls [equiv? eq?])
  (let loop ([ls ls] [result '()])
    (cond
      [(null? ls) #f]
      [(equiv? (car ls) x) (append (reverse result) (cdr ls))]
      [else (loop (cdr ls) (cons (car ls) result))])))

(define (list-permutation? ls1 ls2 [equiv? eq?])
  (let loop ([ls1 ls1] [ls2 ls2])
    (cond
      [(and (null? ls1) (null? ls2)) #t]
      [(or (null? ls1) (null? ls2)) #f]
      [(remove-first (car ls1) ls2 equiv?)
       => (lambda (ls2*)
            (loop (cdr ls1) ls2*))]
      [else #f])))

(define-syntax (in-this-directory stx)
  (syntax-case stx ()
    [(_ e1 e2 ...)
     (with-syntax ([cwd (syntax/loc stx
                          (this-expression-source-directory e1))])
       #'(parameterize ([current-directory cwd])
           e1 e2 ...))]))

(define (rm-rf path)
  (when (or (file-exists? path) (directory-exists? path))
    (delete-directory/files path)))

(define keep-new-directories?
  (make-parameter #f (lambda (new-b)
                       (if (not (boolean? new-b))
                           (raise-type-error 'keep-new-directories? "boolean" new-b)
                           new-b))))

(define-syntax in-new-directory
  (syntax-rules ()
    [(_ dir-e e1 e2 ...)
     (let ([dir dir-e])
       (dynamic-wind
        void
        (lambda ()
          (when (directory-exists? dir)
            (error 'in-new-directory "can't create directory ~a; directory exists" dir))
          (make-directory* dir)
          (parameterize ([current-directory dir]
                         [keep-new-directories? #t])
            e1 e2 ...))
        (lambda ()
          (unless (keep-new-directories?)
            (rm-rf dir)))))]))