update sugar/file & docs

file.rkt

@@ -1,17 +1,15 @@
 #lang racket/base
 (require "define.rkt" "coerce.rkt" "string.rkt" racket/path)
 
-
-
 (define+provide/contract (get-enclosing-dir p)
   (coerce/path? . -> . path?)
   (simplify-path (build-path p 'up)))
 
 ;; does path have a certain extension
 (define+provide/contract (has-ext? x ext)
-  (coerce/path? coerce/symbol? . -> . coerce/boolean?)
+  (coerce/path? coerce/string? . -> . coerce/boolean?)
   (define ext-of-path (filename-extension x))
-  (and ext-of-path (equal? (string-downcase (bytes->string/utf-8 ext-of-path)) (string-downcase (symbol->string ext)))))
+  (and ext-of-path (equal? (string-downcase (bytes->string/utf-8 ext-of-path)) (string-downcase ext))))
 
 ;; get file extension as a string, or return #f 
 ;; (consistent with filename-extension behavior)
@@ -29,8 +27,6 @@
   (coerce/path? . -> . coerce/boolean?)
   (ormap (λ(ext) (has-ext? x ext)) binary-extensions))
 
-
-
 ;; put extension on path
 ;; use local contract here because this function is used within module
 (define/contract+provide (add-ext x ext)
@@ -47,7 +43,7 @@
 
 
 ;; take all extensions off path
-(define+provide/contract (remove-all-ext x)
+(define+provide/contract (remove-ext* x)
   (coerce/path? . -> . path?)
   ;; pass through hidden files (those starting with a dot)
   (if (x . starts-with? . ".")
@@ -55,5 +51,5 @@
       (let ([path-with-removed-ext (remove-ext x)])
         (if (equal? x path-with-removed-ext)
             x
-            (remove-all-ext path-with-removed-ext)))))
+            (remove-ext* path-with-removed-ext)))))
 

main.rkt

@@ -10,7 +10,6 @@
   "misc.rkt"
   "string.rkt"
   "len.rkt"
-  "exception.rkt"
   "tree.rkt"
   "values.rkt")
 
@@ -25,6 +24,5 @@
   "misc.rkt"
   "string.rkt"
   "len.rkt"
-  "exception.rkt"
   "tree.rkt"
   "values.rkt"))

scribblings/file.scrbl

@@ -0,0 +1,89 @@
+#lang scribble/manual
+
+@(require scribble/eval (for-label racket sugar))
+
+@(define my-eval (make-base-eval))
+@(my-eval `(require sugar))
+
+@title{File}
+@defmodule[sugar/file]
+
+File utilities, mostly in the realm of file extensions. These functions don't access the filesystem. 
+
+Arguments that are @racket[pathish?] can take either a string or a path. For clarity below, I've used strings.
+
+@defproc[
+(get-ext
+[file-path pathish?])
+(or/c #f string?)]
+Return the last file extension of @racket[_file-path] as a string, or @racket[#f] if it has no extension. Omit the intervening @litchar{.} separator. 
+
+@examples[#:eval my-eval
+(get-ext "foo.txt")
+(get-ext "/path/to/foo.txt")
+(get-ext "/path/to/foo.txt.bar")
+(get-ext "/path/to/file-without-extension")
+(get-ext "/path/to/directory/")]
+
+@defproc[
+(has-ext?
+[file-path pathish?]
+[ext stringish?])
+boolean?]
+Return @racket[#t] if the last file extension of @racket[_file-path] is @racket[_ext], otherwise @racket[#f].
+
+@examples[#:eval my-eval
+(has-ext? "foo.txt" "txt")
+(has-ext? "foo.txt" "jpg")
+(has-ext? "foo.jpg.txt" "jpg")]
+
+@defproc[
+(remove-ext
+[file-path pathish?])
+path?]
+Remove the last file extension of @racket[_file-path], and return the path that remains. If @racket[_file-path] has no extension, you just get the same @racket[_file-path]. Does not use the filesystem.
+
+@examples[#:eval my-eval
+(remove-ext "foo.txt")
+(remove-ext "/path/to/foo.txt")
+(remove-ext "/path/to/foo.txt.bar")
+(remove-ext (remove-ext "/path/to/foo.txt.bar"))]
+
+@defproc[
+(remove-ext*
+[file-path pathish?])
+path?]
+Like @racket[remove-ext], just more. Remove all file extensions from @racket[_file-path], and return the path that remains. If @racket[_file-path] has no extensions, you just get the same @racket[_file-path]. Does not use the filesystem.
+
+@examples[#:eval my-eval
+(remove-ext* "foo.txt")
+(remove-ext* "/path/to/foo.txt")
+(remove-ext* "/path/to/foo.txt.bar")
+(remove-ext* (remove-ext* "/path/to/foo.txt.bar"))]
+
+@defproc[
+(add-ext
+[file-path pathish?]
+[ext stringish?])
+path?]
+Return a new @racket[_file-path] with @racket[_ext] appended. Note that this does not replace an existing file extension. If that's what you want, then do @racket[(add-ext (remove-ext _file-path) _ext)].
+
+@examples[#:eval my-eval
+(add-ext "foo" "txt")
+(add-ext "foo.txt" "jpg")
+(add-ext (remove-ext "foo.txt") "jpg")]
+
+
+@defproc[
+(get-enclosing-dir
+[path pathish?])
+path?]
+Return the enclosing directory of @racket[_path]. Does not consult the filesystem about whether @racket[_path] is valid. If you reach the @racket[_root] directory, then @racket[(get-enclosing-dir _root)] will just return @racket[_root] again.
+
+@examples[#:eval my-eval
+(define bin (string->path "/usr/bin"))
+bin
+(get-enclosing-dir bin)
+(get-enclosing-dir (get-enclosing-dir bin))
+(get-enclosing-dir (get-enclosing-dir (get-enclosing-dir bin)))
+]

scribblings/sugar.scrbl

@@ -24,6 +24,8 @@ A collection of small functions to help make Racket code simpler & more readable
 
 @include-section["debug.scrbl"]
 
+@include-section["file.scrbl"]
+
 @include-section["len.scrbl"]
 
 @include-section["license.scrbl"]

tests.rkt

@@ -109,3 +109,36 @@
 
 (check-equal? (map-tree (λ(i) (if (number? i) (* 2 i) i)) '(p 1 2 3 (em 4 5))) '(p 2 4 6 (em 8 10)))
 (check-equal? (map-tree (λ(i) (if (symbol? i) 'foo i)) '(p 1 2 3 (em 4 5))) '(foo 1 2 3 (foo 4 5)))
+
+
+(define foo-path-strings '("foo" "foo.txt" "foo.bar" "foo.bar.txt"))
+(define-values (foo-path foo.txt-path foo.bar-path foo.bar.txt-path) 
+  (apply values (map ->path foo-path-strings)))
+;; test the sample paths before using them for other tests
+(define foo-paths (list foo-path foo.txt-path foo.bar-path foo.bar.txt-path))
+(for-each check-equal? (map ->string foo-paths) foo-path-strings)
+
+
+(check-false (has-ext? foo-path 'txt)) 
+(check-true (foo.txt-path . has-ext? . 'txt))
+(check-true ((->path "foo.TXT") . has-ext? . 'txt))
+(check-true (has-ext? foo.bar.txt-path 'txt))
+(check-false (foo.bar.txt-path . has-ext? . 'doc)) ; wrong extension
+
+
+(check-equal? (get-ext (->path "foo.txt")) "txt")
+(check-false (get-ext "foo"))
+
+(check-equal? (add-ext (string->path "foo") "txt") (string->path "foo.txt"))
+(check-equal? (remove-ext foo-path) foo-path)
+(check-equal? (remove-ext (->path ".foo.txt")) (->path ".foo.txt"))
+(check-equal? (remove-ext foo.txt-path) foo-path)
+(check-equal? (remove-ext foo.bar.txt-path) foo.bar-path)
+(check-not-equal? (remove-ext foo.bar.txt-path) foo-path) ; does not remove all extensions
+
+
+(check-equal? (remove-ext* foo-path) foo-path)
+(check-equal? (remove-ext* foo.txt-path) foo-path)
+(check-equal? (remove-ext* (->path ".foo.txt")) (->path ".foo.txt"))
+(check-not-equal? (remove-ext* foo.bar.txt-path) foo.bar-path) ; removes more than one ext
+(check-equal? (remove-ext* foo.bar.txt-path) foo-path)