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

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.

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?)

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")
-]
+]

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]

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))

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) "<brennan id=\"dale\">hello</brennan>")
  (check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) #:splice #t x) "hello")
-
+ 
  (define xs '("hello " (em "you") " " 42))
  (check-equal? (->html 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* 
                       (with-handlers ([exn:fail? (λ(exn) (error (format "within when/block, ~a" (exn-message exn))))])
                         (map ->string (list body ...)))) 
-           "")]))
+           "")]))

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)
+(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))