#lang racket
(require srfi/13)
(provide name-as-string filename-main filename-suffix get-file-or-directory-name make-unique-name move-directory-to/renaming file=? 
         copy-directories/renaming file-is-visible? parent-directory make-unique-path path-equal? count-lines compose-name
         rename-or-copy-file rename-or-copy-directory rename-or-copy-file-or-directory file-equal?)


; Return the name of a file or folder path as string.
(define (get-file-or-directory-name file-or-folder)
  (path->string (car (reverse (explode-path file-or-folder)))))

(define (split-name name)
  (regexp-split #rx"\\." name))

(define (name-as-string name-or-path)
  (if (string? name-or-path)
      name-or-path
      (get-file-or-directory-name name-or-path)))

; Return the name without suffix of a file or folder as string.
(define (filename-main name-or-path)
  (let* ((name (name-as-string name-or-path))
         (suffix (filename-suffix name)))
    (if (string=? "" suffix)
        name
        (string-drop-right name (add1 (string-length suffix))))))

; Return the suffix of a file or folder if there is one.
; Delimiter is assumed to be "." regardless of the file system.
(define (filename-suffix name-or-path)
  (let* ((name (name-as-string name-or-path))
         (li (split-name name)))
    (if (> (length li) 1)
        (car (reverse (split-name name)))
        "")))

; Takes a main file-name (without suffix) string of the form "name-n" and returns and splits it up into name
; and number n (if there), returns two values the name without number and delimiter
; and the number or #f if there is none
(define (filename-split-number name)
  (define parts (regexp-split #rx"-" name))
  (if (or (= (length parts) 1) (not (string->number (last parts))))
      (values name #f)
      (values (string-drop-right name (add1 (string-length (last parts))))
              (string->number (last parts)))))

; compose a file name out of main part, number suffix "-n" and real suffix
(define (compose-name name n suffix)
  (cond
    ((and (not n) (string=? suffix "")) name)
    ((not n) (string-append name "." suffix))
    ((string=? suffix "") (string-append name "-" (number->string n)))
    (else (string-append name "-" (number->string n) "." suffix))))

; Given some name as string and a folder as path, returns
; a new name that is ensured to be unique within the given
; folder. This version leaves the suffix intact.
; Performance note: This routine checks for the presence of files
; of the scheme "name-1.suff", "name-2.suff", ..., "name-n.suff"
; until it finds a nonexistent file "name-n+1.suff" so it ought not be used
; to automatically find unique names of a large number of files.
(define (make-unique-name name folder)
  (define path (if folder (build-path folder name) name))
  (define suffix (filename-suffix name))
  (define-values (main-part num) (filename-split-number (filename-main name)))
  (if (or (file-exists? path)
          (directory-exists? path))
      (if num
          (make-unique-name 
           (compose-name main-part (add1 num) suffix)
           folder)
          (make-unique-name
           (compose-name (filename-main name)
                         1
                         (filename-suffix name))
           folder))
      name))

; Return parent directory of a path, #f if there is none.
(define (parent-directory path)
  (let ((parts (explode-path (simple-form-path path))))
    (if (> (length parts) 1)
        (apply build-path (reverse (cdr (reverse parts))))
        #f)))

; Return a unique path that is guaranteed not to point to an existing file
; based on a suggested path. The path returned is within the same directory
; as the suggested-path.
(define (make-unique-path suggested-path)
  (let ((parent-dir (parent-directory suggested-path)))
    (build-path parent-dir
                (make-unique-name
                 (get-file-or-directory-name suggested-path)
                 parent-dir))))

; Test whether two paths are equal.
; This works for paths to folders but the function is not guaranteed to return #t when
; the two paths given point to the same file or folder. Use file=? if you need
; a slower but more reliable method and the file may be
; opened for read access.
(define (path-equal? p1 p2)
  (equal? (normal-case-path (simple-form-path p1))
          (normal-case-path (simple-form-path p1))))

; Determine whether two paths alias the same existent file on disk.
; This function is slow, accesses the filesystem and
; an exception is trown if one or more of the files exist but the user has
; no read access to it or if one of the paths points to a folder.
(define (file=? file1 file2)
  (if (or (not (file-exists? file1))
          (not (file-exists? file2)))
      #f
      (let ((p1 (open-input-file file1))
            (p2 (open-input-file file2)))
        (begin0
          (= (port-file-identity p1)
             (port-file-identity p2))
          (close-input-port p1)
          (close-input-port p2)))))

; Copy all folders satisfying some predicate in a folder into some destination folder.
; Folders are renamed in the destination folder if they already exist there.
(define (copy-directories/renaming source-directory dest-directory pred?)
  (for-each 
   (lambda (folder)
     (when (and (directory-exists? folder) (pred? folder))
       (copy-directory/files
        (build-path source-directory 
                    (get-file-or-directory-name folder))
        (build-path dest-directory
                    (make-unique-name 
                     (get-file-or-directory-name folder)
                     dest-directory)))))
   (directory-list source-directory)))

; Move the given directory into a destination folder renaming the destination if it
; already exists. Returns the path to the directory which might have been renamed.
(define (move-directory-to/renaming source-folder destination-folder)
  (define new-path (build-path
                             destination-folder
                             (make-unique-name
                              (get-file-or-directory-name source-folder) 
                              destination-folder)))
  (rename-file-or-directory source-folder new-path)
  new-path)

; Return #t if file is visible according to Unix conventions, #f otherwise.
(define (file-is-visible? file)
  (not (string=? "." (substring (get-file-or-directory-name file) 0 1))))

; Count the number of lines in text port.
; The port must support line-counting (not all ports do this).
(define (count-lines (port (current-input-port)))
  (let loop ((i 0)
             (line (read-line port)))
    (if (eof-object? line)
        i
        (loop (add1 i) (read-line port)))))


; Rename or copy a file to a target directory (relatively exception safe)
(define (rename-or-copy-file source target)
  (with-handlers ([exn:fail:filesystem? 
                   (lambda (exn)
                     (copy-file source target)
                     (delete-file source))])
    (rename-file-or-directory source target)))

; Rename or copy a directory to the target directory (relatively exception safe)
(define (rename-or-copy-directory source target)
  (with-handlers ([exn:fail:filesystem?
                   (lambda (exn)
                     (copy-directory/files source target)
                     (delete-directory/files source))])
    (rename-file-or-directory source target)))

; Move a file or directory to the destination directory (relatively exception safe)
(define (rename-or-copy-file-or-directory source target)
  (if (directory-exists? source)
      (rename-or-copy-directory source target)
      (rename-or-copy-file source target)))

; compare two files bytes for byte
(define (file-equal? file1 file2)
  (if (not (= (file-size file1) (file-size file2)))
      #f
      (if (file=? file1 file2)
          #t
          (let* ((port1 (open-input-file file1 #:mode 'binary))
                 (port2 (open-input-file file2 #:mode 'binary))
                 (result (let loop ((b1 (read-byte port1))
                                    (b2 (read-byte port2)))
                           (cond 
                             ((eof-object? b1) #t)
                             ((not (= b1 b2)) #f)
                             (else (loop (read-byte port1) (read-byte port2)))))))
            (close-input-port port1)
            (close-input-port port2)
            result))))