From bc95ce269e75ac67ebd17ed0e8d033b80131ac7c Mon Sep 17 00:00:00 2001 From: lijunsong Date: Sun, 10 Apr 2016 23:49:11 -0700 Subject: [PATCH 1/2] fix #16 remove-ext doesn't work. The problem was remove-ext (and remove-ext*) function checked the given path for hidden files. This fix lets remove-ext check file name of the given path. --- sugar/file.rkt | 20 ++++++++++++-------- sugar/test/main.rkt | 8 ++++++++ 2 files changed, 20 insertions(+), 8 deletions(-) diff --git a/sugar/file.rkt b/sugar/file.rkt index 9a37eae..e3e1e5d 100644 --- a/sugar/file.rkt +++ b/sugar/file.rkt @@ -45,8 +45,9 @@ (define+provide+safe (remove-ext x) (pathish? . -> . path?) ;; pass through hidden files (those starting with a dot) - (let ([x (->path x)]) - (if ((->string x) . starts-with? . ".") + (let* ([x (->path x)] + [x-name (file-name-from-path x)]) + (if ((->string x-name) . starts-with? . ".") x (path-replace-suffix x "")))) @@ -54,11 +55,14 @@ ;; take all extensions off path (define+provide+safe (remove-ext* x) (pathish? . -> . path?) + (define (remove* p) + (let ([path-with-removed-ext (path-replace-suffix p "")]) + (if (equal? p path-with-removed-ext) + p + (remove* path-with-removed-ext)))) ;; pass through hidden files (those starting with a dot) - (let ([x (->path x)]) - (if ((->string x) . starts-with? . ".") + (let ([x (->path x)] + [x-name (file-name-from-path x)]) + (if ((->string x-name) . starts-with? . ".") x - (let ([path-with-removed-ext (remove-ext x)]) - (if (equal? x path-with-removed-ext) - x - (remove-ext* path-with-removed-ext)))))) \ No newline at end of file + (remove* x)))) \ No newline at end of file diff --git a/sugar/test/main.rkt b/sugar/test/main.rkt index e779373..0833e9d 100644 --- a/sugar/test/main.rkt +++ b/sugar/test/main.rkt @@ -154,12 +154,20 @@ (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 + ;; test remove-ext on paths that have "." prefix + (check-equal? (remove-ext (->path "./foo.txt.bar")) (->path "./foo.txt")) + (check-equal? (remove-ext (->path "../foo.txt.bar")) (->path "../foo.txt")) + (check-equal? (remove-ext (->path "/hidden/file/.foo.txt.bar")) (->path "/hidden/file/.foo.txt.bar")) ; hidden file won't change (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) + ;; test remove-ext* on paths that have "." prefix + (check-equal? (remove-ext* (->path "./foo.txt.bar")) (->path "./foo")) + (check-equal? (remove-ext* (->path "../foo.txt.bar")) (->path "../foo")) + (check-equal? (remove-ext* (->path "/hidden/file/.foo.txt.bar")) (->path "/hidden/file/.foo.txt.bar")) ; hidden file won't change (check-true (has-binary-ext? "foo.MP3")) (check-false (has-binary-ext? "foo.py")) -- 2.25.1 From 63b7f84a89a2c4957a3e40099c03266e07054d10 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 11 Apr 2016 11:20:21 -0700 Subject: [PATCH 2/2] adjustments --- sugar/file.rkt | 62 ++++++++++++++++++++++++++++++--------------- sugar/test/main.rkt | 1 + 2 files changed, 43 insertions(+), 20 deletions(-) diff --git a/sugar/file.rkt b/sugar/file.rkt index e3e1e5d..50d4353 100644 --- a/sugar/file.rkt +++ b/sugar/file.rkt @@ -1,12 +1,36 @@ #lang racket/base -(require "define.rkt" "coerce/base.rkt" racket/path) +(require "define.rkt" "coerce/base.rkt") -;; does path have a certain extension +;; this is identical to `filename-extension` in `racket/path` +;; but will not treat hidden files as an extension (which IMHO is a bug) +(define (filename-extension name) + (let* ([name (file-name-from-path name)] + [name (and name (path->bytes name))]) + (cond [(and name (regexp-match #rx#".[.]([^.]+)$" name)) => cadr] + [else #f]))) + +(module+ test + (require rackunit) + (require (prefix-in rp: racket/path)) + (check-equal? (rp:filename-extension (string->path ".foo")) #"foo") ; bad behavior + (check-false (filename-extension (string->path ".foo")))) ; good behavior + + +;; this is pulled in from `racket/path` to avoid the dependency +(define (file-name-from-path name) + (unless (or (path-string? name) + (path-for-some-system? name)) + (raise-argument-error 'file-name-from-path "(or/c path-string? path-for-some-system?)" name)) + (let-values ([(base file dir?) (split-path name)]) + (and (not dir?) (path-for-some-system? file) file))) + + +;; does path have a certain extension, case-insensitively (define+provide+safe (has-ext? x ext) (pathish? stringish? . -> . boolean?) (define ext-of-path (filename-extension (->path x))) - (->boolean (and ext-of-path (equal? (string-downcase (bytes->string/utf-8 ext-of-path)) (string-downcase (->string ext)))))) + (and ext-of-path (equal? (string-downcase (bytes->string/utf-8 ext-of-path)) (string-downcase (->string ext))))) ;; get file extension as a string, or return #f @@ -40,29 +64,27 @@ (define pat (regexp (format "^~a" (regexp-quote starter)))) (and (regexp-match pat str) #t)) +(define (path-hidden? path) + ((->string (file-name-from-path path)) . starts-with? . ".")) + +;; with `remove-ext` and `remove-ext*`, +;; the policy is to pass through hidden files +;; though I can't remember why. ;; take one extension off path (define+provide+safe (remove-ext x) (pathish? . -> . path?) - ;; pass through hidden files (those starting with a dot) - (let* ([x (->path x)] - [x-name (file-name-from-path x)]) - (if ((->string x-name) . starts-with? . ".") - x - (path-replace-suffix x "")))) + (let ([path (->path x)]) + (if (path-hidden? path) + path + (path-replace-suffix path "")))) ;; take all extensions off path (define+provide+safe (remove-ext* x) (pathish? . -> . path?) - (define (remove* p) - (let ([path-with-removed-ext (path-replace-suffix p "")]) - (if (equal? p path-with-removed-ext) - p - (remove* path-with-removed-ext)))) - ;; pass through hidden files (those starting with a dot) - (let ([x (->path x)] - [x-name (file-name-from-path x)]) - (if ((->string x-name) . starts-with? . ".") - x - (remove* x)))) \ No newline at end of file + (let loop ([path (->path x)]) + (define path-out (remove-ext path)) + (if (equal? path path-out) + path + (loop path-out)))) \ No newline at end of file diff --git a/sugar/test/main.rkt b/sugar/test/main.rkt index 0833e9d..9c2edd0 100644 --- a/sugar/test/main.rkt +++ b/sugar/test/main.rkt @@ -147,6 +147,7 @@ (check-equal? (get-ext (->path "foo.txt")) "txt") (check-false (get-ext "foo")) + (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) -- 2.25.1