(module file mzscheme
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 1)))
  (require (planet "test.ss" ("dherman" "test.plt" 1)))
  (require "../../file.ss")
  (require (lib "contract.ss"))
  (require (lib "etc.ss"))
  (require (lib "file.ss"))

  (define collects-directory
    (normalize-path
     (build-path (this-expression-source-directory)
                 'up 'up 'up)))

  (define this-directory-relative-path
    (build-path "io" "private" "tests"))

  (define this-file-relative-path
    (build-path this-directory-relative-path "file.ss"))

  (define-syntax in-collects-directory
    (syntax-rules ()
      [(_ e1 e2 ...)
       (parameterize ([current-directory collects-directory])
         e1 e2 ...)]))

  (define-assertion (assert-contract-passes contract x)
    (assert-true ((flat-contract-predicate contract) x)))
  (define-assertion (assert-contract-fails contract x)
    (assert-false ((flat-contract-predicate contract) x)))

  (define contract-tests
    (make-test-suite
     "contract tests"
     (make-test-case "relative is relative (path)"
                     (assert-contract-passes relative-path/c (build-path 'same)))
     (make-test-case "relative is relative (string)"
                     (assert-contract-passes relative-path/c (path->string (build-path 'same))))
     (make-test-case "complete is not relative (path)"
                     (assert-contract-fails relative-path/c (path->complete-path (current-directory))))
     (make-test-case "complete is not relative (string)"
                     (assert-contract-fails relative-path/c
                                            (path->string (path->complete-path (current-directory)))))
     (make-test-case "relative is not complete (path)"
                     (assert-contract-fails complete-path/c (build-path 'same)))
     (make-test-case "relative is not complete (string)"
                     (assert-contract-fails complete-path/c (path->string (build-path 'same))))
     (make-test-case "complete is complete (path)"
                     (assert-contract-passes complete-path/c (path->complete-path (current-directory))))
     (make-test-case "complete is complete (string)"
                     (assert-contract-passes complete-path/c
                                             (path->string (path->complete-path (current-directory)))))
     (make-test-case "relative file"
                     (in-collects-directory
                      (assert-contract-passes relative-file-path/c
                                              (build-path "io" "file.ss"))))
     (make-test-case "relative non-file"
                     (in-collects-directory
                      (assert-contract-fails relative-file-path/c
                                             (build-path "io" "does-not-exist.txt"))))
     (make-test-case "non-relative file"
                     (in-collects-directory
                      (assert-contract-fails relative-file-path/c
                                             (path->complete-path
                                              (build-path "io" "file.ss")))))
     (make-test-case "complete file"
                     (in-collects-directory
                      (assert-contract-passes complete-file-path/c
                                              (path->complete-path
                                               (build-path "io" "file.ss")))))
     (make-test-case "complete non-file"
                     (in-collects-directory
                      (assert-contract-fails complete-file-path/c
                                             (path->complete-path
                                              (build-path "io" "does-not-exist.txt")))))
     (make-test-case "non-complete file"
                     (in-collects-directory
                      (assert-contract-fails complete-file-path/c
                                             (build-path "io" "file.ss"))))
     (make-test-case "relative directory"
                     (in-collects-directory
                      (assert-contract-passes relative-directory-path/c
                                              (build-path "io"))))
     (make-test-case "relative non-directory"
                     (in-collects-directory
                      (assert-contract-fails relative-directory-path/c
                                             (build-path "io" "file.ss"))))
     (make-test-case "non-relative directory"
                     (in-collects-directory
                      (assert-contract-fails relative-directory-path/c
                                             (path->complete-path
                                              (build-path "io")))))
     (make-test-case "complete directory"
                     (in-collects-directory
                      (assert-contract-passes complete-directory-path/c
                                              (path->complete-path
                                               (build-path "io")))))
     (make-test-case "complete non-directory"
                     (in-collects-directory
                      (assert-contract-fails complete-directory-path/c
                                             (path->complete-path
                                              (build-path "io" "file.ss")))))
     (make-test-case "non-complete directory"
                     (in-collects-directory
                      (assert-contract-fails complete-directory-path/c
                                             (build-path "io"))))
     ))

  (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 path-manipulation-tests
    (make-test-suite
     "path manipulations"
     (make-test-case "path->relative-path (. directory)"
                     (assert path=?
                             (path->relative-path
                              (path->complete-path (build-path 'same)))
                             (build-path 'same)))
     (make-test-case "path->relative-path"
                     (in-new-directory "sandbox"
                       (let ([e (build-path "a" "b" "c" "d" "e")])
                         (make-directory* e)
                         (let ([complete (path->complete-path e)])
                           (assert path=? (path->relative-path complete) e)))))
     (make-test-case "explode-relative-path"
                     (in-new-directory "sandbox"
                       (let ([e (build-path "a" "b" "c" "d" "e")])
                         (make-directory* e)
                         (assert (lambda (ls1 ls2)
                                   (list-permutation? ls1 ls2 path=?))
                                 (explode-relative-path e)
                                 (map build-path (list "a" "b" "c" "d" "e"))))))
     (make-test-case "telescope-relative-path"
                     (in-new-directory "sandbox"
                       (let ([e (build-path "a" "b" "c" "d" "e")])
                         (make-directory* e)
                         (assert (lambda (ls1 ls2)
                                   (list-permutation? ls1 ls2 path=?))
                                 (telescope-relative-path e)
                                 (list (build-path "a")
                                       (build-path "a" "b")
                                       (build-path "a" "b" "c")
                                       (build-path "a" "b" "c" "d")
                                       (build-path "a" "b" "c" "d" "e"))))))
     ))

  (define (make-file path)
    (with-output-to-file path
      (lambda ()
        (printf "hello, world~n"))))

  (define filesystem-tests
    (make-test-suite
     "filesystem tests"
     (make-test-case "directory-list/all"
                     (in-new-directory "sandbox"
                       (let ([dir1 (build-path "a" "b")]
                             [dir2 (build-path "c")])
                         (make-directory* dir1)
                         (make-directory* dir2)
                         (make-file (build-path "a" "file1.txt"))
                         (make-file (build-path "a" "b" "file2.txt"))
                         (make-file (build-path "c" "file3.txt"))
                         (assert (lambda (ls1 ls2)
                                   (list-permutation? ls1 ls2 path=?))
                                 (directory-list/all)
                                 (list (build-path "a")
                                       (build-path "a" "b")
                                       (build-path "c")
                                       (build-path "a" "file1.txt")
                                       (build-path "a" "b" "file2.txt")
                                       (build-path "c" "file3.txt"))))))
     ))

  (define path-comparison-tests
    (make-test-suite
     "path comparisons"
     (make-test-case "path-normalized=? normalizes paths before checking"
                     (assert-true
                      (in-collects-directory
                       (path-normalized=?
                        (build-path this-directory-relative-path
                                    'up 'up 'up "io" "private" "tests")
                        this-directory-relative-path))))
     (make-test-case "relative path=?"
                     (assert-true
                      (in-collects-directory
                       (path=? (build-path "collects")
                               (build-path "collects")))))
     (make-test-case "a file is distinct from its parent directory"
                     (assert-false
                      (in-collects-directory
                       (path=?
                        this-directory-relative-path
                        this-file-relative-path))))
     ))

  (define file-tests
    (make-test-suite
     "All file.ss tests"
     contract-tests
     path-manipulation-tests
     path-comparison-tests
     filesystem-tests
     ))

  (provide file-tests))