simplify more paths

pull/243/head
Matthew Butterick 3 years ago
parent 5e5dc5d9fd
commit ae4aaefba1

@ -39,7 +39,7 @@
(λ (path-or-path-string subkey caller-name) (λ (path-or-path-string subkey caller-name)
(define path (define path
(with-handlers ([exn:fail? (path-error-handler caller-name path-or-path-string)]) (with-handlers ([exn:fail? (path-error-handler caller-name path-or-path-string)])
(path->complete-path (if (path? path-or-path-string) (simple-form-path (if (path? path-or-path-string)
path-or-path-string path-or-path-string
(string->path path-or-path-string))))) (string->path path-or-path-string)))))
(unless (file-exists? path) (unless (file-exists? path)

@ -52,7 +52,7 @@
'pollen)])) 'pollen)]))
(define (very-nice-path x) (define (very-nice-path x)
(path->complete-path (simplify-path (cleanse-path (->path x))))) (simple-form-path (cleanse-path (->path x))))
(define (handle-test) (define (handle-test)
(displayln "raco pollen is installed correctly")) (displayln "raco pollen is installed correctly"))

@ -19,10 +19,9 @@
(parameterize ([current-directory (dirname (->complete-path starting-path))]) (parameterize ([current-directory (dirname (->complete-path starting-path))])
(let loop ([dir (current-directory)][path filename-to-find]) (let loop ([dir (current-directory)][path filename-to-find])
(and dir ; dir is #f when it hits the top of the filesystem (and dir ; dir is #f when it hits the top of the filesystem
(let ([completed-path (path->complete-path path)]) (match (simple-form-path path)
(if (exists-proc completed-path) [(? exists-proc sfp) sfp]
(simplify-path completed-path) [_ (loop (dirname dir) (build-path 'up path))])))))
(loop (dirname dir) (build-path 'up path))))))))
;; for files like svg that are not source in pollen terms, ;; for files like svg that are not source in pollen terms,

@ -31,7 +31,7 @@
pagetree-source?))]) pagetree-source?))])
(proc path)) (proc path))
#:unless (path-cached? path)) #:unless (path-cached? path))
(path->complete-path path))) (simple-form-path path)))
(cond (cond
[wants-dry-run? (for-each message uncached-paths)] [wants-dry-run? (for-each message uncached-paths)]

@ -1 +1 @@
1605630343 1606102497

@ -33,7 +33,7 @@
(require racket/runtime-path) (require racket/runtime-path)
(define-runtime-path sample-dir "test/data/samples") (define-runtime-path sample-dir "test/data/samples")
(define samples (parameterize ([current-directory sample-dir]) (define samples (parameterize ([current-directory sample-dir])
(map path->complete-path (filter (λ (name) (regexp-match "sample-" name)) (directory-list "."))))) (map simple-form-path (filter (λ (name) (regexp-match "sample-" name)) (directory-list ".")))))
(define-values (sample-01 sample-02 sample-03) (apply values samples))) (define-values (sample-01 sample-02 sample-03) (apply values samples)))
;; each key for mod-date-hash is a list of file / mod-date pairs (using pollen/cache keymaking function) ;; each key for mod-date-hash is a list of file / mod-date pairs (using pollen/cache keymaking function)

@ -1,6 +1,7 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base racket/syntax) (require (for-syntax racket/base racket/syntax)
racket/runtime-path racket/runtime-path
racket/path
"private/constants.rkt") "private/constants.rkt")
(provide (all-from-out "private/constants.rkt")) (provide (all-from-out "private/constants.rkt"))
@ -23,10 +24,10 @@
[(not maybe-dir) (current-directory)] [(not maybe-dir) (current-directory)]
[(directory-exists? maybe-dir) maybe-dir] [(directory-exists? maybe-dir) maybe-dir]
[else (define dir (dirname maybe-dir)) [else (define dir (dirname maybe-dir))
(and (not (eq? 'relative dir)) (path->complete-path dir (current-directory)))])) (and (not (eq? 'relative dir)) (simple-form-path dir (current-directory)))]))
(let loop ([dir starting-dir][path default-directory-require]) (let loop ([dir starting-dir][path default-directory-require])
(and dir ; dir is #f when it hits the top of the filesystem (and dir ; dir is #f when it hits the top of the filesystem
(let ([simplified-path (simplify-path (path->complete-path path starting-dir))]) (let ([simplified-path (simple-form-path (path->complete-path path starting-dir))])
(if (file-exists? simplified-path) (if (file-exists? simplified-path)
simplified-path simplified-path
(loop (dirname dir) (build-path 'up path))))))) (loop (dirname dir) (build-path 'up path)))))))

Loading…
Cancel
Save