update sugar/file & docs

pull/2/head
Matthew Butterick 10 years ago
parent 3bb5037302
commit 0d05dcbd55

@ -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)))))

@ -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"))

@ -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)))
]

@ -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"]

@ -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)
Loading…
Cancel
Save