diff --git a/file.rkt b/file.rkt index f654ed0..18c9661 100644 --- a/file.rkt +++ b/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))))) diff --git a/main.rkt b/main.rkt index ff68855..911ff8c 100644 --- a/main.rkt +++ b/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")) \ No newline at end of file diff --git a/scribblings/file.scrbl b/scribblings/file.scrbl new file mode 100644 index 0000000..47f9180 --- /dev/null +++ b/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))) +] \ No newline at end of file diff --git a/scribblings/sugar.scrbl b/scribblings/sugar.scrbl index 5131ae4..a5991b2 100644 --- a/scribblings/sugar.scrbl +++ b/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"] diff --git a/tests.rkt b/tests.rkt index ec32562..840cede 100644 --- a/tests.rkt +++ b/tests.rkt @@ -108,4 +108,37 @@ ;(check-equal? (filter-tree (λ(i) (and (tagged-xexpr? i) (equal? 'em (car i)))) '(p "foo" (em "bar"))) '(p "foo")) (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))) \ No newline at end of file +(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) \ No newline at end of file