make sure `get-template-for` notices template sources

pull/102/head
Matthew Butterick 9 years ago
parent 9a508a8f44
commit 82a331175f

@ -11,13 +11,16 @@
dir)
(define+provide/contract (find-upward-from source-path filename-to-find)
(coerce/path? coerce/path? . -> . (or/c #f path?))
(parameterize ([current-directory (dirname (->complete-path source-path))])
(define+provide/contract (find-upward-from starting-path filename-to-find
[exists-proc file-exists?])
;; use exists-proc to permit less strict matching.
;; for instance, maybe it's ok to find the source for the path.
((coerce/path? coerce/path?)((path? . -> . any/c)) . ->* . (or/c #f path?))
(parameterize ([current-directory (dirname (->complete-path starting-path))])
(let loop ([dir (current-directory)][path filename-to-find])
(and dir ; dir is #f when it hits the top of the filesystem
(let ([completed-path (path->complete-path path)])
(if (file-exists? completed-path)
(if (exists-proc completed-path)
(simplify-path completed-path)
(loop (dirname dir) (build-path 'up path))))))))

@ -230,7 +230,7 @@
(define (get-default-template)
(and output-path-ext
(let ([default-template-filename (add-ext (world:current-default-template-prefix) output-path-ext)])
(find-upward-from source-path default-template-filename))))
(find-upward-from source-path default-template-filename file-exists-or-has-source?))))
(define (get-fallback-template)
(and output-path-ext

@ -1,11 +1,14 @@
#lang at-exp racket/base
(require rackunit racket/runtime-path pollen/project)
(require rackunit racket/runtime-path pollen/project pollen/render)
(define-runtime-path pathup-one "data/pathup/subdir/test-pathup-one.html.pm")
(define-runtime-path dr-top "data/pathup/pollen.rkt")
(define-runtime-path pathup-two "data/pathup/subdir/subdir/test-pathup-two.html.pm")
(define-runtime-path dr-sub "data/pathup/subdir/subdir/pollen.rkt")
(define-runtime-path template "data/pathup/subdir/template.html")
(check-false (get-directory-require-files "test-pathup.rkt"))
(check-equal? (get-directory-require-files pathup-one) (list dr-top))
(check-equal? (get-directory-require-files pathup-two) (list dr-sub))
(check-equal? (get-directory-require-files pathup-two) (list dr-sub))
(check-equal? (get-template-for pathup-one) template)
(check-equal? (get-template-for pathup-two) template)
Loading…
Cancel
Save