correct `unescape-ext` to only operate on filename (closes #100)

pull/102/head
Matthew Butterick 9 years ago
parent 43809705f1
commit ef7494ed83

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base racket/syntax)) (require (for-syntax racket/base racket/syntax))
(require racket/contract racket/path racket/match) (require racket/contract racket/path)
(require (only-in racket/path filename-extension)) (require (only-in racket/path filename-extension))
(require "world.rkt" sugar/define sugar/file sugar/string sugar/coerce sugar/test) (require "world.rkt" sugar/define sugar/file sugar/string sugar/coerce sugar/test)
@ -81,24 +81,40 @@
(check-equal? (escape-last-ext "foo.html") (->path "foo_html")) (check-equal? (escape-last-ext "foo.html") (->path "foo_html"))
(check-equal? (escape-last-ext "foo.html" #\$) (->path "foo$html"))) (check-equal? (escape-last-ext "foo.html" #\$) (->path "foo$html")))
(define second cadr)
(define third caddr)
(define (last x) (car (reverse x)))
(define+provide/contract (unescape-ext x [escape-char (world:current-extension-escape-char)]) (define+provide/contract (unescape-ext x [escape-char (world:current-extension-escape-char)])
((pathish?) (char?) . ->* . coerce/path?) ((coerce/string?) (char?) . ->* . coerce/path?)
;; if x has an escaped extension, unescape it. ;; if x has an escaped extension, unescape it.
(define xstr (->string x)) (define-values (base name dir?) (split-path x))
(define pat (regexp (format "(.*)[~a](.*)$" escape-char))) (cond
(define results (regexp-match pat xstr)) [dir? x]
[else
(define x-parts (explode-path x))
(define filename (last x-parts))
(define escaped-extension-pat (pregexp (format "(.*)[~a](\\S+)$" escape-char)))
(define results (regexp-match escaped-extension-pat (->string filename)))
(if results (if results
(match-let ([(list _ filename ext) results]) (let* ([filename-without-ext (second results)]
(add-ext filename ext)) [ext (third results)]
x)) [new-filename (add-ext filename-without-ext ext)])
(if (eq? base 'relative)
new-filename
(build-path base new-filename)))
x)]))
(module-test-external (module-test-external
(require sugar/coerce) (require sugar/coerce)
(check-equal? (unescape-ext "foo") (->path "foo")) (check-equal? (unescape-ext "foo") (->path "foo"))
(check-equal? (unescape-ext "foo_") (->path "foo_"))
(check-equal? (unescape-ext "foo_#$%") (->path "foo.#$%"))
(check-equal? (unescape-ext "foo.html") (->path "foo.html")) (check-equal? (unescape-ext "foo.html") (->path "foo.html"))
(check-equal? (unescape-ext "foo_html") (->path "foo.html")) (check-equal? (unescape-ext "foo_html") (->path "foo.html"))
(check-equal? (unescape-ext "foo_dir/bar") (->path "foo_dir/bar"))
(check-equal? (unescape-ext "foo_dir/bar.html") (->path "foo_dir/bar.html"))
(check-equal? (unescape-ext "foo_dir/bar_html") (->path "foo_dir/bar.html"))
(check-equal? (unescape-ext "foo$html" #\$) (->path "foo.html")) (check-equal? (unescape-ext "foo$html" #\$) (->path "foo.html"))
(check-equal? (unescape-ext "foo_bar__html") (->path "foo_bar_.html")) (check-equal? (unescape-ext "foo_bar__html") (->path "foo_bar_.html"))
(check-equal? (unescape-ext "foo$bar$$html" #\$) (->path "foo$bar$.html"))) (check-equal? (unescape-ext "foo$bar$$html" #\$) (->path "foo$bar$.html")))

Loading…
Cancel
Save