#lang scheme/base

(require scheme/file
         (except-in srfi/1 any)
         "file.ss"
         "test-base.ss")

; Test data --------------------------------------

(define mdt-top1 "make-directory-tree-test-data-1")
(define mdt-top2 "make-directory-tree-test-data-2")

(define mdt-dir1 "directory1")
(define mdt-dir2 "directory2")
(define mdt-dir3 "directory3")
(define mdt-dirs (list mdt-dir1 mdt-dir2 mdt-dir3))

(define mdt-sub1 "subdirectory1")
(define mdt-sub2 "subdirectory2")
(define mdt-sub3 "subdirectory3")
(define mdt-subs (list mdt-sub1 mdt-sub2 mdt-sub3))

(define mdt-tree
  (list mdt-top1
        (append-map (lambda (dir)
                      (list dir mdt-subs))
                    mdt-dirs)
        mdt-top2
        (append-map (lambda (dir)
                      (list dir mdt-subs))
                    mdt-dirs)))

(define mdt-all
  (append-map
   (lambda (dir)
     (map (lambda (sub)
            (format "~a/~a/~a" mdt-top1 dir sub))
          mdt-subs))
   mdt-dirs))

; -> void
(define (delete-mdt-files)
  (when (directory-exists? mdt-top1) (delete-directory/files mdt-top1))
  (when (directory-exists? mdt-top2) (delete-directory/files mdt-top2)))

(define mncf-top   "make-non-conflicting-filename-test-data")
(define mncf-file1 "file-with-extension.ext")
(define mncf-file2 "file-with-extension1.ext")
(define mncf-file3 "file-with-extension2.ext")
(define mncf-file4 "file-without-extension")
(define mncf-file5 "file-without-extension1")
(define mncf-file6 "file-without-extension2")
(define mncf-file7 "file-with-two.extensions.ext")

; create-mncf-files : -> void
(define (create-mncf-files)
  (delete-mncf-files)
  (make-directory mncf-top)
  (touch (build-path mncf-top mncf-file1))
  (touch (build-path mncf-top mncf-file2))
  (touch (build-path mncf-top mncf-file3))
  (touch (build-path mncf-top mncf-file4))
  (touch (build-path mncf-top mncf-file5))
  (touch (build-path mncf-top mncf-file6))
  (touch (build-path mncf-top mncf-file7)))

; -> void
(define (delete-mncf-files)
  (when (directory-exists? mncf-top) (delete-directory/files mncf-top)))

(define cf-top   "concatenate-files-test-data")
(define cf-file1 "file1.txt")
(define cf-file2 "file2.txt")
(define cf-file3 "file3.txt")
(define cf-cat   "file123.txt")

; -> void
(define (create-cf-files)
  (delete-cf-files)
  (make-directory cf-top)
  (touch (build-path cf-top cf-file1) cf-file1)  ; File contains the text "file1.txt"
  (touch (build-path cf-top cf-file2) cf-file2)  ; File contains the text "file2.txt"
  (touch (build-path cf-top cf-file3) cf-file3)) ; File contains the text "file3.txt"

; -> void
(define (delete-cf-files)
  (when (directory-exists? cf-top) (delete-directory/files cf-top)))

; Tests ------------------------------------------

(define file-tests
  (test-suite "file.ss"
    
    (test-case "path-contains?"
      (check-true  (path-contains? (build-path "/a/b/c")   (build-path "/a/b/c/d")))
      (check-false (path-contains? (build-path "/a/b/c/d") (build-path "/a/b/c")))
      (check-true  (path-contains? (build-path "/a/b/c")   (build-path "/a/b/c")))
      (check-true  (path-contains? (build-path "/a/b/c")   (build-path "/a/b/c/d/../e")))
      (check-false (path-contains? (build-path "/a/b/c")   (build-path "/a/b/c/d/../../d")))
      (check-true  (path-contains? (build-path "/a/b/c")   (build-path "/a/b/c/d/../../c/d"))))
    
    (test-suite "make-directory-tree"
      
      #:before delete-mdt-files
      #:after  delete-mdt-files
      
      (test-case "create single directory"
        (check-false (directory-exists? mdt-top1))
        (make-directory-tree mdt-top1)
        (check-true (directory-exists? mdt-top1))
        (delete-directory mdt-top1))
      
      (test-case "create peer directories"
        (check-false (directory-exists? mdt-top1))
        (check-false (directory-exists? mdt-top2))
        (make-directory-tree (list mdt-top1 mdt-top2))
        (check-true (directory-exists? mdt-top1))
        (check-true (directory-exists? mdt-top2))
        (delete-directory mdt-top1)
        (delete-directory mdt-top2))
      
      (test-case "create parent/child directories"
        (check-false (directory-exists? mdt-top1))
        (check-false (directory-exists? mdt-top2))
        (make-directory-tree (list mdt-top1 (list mdt-top2)))
        (check-true (directory-exists? mdt-top1))
        (check-true (directory-exists? (build-path mdt-top1 mdt-top2)))
        (check-false (directory-exists? mdt-top2))
        (delete-directory/files mdt-top1))
      
      (test-case "create tree of directories"
        (check-false (directory-exists? mdt-top1))
        (make-directory-tree mdt-tree)
        (map check-true (map directory-exists? mdt-all) mdt-all)))
    
    (test-suite "make-non-conflicting-[filename/path]" 
      
      #:before create-mncf-files
      #:after  delete-mncf-files
      
      (test-equal? "make-non-conflicting-filename works when there are no conflicts"
        (make-non-conflicting-filename mncf-top "non-conflicting-filename.ext")
        "non-conflicting-filename.ext")
      
      (test-equal? "filename with extension"
        (make-non-conflicting-filename mncf-top mncf-file1)
        "file-with-extension3.ext")
      
      (test-equal? "filename with no extension"
        (make-non-conflicting-filename mncf-top mncf-file4)
        "file-without-extension3")
      
      (test-equal? "filename with two extensions"
        (make-non-conflicting-filename mncf-top mncf-file7)
        "file-with-two.extensions1.ext")
      
      (test-equal? "filename with an index"
        (make-non-conflicting-filename mncf-top mncf-file2)
        "file-with-extension3.ext")
      
      (test-equal? "make-non-conflicting-path"
        (make-non-conflicting-path mncf-top mncf-file1)
        (build-path mncf-top "file-with-extension3.ext")))
    
    (test-suite "read-file->string"
      
      #:before create-cf-files
      
      (test-case "works as expected"
        (check-equal? (read-file->string (build-path cf-top cf-file1)) cf-file1)
        (check-equal? (read-file->string (build-path cf-top cf-file2)) cf-file2)
        (check-equal? (read-file->string (build-path cf-top cf-file3)) cf-file3))
      
      (test-exn "exn when file missing"
        exn:fail:filesystem?
        (cut read-file->string (build-path cf-top cf-cat))))
    
    (test-suite "concatenate-files"
      
      #:after delete-cf-files
      
      (test-case "works as expected"
        (check-equal? (read-file->string (build-path cf-top cf-file1)) cf-file1)
        (check-equal? (read-file->string (build-path cf-top cf-file2)) cf-file2)
        (check-equal? (read-file->string (build-path cf-top cf-file3)) cf-file3)
        (concatenate-files (build-path cf-top cf-cat)
                           (list (build-path cf-top cf-file1)
                                 (build-path cf-top cf-file2)
                                 (build-path cf-top cf-file3)))
        (check-equal? (read-file->string (build-path cf-top cf-cat)) (string-append cf-file1 cf-file2 cf-file3))))
    
    (test-suite "directory-tree and in-directory"
      
      #:before (lambda ()
                 (when (directory-exists? "dtt")
                   (delete-directory/files "dtt"))
                 (make-directory-tree '("dtt" ("a" ("b.txt" "c.png") "d" ("e.txt" "f.png")))))
      #:after (lambda ()
                (when (directory-exists? "dtt")
                  (delete-directory/files "dtt")))
      
      (test-case "directory-tree"
        (check-equal? (map path->string (directory-tree "dtt"))
                      (list "dtt" "dtt/a" "dtt/a/b.txt" "dtt/a/c.png" "dtt/d" "dtt/d/e.txt" "dtt/d/f.png"))
        (check-equal? (map path->string (directory-tree "dtt" #:order 'post))
                      (list "dtt/a/b.txt" "dtt/a/c.png" "dtt/a" "dtt/d/e.txt" "dtt/d/f.png" "dtt/d" "dtt"))
        (check-equal? (map path->string 
                           (directory-tree
                            "dtt" 
                            #:filter (lambda (path) (and (regexp-match #px"txt$" (path->string path)) #t))))
                      (list "dtt/a/b.txt"
                            "dtt/d/e.txt")))
      
      (test-case "in-directory"
        (check-equal? (for/list ([path (in-directory "dtt")])
                        (path->string path))
                      (list "dtt" "dtt/a" "dtt/a/b.txt" "dtt/a/c.png" "dtt/d" "dtt/d/e.txt" "dtt/d/f.png"))
        (check-equal? (for/list ([path (in-directory "dtt" #:order 'post)])
                        (path->string path))
                      (list "dtt/a/b.txt" "dtt/a/c.png" "dtt/a" "dtt/d/e.txt" "dtt/d/f.png" "dtt/d" "dtt"))
        (check-equal? (for/list ([path (in-directory
                                        "dtt"
                                        #:filter (lambda (path)
                                                   (and (regexp-match #px"txt$" (path->string path)) #t)))])
                        (path->string path))
                      (list "dtt/a/b.txt" "dtt/d/e.txt"))))))

; Helpers ----------------------------------------

; path -> void
;
; Used in tests for make-non-conflicting-filename.
(define (touch path [content #f])
  (unless (file-exists? path)
    (with-output-to-file path
      (cut display (if content content "Temporary file: feel free to delete.")))))

; Provide statements -----------------------------

(provide file-tests)