updates

file-tools.rkt

@@ -1,5 +1,5 @@
 #lang racket/base
-(require racket/contract)
+(require racket/contract racket/path)
 (require (only-in racket/path filename-extension))
 (require "world.rkt" "readability.rkt")
 
@@ -11,6 +11,7 @@
 ; helper functions for regenerate functions
 (define pollen-project-directory (current-directory))
 
+
 ;; if something can be successfully coerced to a path,
 ;; it's pathish.
 (define/contract (pathish? x)
@@ -36,6 +37,18 @@
   (check-false (directory-pathish? "foobar")))
 
 
+;; helper function for ptree
+;; make paths absolute to test whether files exist,
+;; then convert back to relative
+(define/contract (visible-files dir)
+  (directory-pathish? . -> . (listof path?))
+  (define (visible? relative-path)
+    (not ((->string relative-path) . starts-with? . ".")))
+  (filter visible? 
+          (map (λ(p) (find-relative-path dir p)) 
+               (filter file-exists? 
+                       (directory-list dir #:build? #t)))))
+
 ;; does path have a certain extension
 (define/contract (has-ext? x ext)
   (pathish? stringish? . -> . boolean?)
@@ -81,10 +94,14 @@
 ;; take one extension off path
 (define/contract (remove-ext x)
   (pathish? . -> . path?)
-  (path-replace-suffix (->path x) ""))
+  ;; pass through hidden files (those starting with a dot)
+  (if (x . starts-with? . ".")
+      x
+      (path-replace-suffix (->path x) "")))
 
 (module+ test  
   (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
@@ -93,15 +110,19 @@
 ;; take all extensions off path
 (define/contract (remove-all-ext x)
   (pathish? . -> . path?)
-  (define path (->path x))
+  ;; pass through hidden files (those starting with a dot)
-  (define path-with-removed-ext (remove-ext path))
+  (if (x . starts-with? . ".")
-  (if (equal? path path-with-removed-ext)
+      x
-      path
+      (let* ([path (->path x)]
-      (remove-all-ext path-with-removed-ext)))
+             [path-with-removed-ext (remove-ext path)])
+        (if (equal? path path-with-removed-ext)
+            path
+            (remove-all-ext path-with-removed-ext)))))
 
 (module+ test  
   (check-equal? (remove-all-ext foo-path) foo-path)
   (check-equal? (remove-all-ext foo.txt-path) foo-path)
+  (check-equal? (remove-all-ext (->path ".foo.txt")) (->path ".foo.txt"))
   (check-not-equal? (remove-all-ext foo.bar.txt-path) foo.bar-path) ; removes more than one ext
   (check-equal? (remove-all-ext foo.bar.txt-path) foo-path))
 

ptree.rkt

@@ -234,7 +234,8 @@
   ;; then remove duplicates because some sources might have already been rendered
   (define output-paths (remove-duplicates (map ->output-path files) equal?))
   ;; find ones that match pnode
-  (define matching-paths (filter (λ(x) (equal? (->string (remove-all-ext x)) (->string pnode))) output-paths))
+  (define matching-paths (filter (λ(x) (equal? (path->pnode x) (->string pnode))) output-paths))
+  
   (cond
     [((len matching-paths) . = . 1) (->string (car matching-paths))]
     [((len matching-paths) . > . 1) (error "More than one matching URL for" pnode)]
@@ -246,7 +247,7 @@
   (check-equal? (pnode->url 'foo files) "foo.html")
   (check-equal? (pnode->url 'bar files) "bar.html")
   ;;  (check-equal? (pnode->url 'zap files) 'error) ;; todo: how to test error?
-  (check-equal? (pnode->url 'hee files) "#"))
+  (check-false (pnode->url 'hee files)))
 
 
 ;; recursively processes tree, converting tree locations & their parents into xexprs of this shape:
@@ -312,7 +313,7 @@
   ;; try treating x as a directory, 
   ;; otherwise treat it as a list of paths
   (set! current-url-context (with-handlers ([exn:fail? (λ(e) x)])
-                              (directory-list x))))
+                              (visible-files (->path x)))))
 
 ;; set the state variable using the setter
 (set-current-url-context pollen-project-directory)
@@ -320,5 +321,5 @@
 (module+ main
   (displayln "Running module main")
   (set-current-ptree (make-project-ptree (->path "/Users/MB/git/bpt/")))
-  (set-current-url-context (directory-list "/Users/MB/git/bpt/"))
+  (set-current-url-context "/Users/MB/git/bpt/")
   (pnode->url (previous-pnode (previous-pnode 'what-is-typography))))