(module test mzscheme
  (require (lib "etc.ss"))
  (require (lib "file.ss"))

  (define remove-first
    (opt-lambda (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?
    (opt-lambda (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 (source-directory-of-expression stx)
    (syntax-case stx ()
      [(_ context)
       (syntax/loc #'context
         (this-expression-source-directory))]))

  (define-syntax (in-this-directory stx)
    (syntax-case stx ()
      [(_ e1 e2 ...)
       #`(parameterize ([current-directory (source-directory-of-expression #,stx)])
           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 ()
            (rm-rf dir)
            (make-directory dir)
            (parameterize ([current-directory dir]
                           [keep-new-directories? #t])
              e1 e2 ...))
          (lambda ()
            (unless (keep-new-directories?) (rm-rf dir)))))]))

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