add `get-doc`, `get-metas`, `get-source` & related

pull/110/head
Matthew Butterick 9 years ago
parent 97b6dbb977
commit 18cdb277c1

@ -72,7 +72,7 @@
(define (paths->key source-path [template-path #f]) (define (paths->key source-path [template-path #f])
;; key is list of file + mod-time pairs, use #f for missing ;; key is list of file + mod-time pairs, use #f for missing
(define path-strings (append (list source-path) (define path-strings (append (list source-path)
(append (list (and template-path (or (->source-path template-path) template-path))) ; if template has a source file, track that instead (append (list (and template-path (or (get-source template-path) template-path))) ; if template has a source file, track that instead
(->list (get-directory-require-files source-path))))) ; is either list of files or (list #f) (->list (get-directory-require-files source-path))))) ; is either list of files or (list #f)
;; can't use relative paths for cache keys because source files include `here-path` which is absolute. ;; can't use relative paths for cache keys because source files include `here-path` which is absolute.

@ -267,6 +267,21 @@
(check-equal? (->markup-source-path 'foo) (->path "foo.pm"))) (check-equal? (->markup-source-path 'foo) (->path "foo.pm")))
(make-source-utility-functions markdown) (make-source-utility-functions markdown)
(module-test-external
(require sugar/coerce)
(check-true (markdown-source? "foo.html.pmd"))
(check-false (markdown-source? "foo.html"))
(check-false (markdown-source? #f))
(check-equal? (->markdown-source-paths (->path "foo.pmd")) (list (->path "foo.pmd")))
(check-equal? (->markdown-source-paths (->path "foo.html")) (list (->path "foo.html.pmd") (->path "foo_html.pmd")
(->path "foo.poly.pmd") (->path "foo_poly.pmd")))
(check-equal? (->markdown-source-paths "foo") (list (->path "foo.pmd")))
(check-equal? (->markdown-source-paths 'foo) (list (->path "foo.pmd")))
(check-equal? (->markdown-source-path (->path "foo.pmd")) (->path "foo.pmd"))
(check-equal? (->markdown-source-path (->path "foo.html")) (->path "foo.html.pmd"))
(check-equal? (->markdown-source-path "foo") (->path "foo.pmd"))
(check-equal? (->markdown-source-path 'foo) (->path "foo.pmd")))
(make-source-utility-functions template) (make-source-utility-functions template)
(module-test-external (module-test-external
@ -277,10 +292,12 @@
(make-source-utility-functions scribble) (make-source-utility-functions scribble)
(define/contract+provide (->source-path path) (define/contract+provide (get-source path)
(coerce/path? . -> . (or/c #f path?)) (coerce/path? . -> . (or/c #f path?))
(ormap (λ(proc) (proc path)) (list get-markup-source get-markdown-source get-preproc-source get-null-source get-scribble-source))) (ormap (λ(proc) (proc path)) (list get-markup-source get-markdown-source get-preproc-source get-null-source get-scribble-source)))
;; for backward compatibility
(define+provide ->source-path get-source)
(define+provide/contract (->output-path x) (define+provide/contract (->output-path x)
(coerce/path? . -> . coerce/path?) (coerce/path? . -> . coerce/path?)

@ -11,12 +11,14 @@
A utility module that provides functions for working with Pollen source and output files. The tests rely on file extensions specified in @racket[pollen/world]. A utility module that provides functions for working with Pollen source and output files. The tests rely on file extensions specified in @racket[pollen/world].
Pollen handles six kinds of source files: Pollen handles seven kinds of source files:
@bold{Preprocessor}, with file extension @code[(format ".~a" world:preproc-source-ext)]. @bold{Preprocessor}, with file extension @code[(format ".~a" world:preproc-source-ext)].
@bold{Markup}, with file extension @code[(format ".~a" world:markup-source-ext)]. @bold{Markup}, with file extension @code[(format ".~a" world:markup-source-ext)].
@bold{Markdown}, with file extension @code[(format ".~a" world:markdown-source-ext)].
@bold{Template}, with file extension @code[(format ".~a" world:template-source-ext)]. @bold{Template}, with file extension @code[(format ".~a" world:template-source-ext)].
@bold{Null}, with file extension @code[(format ".~a" world:null-source-ext)]. @bold{Null}, with file extension @code[(format ".~a" world:null-source-ext)].
@ -36,6 +38,11 @@ boolean?]
[v any/c]) [v any/c])
boolean?] boolean?]
@defproc[
(markdown-source?
[v any/c])
boolean?]
@defproc[ @defproc[
(template-source? (template-source?
[v any/c]) [v any/c])
@ -61,6 +68,7 @@ Test whether @racket[_v] is a path representing a source file of the specified t
@examples[#:eval my-eval @examples[#:eval my-eval
(preproc-source? "main.css.pp") (preproc-source? "main.css.pp")
(markup-source? "default.html.pm") (markup-source? "default.html.pm")
(markdown-source? "default.html.pmd")
(template-source? "main.html.pt") (template-source? "main.html.pt")
(null-source? "index.html.p") (null-source? "index.html.p")
(scribble-source? "file.scrbl") (scribble-source? "file.scrbl")
@ -80,6 +88,11 @@ boolean?]
[v any/c]) [v any/c])
boolean?] boolean?]
@defproc[
(has-markdown-source?
[v any/c])
boolean?]
@defproc[ @defproc[
(has-template-source? (has-template-source?
[v any/c]) [v any/c])
@ -112,6 +125,11 @@ boolean?]
[v any/c]) [v any/c])
boolean?] boolean?]
@defproc[
(has/is-markdown-source?
[v any/c])
boolean?]
@defproc[ @defproc[
(has/is-template-source? (has/is-template-source?
[v any/c]) [v any/c])
@ -141,6 +159,11 @@ path?]
[p pathish?]) [p pathish?])
path?] path?]
@defproc[
(->markdown-source-path
[p pathish?])
path?]
@defproc[ @defproc[
(->template-source-path (->template-source-path
[p pathish?]) [p pathish?])
@ -162,12 +185,53 @@ Convert an output path @racket[_p] into the source path of the specified type th
(define name "default.html") (define name "default.html")
(->preproc-source-path name) (->preproc-source-path name)
(->markup-source-path name) (->markup-source-path name)
(->markdown-source-path name)
(->template-source-path name) (->template-source-path name)
(->scribble-source-path name) (->scribble-source-path name)
(->null-source-path name) (->null-source-path name)
] ]
@deftogether[
(@defproc[
(get-preproc-source
[p pathish?])
(or/c #f path?)]
@defproc[
(get-markup-source
[p pathish?])
(or/c #f path?)]
@defproc[
(get-markdown-source
[p pathish?])
(or/c #f path?)]
@defproc[
(get-template-source
[p pathish?])
(or/c #f path?)]
@defproc[
(get-null-source
[p pathish?])
(or/c #f path?)]
@defproc[
(get-scribble-source
[p pathish?])
(or/c #f path?)]
)]
Find an existing source path of the specified type that would produce the output path @racket[_p]. If there is no source of the specified type, return @racket[#f].
@defproc[
(get-source
[p pathish?])
(or/c #f path?)]
Find an existing source path that would produce the output path @racket[_p]. Check source formats in this order: @racket[get-markup-source], @racket[get-markdown-source], @racket[get-preproc-source], @racket[get-null-source], @racket[get-scribble-source]. If there is no corresponding source, return @racket[#f].
@defproc[ @defproc[
@ -181,4 +245,4 @@ Convert a source path @racket[_p] into its corresponding output path. This funct
(->output-path "default.html.pm") (->output-path "default.html.pm")
(->output-path "index.html.p") (->output-path "index.html.p")
(->output-path "file.scrbl") (->output-path "file.scrbl")
] ]

@ -84,6 +84,29 @@ As the input contract suggests, this function can take either a single @racket[x
] ]
@defproc[
(get-doc
[doc-source (or/c pagenode? pathish?)])
(or/c txexpr? string?)]
Retrieve the @racket[doc] export from @racket[_doc-source], which can be either a path, path string, or pagenode that can be resolved into a source path. If @racket[_doc-source] cannot be resolved, raise an error.
If @racket[_doc-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
If @racket[world:current-main-export] is set to an identifier name other than @racket[doc], then that identifier is retrieved instead.
@defproc[
(get-metas
[meta-source (or/c pagenode? pathish?)])
hash?]
Retrieve the @racket[metas] export from @racket[_meta-source], which can be either a path, path string, or pagenode that can be resolved into a source path. If @racket[_meta-source] cannot be resolved, raise an error.
If @racket[_meta-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
If @racket[world:current-meta-export] is set to an identifier name other than @racket[metas], then that identifier is retrieved instead.
@deftogether[( @deftogether[(
@defproc[ @defproc[
@ -139,7 +162,6 @@ Note that if @racket[_meta-source] is a relative path or pagenode, it is treated
] ]
@defproc[ @defproc[
(select-from-doc (select-from-doc
[key symbolish?] [key symbolish?]
@ -160,6 +182,9 @@ Note that if @racket[_doc-source] is a relative path or pagenode, it is treated
(select-from-doc 'nonexistent-key doc) (select-from-doc 'nonexistent-key doc)
] ]
@defproc[ @defproc[
(when/block (when/block
[condition any/c] [condition any/c]

@ -222,7 +222,7 @@
(define path-source-pairs (define path-source-pairs
(map (map
(λ(p) (define source (λ(p) (define source
(let ([possible-source (->source-path (build-path dashboard-dir p))]) (let ([possible-source (get-source (build-path dashboard-dir p))])
(and possible-source (->string (find-relative-path dashboard-dir possible-source))))) (and possible-source (->string (find-relative-path dashboard-dir possible-source)))))
(cons p source)) (cons p source))
project-paths)) project-paths))

@ -76,28 +76,30 @@
(check-equal? (select-from-doc 'key '(root (key "value"))) '("value")) (check-equal? (select-from-doc 'key '(root (key "value"))) '("value"))
(check-false (select-from-doc 'absent-key '(root (key "value")))) (check-false (select-from-doc 'absent-key '(root (key "value"))))
(let ([doc '(root (key "value"))]) (let ([doc '(root (key "value"))])
(check-equal? (select-from-doc 'key doc) '("value")) (check-equal? (select-from-doc 'key doc) '("value"))
(check-false (select-from-doc 'absent-key doc)))) (check-false (select-from-doc 'absent-key doc))))
(define (get-metas pagenode-or-path) (define (pagenode-or-path->source pagenode-or-path)
; ((or/c pagenode? pathish?) . -> . hash?) (get-source (if (pagenode? pagenode-or-path)
(define source-path (->source-path (cond (pagenode->path pagenode-or-path)
[(pagenode? pagenode-or-path) (pagenode->path pagenode-or-path)] pagenode-or-path)))
[else pagenode-or-path])))
(if source-path
(cached-require source-path (world:current-meta-export))
(error (format "get-metas: no source found for '~a' in directory ~a" pagenode-or-path (current-directory)))))
(define (get-doc pagenode-or-path) (define+provide/contract (get-metas pagenode-or-path)
; ((or/c pagenode? pathish?) . -> . (or/c txexpr? string?)) ((or/c pagenode? pathish?) . -> . hash?)
(define source-path (->source-path (cond (define source-path (pagenode-or-path->source pagenode-or-path))
[(pagenode? pagenode-or-path) (pagenode->path pagenode-or-path)] (unless source-path
[else pagenode-or-path]))) (error (format "get-metas: no source found for '~a' in directory ~a" pagenode-or-path (current-directory))))
(if source-path (cached-require source-path (world:current-meta-export)))
(cached-require source-path (world:current-main-export))
(error (format "get-doc: no source found for '~a' in directory ~a" pagenode-or-path (current-directory)))))
(define+provide/contract (get-doc pagenode-or-path)
((or/c pagenode? pathish?) . -> . (or/c txexpr? string?))
(define source-path (pagenode-or-path->source pagenode-or-path))
(unless source-path
(error (format "get-doc: no source found for '~a' in directory ~a" pagenode-or-path (current-directory))))
(cached-require source-path (world:current-main-export)))
(define (trim-outer-tag html) (define (trim-outer-tag html)
@ -109,7 +111,7 @@
(define+provide/contract (->html x-in #:tag [tag #f] #:attrs [attrs #f] #:splice [splice? #f]) (define+provide/contract (->html x-in #:tag [tag #f] #:attrs [attrs #f] #:splice [splice? #f])
(((or/c xexpr? (listof xexpr?))) (#:tag (or/c #f txexpr-tag?) #:attrs (or/c #f txexpr-attrs?) #:splice boolean?) . ->* . string?) (((or/c xexpr? (listof xexpr?))) (#:tag (or/c #f txexpr-tag?) #:attrs (or/c #f txexpr-attrs?) #:splice boolean?) . ->* . string?)
(define x (cond (define x (cond
[(txexpr? x-in) x-in] [(txexpr? x-in) x-in]
[(list? x-in) (cons 'html x-in)] [(list? x-in) (cons 'html x-in)]
@ -144,7 +146,7 @@
(check-equal? (->html #:splice #t x) "hello") (check-equal? (->html #:splice #t x) "hello")
(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) x) "<brennan id=\"dale\">hello</brennan>") (check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) x) "<brennan id=\"dale\">hello</brennan>")
(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) #:splice #t x) "hello") (check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) #:splice #t x) "hello")
(define xs '("hello " (em "you") " " 42)) (define xs '("hello " (em "you") " " 42))
(check-equal? (->html xs) "hello <em>you</em> &#42;") (check-equal? (->html xs) "hello <em>you</em> &#42;")
(check-equal? (->html #:splice #t xs) "hello <em>you</em> &#42;") (check-equal? (->html #:splice #t xs) "hello <em>you</em> &#42;")
@ -157,4 +159,4 @@
#'(if condition (string-append* #'(if condition (string-append*
(with-handlers ([exn:fail? (λ(exn) (error (format "within when/block, ~a" (exn-message exn))))]) (with-handlers ([exn:fail? (λ(exn) (error (format "within when/block, ~a" (exn-message exn))))])
(map ->string (list body ...)))) (map ->string (list body ...))))
"")])) "")]))

@ -1,5 +1,5 @@
#lang at-exp racket/base #lang at-exp racket/base
(require rackunit racket/runtime-path pollen/project pollen/render) (require rackunit racket/runtime-path pollen/project pollen/render racket/file)
(define-runtime-path pathup-one "data/pathup/subdir/test-pathup-one.html.pm") (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 dr-top "data/pathup/pollen.rkt")
@ -7,8 +7,17 @@
(define-runtime-path dr-sub "data/pathup/subdir/subdir/pollen.rkt") (define-runtime-path dr-sub "data/pathup/subdir/subdir/pollen.rkt")
(define-runtime-path template "data/pathup/subdir/template.html") (define-runtime-path template "data/pathup/subdir/template.html")
(define-runtime-path cache-dir "data/pathup/subdir/pollen-cache")
(define-runtime-path other-cache-dir "data/pathup/subdir/subdir/pollen-cache")
(check-false (get-directory-require-files "test-pathup.rkt")) (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-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-one) template)
(check-equal? (get-template-for pathup-two) template) (check-equal? (get-template-for pathup-two) template)
(when (directory-exists? cache-dir)
(delete-directory/files cache-dir))
(when (directory-exists? other-cache-dir)
(delete-directory/files other-cache-dir))
Loading…
Cancel
Save