From 78c788ae1796e56e6da3dd3939220a594b6e263d Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Sun, 26 Jun 2016 12:03:30 -0700
Subject: [PATCH] fix handling of hidden files with `remove-ext`

---
 sugar/file.rkt      | 18 ++++++++++++++----
 sugar/test/main.rkt |  8 ++++----
 2 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/sugar/file.rkt b/sugar/file.rkt
index 50d4353..dfcd6a6 100644
--- a/sugar/file.rkt
+++ b/sugar/file.rkt
@@ -64,19 +64,29 @@
   (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.
+
+(define (do what path)
+  (define reversed-path-elements (reverse (explode-path path)))
+  (apply build-path `(,@(reverse (cdr reversed-path-elements))
+                      ,(if (eq? what 'hide)
+                           (format ".~a" (->string (car reversed-path-elements)))
+                           (regexp-replace #rx"^." (->string (car reversed-path-elements)) "")))))
+
 
 ;; take one extension off path
 (define+provide+safe (remove-ext x)
   (pathish? . -> . path?)
   (let ([path (->path x)])
+    ;; `path-replace-suffix` incorrectly thinks any leading dot counts as a file extension
+    ;; when it might be a hidden path.
+    ;; so handle hidden paths specially.
+    ;; this is fixed in later Racket versions with `path-replace-extension`
     (if (path-hidden? path)
-        path
+        (do 'hide (path-replace-suffix (do 'unhide path) ""))
         (path-replace-suffix path ""))))
 
 
diff --git a/sugar/test/main.rkt b/sugar/test/main.rkt
index 9c2edd0..d9e735d 100644
--- a/sugar/test/main.rkt
+++ b/sugar/test/main.rkt
@@ -151,24 +151,24 @@
  
  (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 (->path ".foo.txt")) (->path ".foo"))
  (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 (->path "/hidden/file/.foo.txt.bar")) (->path "/hidden/file/.foo.txt"))
  
  (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-equal? (remove-ext* (->path ".foo.txt")) (->path ".foo"))
  (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-equal? (remove-ext* (->path "/hidden/file/.foo.txt.bar")) (->path "/hidden/file/.foo"))
  
  (check-true (has-binary-ext? "foo.MP3"))
  (check-false (has-binary-ext? "foo.py"))