From 18cdb277c13718d3c2a19c39f81a70a97764566c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 20 Jan 2016 08:37:18 -0500 Subject: [PATCH] add `get-doc`, `get-metas`, `get-source` & related --- cache.rkt | 2 +- file.rkt | 19 ++++++++++- scribblings/file.scrbl | 68 ++++++++++++++++++++++++++++++++++++-- scribblings/template.scrbl | 27 ++++++++++++++- server-routes.rkt | 2 +- template.rkt | 44 ++++++++++++------------ test/test-pathup.rkt | 13 ++++++-- 7 files changed, 146 insertions(+), 29 deletions(-) diff --git a/cache.rkt b/cache.rkt index 70e7617..5e295bf 100644 --- a/cache.rkt +++ b/cache.rkt @@ -72,7 +72,7 @@ (define (paths->key source-path [template-path #f]) ;; key is list of file + mod-time pairs, use #f for missing (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) ;; can't use relative paths for cache keys because source files include `here-path` which is absolute. diff --git a/file.rkt b/file.rkt index bbdf78c..d6af56e 100644 --- a/file.rkt +++ b/file.rkt @@ -267,6 +267,21 @@ (check-equal? (->markup-source-path 'foo) (->path "foo.pm"))) (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) (module-test-external @@ -277,10 +292,12 @@ (make-source-utility-functions scribble) -(define/contract+provide (->source-path path) +(define/contract+provide (get-source 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))) +;; for backward compatibility +(define+provide ->source-path get-source) (define+provide/contract (->output-path x) (coerce/path? . -> . coerce/path?) diff --git a/scribblings/file.scrbl b/scribblings/file.scrbl index bf39285..0d97934 100644 --- a/scribblings/file.scrbl +++ b/scribblings/file.scrbl @@ -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]. -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{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{Null}, with file extension @code[(format ".~a" world:null-source-ext)]. @@ -36,6 +38,11 @@ boolean?] [v any/c]) boolean?] +@defproc[ +(markdown-source? +[v any/c]) +boolean?] + @defproc[ (template-source? [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 (preproc-source? "main.css.pp") (markup-source? "default.html.pm") +(markdown-source? "default.html.pmd") (template-source? "main.html.pt") (null-source? "index.html.p") (scribble-source? "file.scrbl") @@ -80,6 +88,11 @@ boolean?] [v any/c]) boolean?] +@defproc[ +(has-markdown-source? +[v any/c]) +boolean?] + @defproc[ (has-template-source? [v any/c]) @@ -112,6 +125,11 @@ boolean?] [v any/c]) boolean?] +@defproc[ +(has/is-markdown-source? +[v any/c]) +boolean?] + @defproc[ (has/is-template-source? [v any/c]) @@ -141,6 +159,11 @@ path?] [p pathish?]) path?] +@defproc[ +(->markdown-source-path +[p pathish?]) +path?] + @defproc[ (->template-source-path [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") (->preproc-source-path name) (->markup-source-path name) +(->markdown-source-path name) (->template-source-path name) (->scribble-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[ @@ -181,4 +245,4 @@ Convert a source path @racket[_p] into its corresponding output path. This funct (->output-path "default.html.pm") (->output-path "index.html.p") (->output-path "file.scrbl") -] \ No newline at end of file +] diff --git a/scribblings/template.scrbl b/scribblings/template.scrbl index 828ae21..2c59ee5 100644 --- a/scribblings/template.scrbl +++ b/scribblings/template.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[( @defproc[ @@ -139,7 +162,6 @@ Note that if @racket[_meta-source] is a relative path or pagenode, it is treated ] - @defproc[ (select-from-doc [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) ] + + + @defproc[ (when/block [condition any/c] diff --git a/server-routes.rkt b/server-routes.rkt index d521e85..a774d79 100644 --- a/server-routes.rkt +++ b/server-routes.rkt @@ -222,7 +222,7 @@ (define path-source-pairs (map (λ(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))))) (cons p source)) project-paths)) diff --git a/template.rkt b/template.rkt index c1896bb..7eef8ca 100644 --- a/template.rkt +++ b/template.rkt @@ -76,28 +76,30 @@ (check-equal? (select-from-doc 'key '(root (key "value"))) '("value")) (check-false (select-from-doc 'absent-key '(root (key "value")))) (let ([doc '(root (key "value"))]) - (check-equal? (select-from-doc 'key doc) '("value")) - (check-false (select-from-doc 'absent-key doc)))) + (check-equal? (select-from-doc 'key doc) '("value")) + (check-false (select-from-doc 'absent-key doc)))) -(define (get-metas pagenode-or-path) - ; ((or/c pagenode? pathish?) . -> . hash?) - (define source-path (->source-path (cond - [(pagenode? pagenode-or-path) (pagenode->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 (pagenode-or-path->source pagenode-or-path) + (get-source (if (pagenode? pagenode-or-path) + (pagenode->path pagenode-or-path) + pagenode-or-path))) -(define (get-doc pagenode-or-path) - ; ((or/c pagenode? pathish?) . -> . (or/c txexpr? string?)) - (define source-path (->source-path (cond - [(pagenode? pagenode-or-path) (pagenode->path pagenode-or-path)] - [else pagenode-or-path]))) - (if source-path - (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-metas pagenode-or-path) + ((or/c pagenode? pathish?) . -> . hash?) + (define source-path (pagenode-or-path->source pagenode-or-path)) + (unless source-path + (error (format "get-metas: no source found for '~a' in directory ~a" pagenode-or-path (current-directory)))) + (cached-require source-path (world:current-meta-export))) + + +(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) @@ -109,7 +111,7 @@ (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?) - + (define x (cond [(txexpr? x-in) x-in] [(list? x-in) (cons 'html x-in)] @@ -144,7 +146,7 @@ (check-equal? (->html #:splice #t x) "hello") (check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) x) "hello") (check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) #:splice #t x) "hello") - + (define xs '("hello " (em "you") " " 42)) (check-equal? (->html xs) "hello you *") (check-equal? (->html #:splice #t xs) "hello you *") @@ -157,4 +159,4 @@ #'(if condition (string-append* (with-handlers ([exn:fail? (λ(exn) (error (format "within when/block, ~a" (exn-message exn))))]) (map ->string (list body ...)))) - "")])) \ No newline at end of file + "")])) diff --git a/test/test-pathup.rkt b/test/test-pathup.rkt index 39382f7..80201d5 100644 --- a/test/test-pathup.rkt +++ b/test/test-pathup.rkt @@ -1,5 +1,5 @@ #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 dr-top "data/pathup/pollen.rkt") @@ -7,8 +7,17 @@ (define-runtime-path dr-sub "data/pathup/subdir/subdir/pollen.rkt") (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-equal? (get-directory-require-files pathup-one) (list dr-top)) (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) \ No newline at end of file +(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)) \ No newline at end of file