1.5 update

pollen/cache.rkt

@@ -1,9 +1,10 @@
 #lang racket/base
 (require racket/file
          racket/list
+         racket/fasl
          sugar/define
          "private/cache-utils.rkt"
-         "private/debug.rkt"
+         "private/log.rkt"
          "setup.rkt")
 
 ;; The cache is a hash with paths as keys.
@@ -18,40 +19,45 @@
     (raise-argument-error 'reset-cache "path-string to existing directory" starting-dir))
   (for ([path (in-directory starting-dir)]
         #:when (cache-directory? path))
-    (message (format "removing cache directory: ~a" path))
-    (delete-directory/files path)))
+       (message (format "removing cache directory: ~a" path))
+       (delete-directory/files path)))
+
+(define ((path-error-handler caller-name path-or-path-string) e)
+  (raise-argument-error caller-name "valid path or path-string" path-or-path-string))
 
 (define-namespace-anchor cache-module-ns)
+
+(define use-fasl? #false)
+
 (define cached-require-base
   (let ([ram-cache (make-hash)])
     (λ (path-or-path-string subkey caller-name)
-      (define path (with-handlers ([exn:fail? (λ (e) (raise-argument-error caller-name "valid path or path-string" path-or-path-string))])
-                     (path->complete-path (if (path? path-or-path-string)
-                                              path-or-path-string
-                                              (string->path path-or-path-string)))))
-      
+      (define path
+        (with-handlers ([exn:fail? (path-error-handler caller-name path-or-path-string)])
+          (path->complete-path (if (path? path-or-path-string)
+                                   path-or-path-string
+                                   (string->path path-or-path-string)))))
       (unless (file-exists? path)
         (raise-argument-error caller-name "path to existing file" path-or-path-string))
-      
       (cond
         [(setup:compile-cache-active path)
          (define key (paths->key path))
-         (define (convert-path-to-cache-record) (path->hash path))
-         (define (get-cache-record) (cache-ref! key convert-path-to-cache-record))
+         (define (convert-path-to-cache-record) ((if use-fasl? s-exp->fasl values) (path->hash path)))
+         (define (get-cache-record) ((if use-fasl? fasl->s-exp values) (cache-ref! key convert-path-to-cache-record)))
          (define ram-cache-record (hash-ref! ram-cache key get-cache-record))
          (hash-ref ram-cache-record subkey)]
-        [else (parameterize ([current-namespace (make-base-namespace)])
-                (namespace-attach-module (namespace-anchor->namespace cache-module-ns) 'pollen/setup) ; brings in params
-                (dynamic-require path subkey))]))))
-
+        [else
+         (parameterize ([current-namespace (make-base-namespace)])
+           ;; brings in currently instantiated params (unlike namespace-require)
+           (define outer-ns (namespace-anchor->namespace cache-module-ns))
+           (namespace-attach-module outer-ns 'pollen/setup) 
+           (dynamic-require path subkey))]))))
 
 (define+provide (cached-require path-string subkey)
   (cached-require-base path-string subkey 'cached-require))
 
-
 (define+provide (cached-doc path-string)
   (cached-require-base path-string (setup:main-export) 'cached-doc))
 
-
 (define+provide (cached-metas path-string)
   (cached-require-base path-string (setup:meta-export) 'cached-metas))

pollen/core.rkt

@@ -1,12 +1,18 @@
 #lang racket/base
-(require (for-syntax racket/base "setup.rkt" "private/splice.rkt"))
-(require txexpr/base xml/path sugar/define sugar/coerce sugar/test racket/string)
-(require "private/file-utils.rkt"
+(require (for-syntax
+          racket/base
+          "setup.rkt")
+         racket/match
+         txexpr/base
+         xml/path
+         sugar/define
+         sugar/coerce
+         sugar/test
+         "private/file-utils.rkt"
          "setup.rkt"
          "cache.rkt"
          "pagetree.rkt"
-         "tag.rkt"
-         "private/splice.rkt")
+         "tag.rkt")
 
 (define is-meta-value? hash?)
 (define is-doc-value? txexpr?)
@@ -22,15 +28,15 @@
   ((coerce/symbol? (or/c is-meta-value? is-doc-value? pagenode? pathish?)) (symbol?) . ->* . (or/c #f txexpr-elements?))
   (define metas-result (and (not (is-doc-value? value-source)) (select-from-metas key value-source caller)))
   (define doc-result  (and (not (is-meta-value? value-source)) (select-from-doc key value-source caller)))
-  (define result (filter values (apply append (map ->list (list metas-result doc-result)))))
-  (and (pair? result) result))
-
+  (match (filter values (apply append (map ->list (list metas-result doc-result))))
+    [(? pair? res) res]
+    [_ #false]))
 
 (define+provide/contract (select key value-source)
   (coerce/symbol? (or/c is-meta-value? is-doc-value? pagenode? pathish?) . -> . (or/c #f txexpr-element?))
-  (define result (select* key value-source 'select))
-  (and (pair? result) (car result)))
-
+  (match (select* key value-source 'select)
+    [(cons res _) res]
+    [_ #false]))
 
 (module-test-external
  (check-equal? (select* 'key  '#hash((key . "value"))) '("value"))
@@ -52,31 +58,28 @@
    (check-false (select* 'absent-key  doc))
    (check-false (select 'absent-key  doc))))
 
-
 (define+provide/contract (select-from-metas key metas-source [caller 'select-from-metas])
   ;; output contract is a single txexpr-element
   ;; because metas is a hash, and a hash has only one value for a key.
   ((coerce/symbol? (or/c is-meta-value? pagenode? pathish?)) (symbol?) . ->* . (or/c #f txexpr-element?))
-  (define metas (if (is-meta-value? metas-source)
-                    metas-source
-                    (get-metas metas-source caller)))
-  (and (hash-has-key? metas key) (hash-ref metas key)))
+  (hash-ref (match metas-source
+              [(? is-meta-value? ms) ms]
+              [_  (get-metas metas-source caller)]) key #false))
 
 (module-test-external
  (let ([metas '#hash((key . "value"))])
    (check-equal? (select-from-metas 'key  metas) "value")
    (check-false (select-from-metas 'absent-key  metas))))
 
-
 (define+provide/contract (select-from-doc key doc-source [caller 'select-from-doc])
   ;; output contract is a list of elements
   ;; because doc is a txexpr, and a txexpr can have multiple values for a key
   ((coerce/symbol? (or/c is-doc-value? pagenode? pathish?)) (symbol?) . ->* . (or/c #f txexpr-elements?))
-  (define doc (if (is-doc-value? doc-source)
-                  doc-source
-                  (get-doc doc-source caller)))
-  (define result (se-path*/list (list key) doc))
-  (and (pair? result) result))
+  (match (se-path*/list (list key) (match doc-source
+                                     [(? is-doc-value?) doc-source]
+                                     [_ (get-doc doc-source caller)]))
+    [(? pair? result) result]
+    [_ #false]))
 
 (module-test-external
  (check-equal? (select-from-doc 'key  '(root (key "value"))) '("value"))
@@ -85,27 +88,23 @@
    (check-equal? (select-from-doc 'key  doc) '("value"))
    (check-false (select-from-doc 'absent-key  doc))))
 
-
 (define (convert+validate-path pagenode-or-path caller)
-  (let* ([path (if (pagenode? pagenode-or-path)
+  (define path (if (pagenode? pagenode-or-path)
                    (build-path (current-project-root) (symbol->string pagenode-or-path))
-                   pagenode-or-path)]
-         [path (or (get-source path) path)])
-    (unless (file-exists? path)
-      (raise-argument-error caller "existing Pollen source, or name of its output path" path))
-    path))
-
+                   pagenode-or-path))
+  (define src-path (or (get-source path) path))
+  (unless (file-exists? src-path)
+    (raise-argument-error caller "existing Pollen source, or name of its output path" src-path))
+  src-path)
 
 (define+provide/contract (get-metas pagenode-or-path [caller 'get-metas])
   (((or/c pagenode? pathish?)) (symbol?) . ->* . is-meta-value?) 
   (cached-metas (convert+validate-path pagenode-or-path caller)))
 
-
 (define+provide/contract (get-doc pagenode-or-path [caller 'get-doc])
   (((or/c pagenode? pathish?)) (symbol?) . ->* . (or/c is-doc-value? string?))
   (cached-doc (convert+validate-path pagenode-or-path caller)))
 
-
 ;; This `@` definition is here to provide a hook for the docs.
 ;; But this is just default tag behavior, and thus would work without the definition.
 ;; Which is why the splicing tag can be renamed:
@@ -125,7 +124,6 @@
              (SPLICING-TAG . BODY) 
              (SPLICING-TAG)))]))
 
-
 (provide for/splice for*/splice)
 
 (define-syntax (for/splice/base stx)
@@ -141,6 +139,5 @@
   (syntax-case stx ()
     [(_ . BODY) (syntax-property #'(for/splice/base . BODY) 'form #'for*/list)]))
 
-
 (provide when/block) ; bw compat
 (define-syntax when/block (make-rename-transformer #'when/splice))

pollen/decode.rkt

@@ -2,6 +2,7 @@
 (require xml
          txexpr/base
          racket/list
+         racket/match
          sugar/list
          sugar/define
          sugar/test
@@ -48,27 +49,29 @@
     #:exclude-tags txexpr-tags?
     #:exclude-attrs txexpr-attrs?) . ->* . decode-proc-output-contract)
   (let loop ([x tx-in])
-    (cond
-      [(txexpr? x) (define-values (tag attrs elements) (txexpr->values x))
-                   (cond
-                     [(or (memq tag excluded-tags)
-                          (for/or ([attr (in-list attrs)])
-                            (member attr excluded-attrs))) 
-                      x] ; because it's excluded
-                     [else
-                      ;; we apply processing here rather than do recursive descent on the pieces
-                      ;; because if we send them back through loop, certain element types are ambiguous
-                      ;; e.g., ((p "foo")) tests out as both txexpr-attrs and txexpr-elements
-                      (define decoded-txexpr (make-txexpr (txexpr-tag-proc tag) 
-                                                          (txexpr-attrs-proc attrs) 
-                                                          (txexpr-elements-proc (append-map (λ (x) (->list/tx (loop x))) elements))))
-                      (txexpr-proc ((if (block-txexpr? decoded-txexpr)
-                                        block-txexpr-proc
-                                        inline-txexpr-proc) decoded-txexpr))])]
-      [(string? x) (string-proc x)]
-      [(or (symbol? x) (valid-char? x)) (entity-proc x)]
-      [(cdata? x) (cdata-proc x)]
-      [else (error "decode: can't decode" x)])))
+    (match x
+      [(? txexpr?)
+       (define-values (tag attrs elements) (txexpr->values x))
+       (cond
+         [(or (memq tag excluded-tags)
+              (for/or ([attr (in-list attrs)])
+                      (member attr excluded-attrs))) x] ; because it's excluded
+         [else
+          ;; we apply processing here rather than do recursive descent on the pieces
+          ;; because if we send them back through loop, certain element types are ambiguous
+          ;; e.g., ((p "foo")) tests out as both txexpr-attrs and txexpr-elements
+          (define decoded-txexpr
+            (make-txexpr (txexpr-tag-proc tag) 
+                         (txexpr-attrs-proc attrs) 
+                         (txexpr-elements-proc (append-map (λ (x) (->list/tx (loop x))) elements))))
+          (txexpr-proc ((if (block-txexpr? decoded-txexpr)
+                            block-txexpr-proc
+                            inline-txexpr-proc) decoded-txexpr))])]
+      [(? string?) (string-proc x)]
+      [(? symbol?) (entity-proc x)]
+      [(? valid-char?) (entity-proc x)]
+      [(? cdata?) (cdata-proc x)]
+      [else (raise-argument-error 'decode "decodable thing" x)])))
 
 (module-test-external
  (require racket/list txexpr racket/function)
@@ -115,10 +118,8 @@
   (make-keyword-procedure
    (λ (kws kwargs . args)
      (define temp-tag (gensym "temp-tag"))
-     (define elements (car args))
-     (define decode-result (keyword-apply decode kws kwargs (list (cons temp-tag elements))))
-     (get-elements decode-result))))
-
+     (define elements (first args))
+     (get-elements (keyword-apply decode kws kwargs (list (cons temp-tag elements)))))))
 
 (define+provide/contract (block-txexpr? x)
   (any/c . -> . boolean?)
@@ -129,27 +130,30 @@
 
 (define+provide/contract (decode-linebreaks elems [maybe-linebreak-proc '(br)]
                                             #:separator [newline (setup:linebreak-separator)])
-  ((txexpr-elements?) ((or/c #f txexpr-element? (txexpr-element? txexpr-element? . -> . (or/c #f txexpr-element?))) #:separator string?) . ->* . txexpr-elements?)
+  ((txexpr-elements?)
+   ((or/c #f txexpr-element?
+          (txexpr-element? txexpr-element? . -> . (or/c #f txexpr-element?))) #:separator string?)
+   . ->* . txexpr-elements?)
   (unless (string? newline)
     (raise-argument-error 'decode-linebreaks "string" newline))
-  (define linebreak-proc (if (procedure? maybe-linebreak-proc)
-                             maybe-linebreak-proc
-                             (λ (e1 e2) maybe-linebreak-proc)))
+  (define linebreak-proc (match maybe-linebreak-proc
+                           [(? procedure? proc) proc]
+                           [val (λ (e1 e2) val)]))
   (define elems-vec (list->vector elems))
   (filter values
           (for/list ([(elem idx) (in-indexed elems-vec)])
-            (cond
-              [(= idx 0) elem] ; pass first item
-              [(= idx (sub1 (vector-length elems-vec))) elem] ; pass through last item
-              [(equal? elem newline)
-               (define prev (vector-ref elems-vec (sub1 idx)))
-               (define next (vector-ref elems-vec (add1 idx)))
-               ;; only convert if neither adjacent tag is a block
-               ;; (because blocks automatically force a newline before & after)
-               (if (or (block-txexpr? prev) (block-txexpr? next))
-                   #f ; flag for filtering
-                   (linebreak-proc prev next))]
-              [else elem]))))
+                    (cond
+                      [(zero? idx) elem] ; pass first item
+                      [(= idx (sub1 (vector-length elems-vec))) elem] ; pass through last item
+                      [(equal? elem newline)
+                       (define prev (vector-ref elems-vec (sub1 idx)))
+                       (define next (vector-ref elems-vec (add1 idx)))
+                       ;; only convert if neither adjacent tag is a block
+                       ;; (because blocks automatically force a newline before & after)
+                       (if (or (block-txexpr? prev) (block-txexpr? next))
+                           #false ; flag for filtering
+                           (linebreak-proc prev next))]
+                      [else elem]))))
 
 (module-test-external
  (check-equal? (decode-linebreaks '("foo" "\n" "bar")) '("foo" (br) "bar"))
@@ -169,17 +173,21 @@
 (define+provide/contract (merge-newlines x)
   (txexpr-elements? . -> . txexpr-elements?)
   (define newline-pat (regexp (format "^~a+$" (setup:newline))))
-  (define (newline? x) (and (string? x) (regexp-match newline-pat x)))  
+  (define (newline? x) (match x
+                         [(regexp newline-pat) #true]
+                         [_ #false]))  
   (define (merge-newline-slice xs)
-    (if (newline? (car xs)) ; if first member of slice is newline, they all are
-        (list (apply string-append xs))
-        xs))
-  (define empty-string? (λ (x) (equal? x "")))
+    (match xs
+      ;; if first member of slice is newline, they all are
+      [(cons (? newline?) _) (list (apply string-append xs))]
+      [_ xs]))
+  (define (empty-string? x) (equal? x ""))
   (let loop ([x x])
-    (if (and (pair? x) (not (attrs? x)))
-        (let ([xs (map loop (filter-not empty-string? x))])
-          (append-map merge-newline-slice (slicef xs newline?)))
-        x)))
+    (match x
+      [(? pair? x) #:when (not (attrs? x))
+                   (define xs (map loop (filter-not empty-string? x)))
+                   (append-map merge-newline-slice (slicef xs newline?))]
+      [_ x])))
 
 (module-test-external
  (require racket/list)
@@ -189,7 +197,6 @@
  (check-equal? (merge-newlines '(p "\n" "\n" "foo" "\n" "\n\n" "bar" (em "\n" "\n" "\n"))) 
                '(p "\n\n" "foo" "\n\n\n" "bar" (em "\n\n\n"))))
 
-
 (define+provide/contract (decode-paragraphs elements-in [maybe-wrap-proc 'p]
                                             #:linebreak-proc [linebreak-proc decode-linebreaks]
                                             #:force? [force-paragraph #f])
@@ -206,26 +213,30 @@
   
   (define (paragraph-break? x)
     (define paragraph-pattern (pregexp (format "^~a+$" paragraph-separator)))
-    (and (string? x) (regexp-match paragraph-pattern x)))
+    (match x
+      [(pregexp paragraph-pattern) #true]
+      [_ #false]))
   
   (define (explicit-or-implicit-paragraph-break? x)
     (or (paragraph-break? x) (block-txexpr? x)))
 
-  (define wrap-proc (if (procedure? maybe-wrap-proc)
-                        maybe-wrap-proc
-                        (λ (elems) (list* maybe-wrap-proc elems))))
+  (define wrap-proc (match maybe-wrap-proc
+                      [(? procedure? proc) proc]
+                      [_ (λ (elems) (list* maybe-wrap-proc elems))]))
 
   (define (wrap-paragraph elems)
-    (if (andmap block-txexpr? elems)
-        elems ; leave a series of block xexprs alone
-        (list (wrap-proc elems)))) ; otherwise wrap in p tag 
+    (match elems
+      [(list (? block-txexpr?) ...) elems] ; leave a series of block xexprs alone
+      [_ (list (wrap-proc elems))])) ; otherwise wrap in p tag
 
   (define elements (prep-paragraph-flow elements-in))
   (if (ormap explicit-or-implicit-paragraph-break? elements) ; need this condition to prevent infinite recursion
-      ;; use append-map on wrap-paragraph rather than map to permit return of multiple elements
-      (append-map wrap-paragraph (append-map (λ (es) (filter-split es paragraph-break?)) (slicef elements block-txexpr?))) ; split into ¶¶, using both implied and explicit paragraph breaks
+      ;; use `append-map` on `wrap-paragraph` rather than `map` to permit return of multiple elements
+      (append-map wrap-paragraph
+                  (append-map (λ (es) (filter-split es paragraph-break?)) (slicef elements block-txexpr?))) ; split into ¶¶, using both implied and explicit paragraph breaks
       (if force-paragraph
-          (append-map wrap-paragraph (slicef elements block-txexpr?)) ; upconverts non-block elements to paragraphs
+          ;; upconverts non-block elements to paragraphs
+          (append-map wrap-paragraph (slicef elements block-txexpr?)) 
           elements)))            
 
 (module-test-external
@@ -246,7 +257,6 @@
                '((p "foo") (div "bar") (div "zam")))
  (check-equal? (decode-paragraphs '("foo" "\n\n" (div "bar") "\n\n" (div "zam")))
                '((p "foo") (div "bar") (div "zam")))
- 
  (check-equal? (decode-paragraphs '("foo")) '("foo"))
  (check-equal? (decode-paragraphs '("foo") #:force? #t) '((p "foo")))
  (check-equal? (decode-paragraphs '((div "foo"))) '((div "foo")))

pollen/mode.rkt

@@ -96,7 +96,7 @@ Intractable problem; unavoidable limitation.
                 (lexer-maker #:command-char #\◊)
                 (fallback))]
            [(drracket:indentation)
-            (dynamic-require 'pollen/private/mode-indentation 'determine-spaces)]
+            (dynamic-require 'pollen/private/external/mode-indentation 'determine-spaces)]
            [else (fallback)]))))))
 
 (module at-reader racket/base

pollen/pagetree.rkt

@@ -30,8 +30,7 @@
 
 
 ;; for contracts: faster than (listof pagenode?)
-(define (pagenodes? x)
-  (and (list? x) (andmap pagenode? x)))
+(define (pagenodes? x) (and (list? x) (andmap pagenode? x)))
 
 
 (define+provide (pagenodeish? x)
@@ -49,9 +48,9 @@
   (define pt-root-tag (setup:pagetree-root-node))
   (define (splice-nested-pagetree xs)
     (apply append (for/list ([x (in-list xs)])
-                    (if (and (txexpr? x) (eq? (get-tag x) pt-root-tag))
-                        (get-elements x)
-                        (list x)))))
+                            (if (and (txexpr? x) (eq? (get-tag x) pt-root-tag))
+                                (get-elements x)
+                                (list x)))))
   (validate-pagetree 
    (decode (cons pt-root-tag xs)
            #:txexpr-elements-proc (compose1 splice-nested-pagetree (λ (xs) (filter-not whitespace? xs))) 
@@ -60,10 +59,11 @@
 
 (define+provide (validate-pagetree x)
   (and (txexpr? x)
-       (let ([pagenodes (pagetree-strict->list x)])
-         (for/and ([p (in-list pagenodes)]
-                   #:unless (pagenode? p))
-           (error 'validate-pagetree "~v is not a valid pagenode" p))
+       (let ()
+         (define pagenodes (pagetree-strict->list x))
+         (for ([p (in-list pagenodes)]
+               #:unless (pagenode? p))
+              (raise-argument-error 'validate-pagetree "valid pagenodes" p))
          (with-handlers ([exn:fail? (λ (e) (error 'validate-pagetree "~a" (exn-message e)))])
            (members-unique?/error pagenodes))
          x)))
@@ -89,7 +89,7 @@
   (define (unique-sorted-output-paths xs)
     (define output-paths (map ->output-path xs))
     (define all-paths (filter path-visible? (remove-duplicates output-paths)))
-    (define path-is-directory? (λ (f) (directory-exists? (build-path dir f))))
+    (define (path-is-directory? f) (directory-exists? (build-path dir f)))
     (define-values (subdirectories files) (partition path-is-directory? all-paths))
     (define-values (pagetree-sources other-files) (partition pagetree-source? files))
     (define (sort-names xs) (sort xs #:key ->string string<?))
@@ -104,7 +104,7 @@
   (define (cache-dir? path) (member (->string path) default-cache-names))
   
   (unless (directory-exists? dir)
-    (error 'directory->pagetree "directory ~v doesn't exist" dir))
+    (raise-argument-error 'directory->pagetree "existing directory" dir))
   
   (decode-pagetree (map ->pagenode (unique-sorted-output-paths (filter-not cache-dir? (directory-list dir)))))) 
 
@@ -125,7 +125,7 @@
     (load-pagetree pagetree-source)))
 
 
-(define (topmost-node x) (car (->list x)))
+(define (topmost-node x) (first (->list x)))
 
 
 (define+provide/contract (parent pnish [pt-or-path (current-pagetree)] #:allow-root [allow-root? #f])
@@ -138,8 +138,8 @@
            (if (memq pagenode (map topmost-node current-children))
                current-parent
                (for/or ([st (in-list (filter list? current-children))])
-                 (loop pagenode st))))))
-  (if (eq? result (car pt))
+                       (loop pagenode st))))))
+  (if (eq? result (first pt))
       (and allow-root? result)
       result))
 
@@ -156,12 +156,11 @@
 (define+provide/contract (children p [pt-or-path (current-pagetree)])
   (((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenodes?))  
   (and pt-or-path p 
-       (let loop ([pagenode (->pagenode p)]
-                  [pt (get-pagetree pt-or-path)])
-         (if (eq? pagenode (car pt))
-             (map topmost-node (cdr pt))
-             (for/or ([subtree (in-list (filter pair? pt))])
-               (loop pagenode subtree))))))
+       (let loop ([pagenode (->pagenode p)][pt (get-pagetree pt-or-path)])
+         (match pagenode
+           [(== (first pt) eq?) (map topmost-node (rest pt))]
+           [_ (for/or ([subtree (in-list (filter pair? pt))])
+                      (loop pagenode subtree))]))))
 
 
 (module-test-external
@@ -192,9 +191,9 @@
   (((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenodes?))  
   (match (for/list ([sib (in-list (or (siblings pnish pt-or-path) empty))]
                     #:unless (eq? sib (->pagenode pnish)))
-           sib)
+                   sib)
     [(? pair? sibs) sibs]
-    [else #f]))
+    [_ #false]))
 
 
 (module-test-external
@@ -210,13 +209,13 @@
 ;; private helper function.
 ;; only takes pt as input.
 ;; used by `pagetree?` predicate, so can't use `pagetree?` contract.
-(define (pagetree-strict->list pt) (flatten (cdr pt)))
+(define (pagetree-strict->list pt) (flatten (rest pt)))
 
 
 ;; flatten tree to sequence
 (define+provide/contract (pagetree->list pt-or-path)
   ((or/c pagetree? pathish?) . -> . pagenodes?)
-  ; use cdr to get rid of root tag at front
+  ; use rest to get rid of root tag at front
   (pagetree-strict->list (get-pagetree pt-or-path))) 
 
 
@@ -230,14 +229,13 @@
        (let loop ([side side]
                   [pagenode (->pagenode pnish)]
                   [pagetree-nodes (pagetree->list (get-pagetree pt-or-path))])
-         (if (eq? side 'right)
-             (match (memq pagenode pagetree-nodes)
-               [(list _ rest ...) rest]
-               [else #f])
-             (match (loop 'right pagenode (reverse pagetree-nodes))
-               [(? pair? result) (reverse result)]
-               [else #f])))))
-
+         (case side
+           [(right) (match (memq pagenode pagetree-nodes)
+                      [(list _ rest ...) rest]
+                      [_ #false])]
+           [else (match (loop 'right pagenode (reverse pagetree-nodes))
+                   [(? pair? result) (reverse result)]
+                   [_ #false])]))))
 
 (module-test-internal
  (require rackunit)
@@ -266,7 +264,7 @@
   (((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenode?))
   (match (previous* pnish pt-or-path)
     [(list _ ... result) result]
-    [else #f]))
+    [_ #false]))
 
 
 (module-test-external
@@ -280,7 +278,7 @@
   (((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenode?))
   (match (next* pnish pt-or-path)
     [(list result _ ...) result]
-    [else #f]))
+    [_ #false]))
 
 
 (module-test-external
@@ -292,10 +290,9 @@
 
 (define/contract+provide (path->pagenode path [starting-path (current-project-root)])
   ((coerce/path?) (coerce/path?) . ->* . coerce/symbol?)
-  (define starting-dir
-    (if (directory-exists? starting-path)
-        starting-path
-        (dirname starting-path)))
+  (define starting-dir (match starting-path
+                         [(? directory-exists?) starting-path]
+                         [_ (dirname starting-path)]))
   (->output-path (find-relative-path (->complete-path starting-dir) (->complete-path path))))
 
 

pollen/private/cache-utils.rkt

@@ -10,63 +10,60 @@
          compiler/cm)
 (provide (all-defined-out))
 
-(define (paths->key source-path [template-path #f] [output-path #f])
-  ;; can't use relative paths for cache keys because source files include `here-path` which is absolute.
-  ;; problem is that cache could appear valid on another filesystem (based on relative pathnames & mod dates)
-  ;; but would actually be invalid (because the `here-path` names are wrong).
-  ;; key is list of file + mod-time pairs, use #f for missing
-  
-  ;; we don't include output-path in path-strings-to-track
-  ;; because we don't want to attach a mod date
-  ;; because cache validity is not sensitive to mod date of output path
-  ;; (in fact we would expect it to be earlier, since we want to rely on an earlier version)
-  (define path-strings-to-track (list* source-path
-                                       ;; if template has a source file, track that instead
-                                       (and template-path (or (get-source template-path) template-path))
-                                       ;; is either list of files or (list #f)
-                                       (append (->list (get-directory-require-files source-path))
-                                               ;; user-designated files to track
-                                               (map ->string (setup:cache-watchlist source-path)))))
+;; can't use relative paths for cache keys because source files include `here-path` which is absolute.
+;; problem is that cache could appear valid on another filesystem (based on relative pathnames & mod dates)
+;; but would actually be invalid (because the `here-path` names are wrong).
+;; key is list of file + mod-time pairs, use #f for missing  
+;; we don't include output-path in path-strings-to-track
+;; because we don't want to attach a mod date
+;; because cache validity is not sensitive to mod date of output path
+;; (in fact we would expect it to be earlier, since we want to rely on an earlier version)
+(define (paths->key source-path [template-path #false] [output-path #false])
+  (define path-strings-to-track
+    (list* source-path
+           ;; if template has a source file, track that instead
+           (and template-path (or (get-source template-path) template-path))
+           ;; is either list of files or (list #f)
+           (append (->list (get-directory-require-files source-path))
+                   ;; user-designated files to track
+                   (map ->string (setup:cache-watchlist source-path)))))
   (define pollen-env (getenv default-env-name))
   (define poly-flag (and (has-inner-poly-ext? source-path) (current-poly-target)))
   (define path+mod-time-pairs
     (for/list ([ps (in-list path-strings-to-track)])
-      (cond
-        [ps (define cp (->complete-path ps))
-            (cons (path->string cp) (file-or-directory-modify-seconds cp #f (λ () 0)))]
-        [else #f])))
+              (cond
+                [ps (define cp (->complete-path ps))
+                    (cons (path->string cp) (file-or-directory-modify-seconds cp #false (λ () 0)))]
+                [else #false])))
   (list* pollen-env poly-flag (and output-path (path->string output-path)) path+mod-time-pairs))
 
-
 (define (key->source-path key) (car (fourth key)))
-
 (define (key->output-path key) (third key))
 
-
 (module-test-internal
  (define ps "/users/nobody/project/source.html.pm")
  (check-equal? (key->source-path (paths->key ps)) ps))
 
-
 (define-namespace-anchor cache-utils-module-ns)
+
 (define (path->hash path)
   (for-each managed-compile-zo (or (get-directory-require-files path) null))
-  (define path-dir (dirname path))
   (apply hasheq
-         (let ([doc-key (setup:main-export)]
-               [meta-key (setup:meta-export)])
+         (let ([doc-key (setup:main-export)] [meta-key (setup:meta-export)])
            (unless (and (symbol? doc-key) (symbol? meta-key))
              (raise-argument-error 'path->hash "symbols for doc and meta key" (cons doc-key meta-key)))
-           ;; new namespace forces `dynamic-require` to re-instantiate 'path'
+           ;; I monkeyed around with using the metas submodule to pull out the metas (for speed)
+           ;; but in practice most files get their doc requested too.
+           ;; so it's just simpler to get both at once and be done with it.
+           ;; the savings of avoiding two cache fetches at the outset outweighs
+           ;; the benefit of not reloading doc when you just need metas.
+           ;; new namespace forces `dynamic-require` to re-instantiate `path`
            ;; otherwise it gets cached in current namespace.
            (parameterize ([current-namespace (make-base-namespace)]
-                          [current-directory path-dir])
-             ;; I monkeyed around with using the metas submodule to pull out the metas (for speed)
-             ;; but in practice most files get their doc requested too.
-             ;; so it's just simpler to get both at once and be done with it.
-             ;; the savings of avoiding two cache fetches at the outset outweighs
-             ;; the benefit of not reloading doc when you just need metas.
-             (namespace-attach-module (namespace-anchor->namespace cache-utils-module-ns) 'pollen/setup) ; brings in params
+                          [current-directory (dirname path)])
+             ;; brings in currently instantiated params (unlike namespace-require)
+             (define outer-ns (namespace-anchor->namespace cache-utils-module-ns))
+             (namespace-attach-module outer-ns 'pollen/setup) 
              (define doc-missing-thunk (λ () ""))
              (define metas-missing-thunk (λ () (hasheq)))
              (list doc-key (dynamic-require path doc-key doc-missing-thunk)
@@ -96,16 +93,16 @@
   (define-values (cache-dir private-cache-dir) (make-cache-dirs dest-path))
   (define-values (dest-path-dir dest-path-filename _) (split-path dest-path))
   (define dest-file (build-path cache-dir (format "~a.rktd" dest-path-filename)))
-  (define (fetch-dest-file) (write-to-file (path-hash-thunk) dest-file #:exists 'replace))
-  #|
-`cache-file` looks for a file in private-cache-dir previously cached with key
-(which in this case carries modification dates and POLLEN env).
-If a cached file is found, copies it to dest-file (which must not exist already, unless exists-ok? is true)
-Otherwise, fetch-dest-file is called; if dest-file exists after calling fetch-dest-file,
-it is copied to private-cache-dir and recorded with key.
-|#
+  (define (fetch-dest-file)
+    (write-to-file (path-hash-thunk) dest-file #:exists 'replace))
+
+  ;; `cache-file` looks for a file in private-cache-dir previously cached with key
+  ;; (which in this case carries modification dates and POLLEN env).
+  ;; If a cached file is found, copies it to dest-file (which must not exist already, unless exists-ok? is true)
+  ;; Otherwise, fetch-dest-file is called; if dest-file exists after calling fetch-dest-file,
+  ;; it is copied to private-cache-dir and recorded with key.
   (cache-file dest-file
-              #:exists-ok? #t
+              #:exists-ok? #true
               key
               private-cache-dir
               fetch-dest-file

pollen/private/command.rkt

@@ -5,8 +5,10 @@
          racket/list
          racket/vector
          racket/cmdline
+         racket/match
          sugar/coerce
          "file-utils.rkt"
+         "log.rkt"
          "../setup.rkt"
          "../render.rkt"
          "../pagetree.rkt")
@@ -18,30 +20,34 @@
 ;; todo: investigate this
 
 (module+ raco
-  (define command-name (with-handlers ([exn:fail? (λ _ #f)])
+  (define command-name (with-handlers ([exn:fail? (λ () #f)])
                          (vector-ref (current-command-line-arguments) 0)))
   (dispatch command-name))
 
-
 (define (get-first-arg-or-current-dir [args (cdr (vector->list (current-command-line-arguments)))]) ; cdr to strip command name from front
   (normalize-path
    (with-handlers ([exn:fail? (λ (exn) (current-directory))])
      ;; incoming path argument is handled as described in docs for current-directory
      (very-nice-path (car args)))))
 
-
 (define (dispatch command-name)
-  (case command-name
-    [("test" "xyzzy") (handle-test)]
-    [(#f "help") (handle-help)]
-    [("start") (handle-start)] ; parses its own args
-    ;; "second" arg is actually third in command line args, so use cddr not cdr
-    [("render") (handle-render)] ; render parses its own args from current-command-line-arguments
-    [("version") (handle-version)]
-    [("reset") (handle-reset (get-first-arg-or-current-dir))]
-    [("setup") (handle-setup (get-first-arg-or-current-dir))]
-    [("clone" "publish") (handle-publish)]
-    [else (handle-unknown command-name)]))
+  (with-logging-to-port
+   (current-error-port)
+   (λ ()
+     (case command-name
+       [("test" "xyzzy") (handle-test)]
+       [(#f "help") (handle-help)]
+       [("start") (handle-start)] ; parses its own args
+       ;; "second" arg is actually third in command line args, so use cddr not cdr
+       [("render") (handle-render)] ; render parses its own args from current-command-line-arguments
+       [("version") (handle-version)]
+       [("reset") (handle-reset (get-first-arg-or-current-dir))]
+       [("setup") (handle-setup (get-first-arg-or-current-dir))]
+       [("clone" "publish") (handle-publish)]
+       [else (handle-unknown command-name)]))
+   #:logger pollen-logger
+   'info
+   'pollen))
 
 (define (very-nice-path x)
   (path->complete-path (simplify-path (cleanse-path (->path x)))))
@@ -67,108 +73,102 @@ version                print the version" (current-server-port) (make-publish-di
 (define (handle-version)
   (displayln (dynamic-require 'pollen/private/version 'pollen:version)))
 
-
 (define (handle-reset directory-maybe)
   (displayln "resetting cache ...")
   ((dynamic-require 'pollen/cache 'reset-cache) directory-maybe))
 
-
 (define (handle-setup directory-maybe)
   (displayln "preheating cache ...")
   ((dynamic-require 'pollen/private/preheat-cache 'preheat-cache) directory-maybe)) 
 
-
 (define (handle-render)
   (define render-target-wanted (make-parameter (current-poly-target)))
   (define render-with-subdirs? (make-parameter #f))
-  (define parsed-args (command-line #:program "raco pollen render"
-                                    #:argv (vector-drop (current-command-line-arguments) 1) ; snip the 'render' from the front
-                                    #:once-each
-                                    [("-t" "--target") target-arg "Render target for poly sources"
-                                                       (render-target-wanted (->symbol target-arg))]
-                                    [("-r" "--recursive") "Render subdirectories recursively"
-                                                          (render-with-subdirs? 'recursive)]
-                                    [("-s" "--subdir") "Render subdirectories nonrecursively" (render-with-subdirs? 'include)]
-                                    #:args other-args
-                                    other-args))  
-  (define path-args (if (empty? parsed-args)
-                        (list (current-directory))
-                        parsed-args))
+  (define parsed-args
+    (command-line #:program "raco pollen render"
+                  #:argv (vector-drop (current-command-line-arguments) 1) ; snip the 'render' from the front
+                  #:once-each
+                  [("-t" "--target") target-arg "Render target for poly sources"
+                                     (render-target-wanted (->symbol target-arg))]
+                  [("-r" "--recursive") "Render subdirectories recursively"
+                                        (render-with-subdirs? 'recursive)]
+                  [("-s" "--subdir") "Render subdirectories nonrecursively" (render-with-subdirs? 'include)]
+                  #:args other-args
+                  other-args)) 
   (parameterize ([current-poly-target (render-target-wanted)]) ;; applies to both cases
-    (cond
-      ;; directory mode: one directory as argument
-      [(and (= 1 (length path-args)) (directory-exists? (car path-args)))
-       (define top-dir (very-nice-path (car path-args)))
-       (let render-one-dir ([dir top-dir])
-         (parameterize ([current-directory dir]
-                        [current-project-root (if (eq? (render-with-subdirs?) 'recursive)
-                                                  dir
-                                                  top-dir)])
-           (define dirlist (directory-list dir))
-           (define preprocs (filter preproc-source? dirlist))
-           (define static-pagetrees (filter pagetree-source? dirlist))
-           ;; if there are no static pagetrees, use make-project-pagetree
-           ;; (which will synthesize a pagetree if needed, which includes all sources)
-           (define batch-to-render
-             (map very-nice-path
-                  (cond
-                    [(null? static-pagetrees)
-                     (displayln (format "rendering generated pagetree for directory ~a" dir))
-                     (cdr (make-project-pagetree dir))]
-                    [else
-                     (displayln (format "rendering preproc & pagetree files in directory ~a" dir))
-                     (append preprocs static-pagetrees)])))
-           (apply render-batch batch-to-render)
-           (when (render-with-subdirs?)
-             (for ([path (in-list dirlist)]
-                   #:when (and (directory-exists? path)
-                               (not (omitted-path? path))))
-               (render-one-dir (->complete-path path))))))]
-      [else ;; path mode
-       (displayln (format "rendering ~a" (string-join (map ->string path-args) " ")))
-       (apply render-batch (map very-nice-path path-args))])))
-
+    (let loop ([args parsed-args])
+      (match args
+        [(== empty) (loop (list (current-directory)))]
+        [(list dir) ;; directory mode: one directory as argument
+         #:when (directory-exists? dir)
+         (define top-dir (very-nice-path dir))
+         (let render-one-dir ([dir top-dir])
+           (parameterize ([current-directory dir]
+                          [current-project-root (case (render-with-subdirs?)
+                                                  [(recursive) dir]
+                                                  [else top-dir])])
+             (define dirlist (directory-list dir))
+             (define preprocs (filter preproc-source? dirlist))
+             (define static-pagetrees (filter pagetree-source? dirlist))
+             ;; if there are no static pagetrees, use make-project-pagetree
+             ;; (which will synthesize a pagetree if needed, which includes all sources)
+             (define batch-to-render
+               (map very-nice-path
+                    (cond
+                      [(null? static-pagetrees)
+                       (displayln (format "rendering generated pagetree for directory ~a" dir))
+                       (cdr (make-project-pagetree dir))]
+                      [else
+                       (displayln (format "rendering preproc & pagetree files in directory ~a" dir))
+                       (append preprocs static-pagetrees)])))
+             (apply render-batch batch-to-render)
+             (when (render-with-subdirs?)
+               (for ([path (in-list dirlist)]
+                     #:when (and (directory-exists? path)
+                                 (not (omitted-path? path))))
+                    (render-one-dir (->complete-path path))))))]
+        [path-args ;; path mode
+         (displayln (format "rendering ~a" (string-join (map ->string path-args) " ")))
+         (apply render-batch (map very-nice-path path-args))]))))
 
 (define (handle-start)
   (define launch-wanted #f)
   (define localhost-wanted #f)
-  (define clargs (command-line #:program "raco pollen start"
-                               #:argv (vector-drop (current-command-line-arguments) 1) ; snip the 'start' from the front
-                               #:once-each
-                               [("--launch" "-l") "Launch browser after start" (set! launch-wanted #t)]
-                               [("--local") "Restrict access to localhost" (set! localhost-wanted #t)]
-                               #:args other-args
-                               other-args))
+  (define clargs
+    (command-line #:program "raco pollen start"
+                  #:argv (vector-drop (current-command-line-arguments) 1) ; snip the 'start' from the front
+                  #:once-each
+                  [("--launch" "-l") "Launch browser after start" (set! launch-wanted #t)]
+                  [("--local") "Restrict access to localhost" (set! localhost-wanted #t)]
+                  #:args other-args
+                  other-args))
   (define dir (path->directory-path (get-first-arg-or-current-dir clargs)))
   (unless (directory-exists? dir)
     (error (format "~a is not a directory" dir)))
-  (define port (with-handlers ([exn:fail? (λ (e) #f)])
-                 (string->number (cadr clargs))))
-  (when (and port (not (exact-positive-integer? port)))
-    (error (format "~a is not a valid port number" port)))
+  (define http-port (with-handlers ([exn:fail? (λ (e) #f)])
+                      (string->number (cadr clargs))))
+  (when (and http-port (not (exact-positive-integer? http-port)))
+    (error (format "~a is not a valid port number" http-port)))
   (parameterize ([current-project-root dir]
-                 [current-server-port (or port (setup:project-server-port))]
+                 [current-server-port (or http-port (setup:project-server-port))]
                  [current-server-listen-ip (and localhost-wanted "127.0.0.1")])
-    (displayln "Starting project server ...")
+    (message "starting project server ...")
     ((dynamic-require 'pollen/private/project-server 'start-server) (format "/~a" (setup:main-pagetree dir)) launch-wanted)))
 
-
 (define (make-publish-dir-name [project-root (current-directory)] [arg-command-name #f])
   (define user-publish-path
     (expand-user-path (->path (setup:publish-directory project-root))))
   (if (complete-path? user-publish-path)
       user-publish-path       
       (build-path (find-system-path 'desk-dir)
-                  (->path (if (equal? arg-command-name "clone") ; bw compat
-                              "clone"
-                              user-publish-path)))))
-
+                  (->path (case arg-command-name
+                            [("clone") "clone"] ; bw compat
+                            [else user-publish-path])))))
 
 (define (delete-it path)
-  (cond
-    [(directory-exists? path) (delete-directory/files path)]
-    [(file-exists? path) (delete-file path)]))
-  
+  (match path
+    [(? directory-exists?) (delete-directory/files path)]
+    [(? file-exists?) (delete-file path)]))
 
 (define (contains-directory? possible-superdir possible-subdir)
   (define (has-prefix? xs prefix)
@@ -176,11 +176,10 @@ version                print the version" (current-server-port) (make-publish-di
          (andmap equal? prefix (take xs (length prefix)))))
   ((explode-path possible-subdir) . has-prefix? . (explode-path possible-superdir)))
 
-
 (define (handle-publish)
   (define command-name ; either "publish" or "clone"
     (vector-ref (current-command-line-arguments) 0))
-  (define force-target-overwrite? (make-parameter #t))
+  (define force-target-overwrite? (make-parameter #true))
   (define other-args (command-line
                       ;; drop command name
                       #:argv (vector-drop (current-command-line-arguments) 1)
@@ -217,8 +216,8 @@ version                print the version" (current-server-port) (make-publish-di
         (begin
           (display (format "destination directory ~a exists. Overwrite? [yes/no] " dest-dir))
           (case (read)
-            [(y yes) #t]
-            [else #f]))))
+            [(y yes) #true]
+            [else #false]))))
   (cond
     [do-publish-operation?
      (when (directory-exists? dest-dir)
@@ -236,11 +235,11 @@ version                print the version" (current-server-port) (make-publish-di
     [else (displayln "publish aborted")]))
 
 (define (handle-unknown command)
-  (if (regexp-match #rx"(shit|fuck)" command)
-      (displayln (let ([responses '("Cursing at free software? Really?" "How uncouth." "Same to you, buddy.")])
-                   (list-ref responses (random (length responses)))))
-      (begin
-        (displayln (format "`~a` is an unknown command." command))
-        (display "These are the available ") ; ... "Pollen commands:"
-        (handle-help)
-        (exit 1))))
+  (match command
+    [(regexp #rx"(shit|fuck)")
+     (define responses '("Cursing at free software? Really?" "How uncouth." "Same to you, buddy."))
+     (displayln (list-ref responses (random (length responses))))]
+    [_ (displayln (format "`~a` is an unknown command." command))
+       (display "These are the available ") ; ... "Pollen commands:"
+       (handle-help)
+       (exit 1)]))

pollen/private/debug.rkt

@@ -1,78 +0,0 @@
-#lang racket/base
-(require (for-syntax racket/base racket/syntax))
-(require racket/date racket/string)
-(require sugar/debug sugar/define)
-
-(provide  (all-from-out sugar/debug))
-
-; todo: contracts, tests, docs
-
-
-; debug utilities
-(define months (list "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
-
-(define last-message-time #f)
-(define (seconds-since-last-message)
-  (define now (current-seconds))
-  (define then last-message-time)
-  (set! last-message-time now)
-  (if then      
-      (- now then)
-      "0"))
-
-(define (zero-fill str count)
-  (set! str (format "~a" str))
-  (if (> (string-length str) count)
-      str
-      (string-append (make-string (- count (string-length str)) #\0) str)))
-
-(define+provide (make-datestamp)
-  (define date (current-date))
-  (define date-fields (map (λ (x) (zero-fill x 2)) 
-                           (list
-                            (date-day date)
-                            (list-ref months (sub1 (date-month date)))
-                            (date-year date)
-                            )))
-  (string-join date-fields "-"))
-
-(define+provide (make-timestamp)  
-  (define date (current-date))
-  (define time-fields (map (λ (x) (zero-fill x 2)) 
-                           (list
-                            ; (date-day date)
-                            ; (list-ref months (sub1 (date-month date)))
-                            (if (<= (date-hour date) 12)
-                                (date-hour date) ; am hours + noon hour
-                                (modulo (date-hour date) 12)) ; pm hours after noon hour
-                            (date-minute date)
-                            (date-second date))))  
-  (string-append (string-join time-fields ":") (if (< (date-hour date) 12) "am" "pm")))
-
-(define (make-debug-timestamp)
-  (format "[~a ∆~as]" (make-timestamp) (seconds-since-last-message)))
-
-;; creates pollen-logger and associated functions:
-;; log-pollen-fatal, log-pollen-error, log-pollen-warning, 
-;; log-pollen-info, and log-pollen-debug
-(define-logger pollen) 
-
-
-(define-syntax (make-message-logger-functions stx)
-  (syntax-case stx ()
-    [(_ stem)
-     (with-syntax ([message-stem (format-id stx "message-~a" #'stem)]
-                   [log-pollen-stem (format-id stx "log-pollen-~a" #'stem)])
-       #'(begin
-           ;; does file have particular extension
-           (define+provide (message-stem . items)
-             (log-pollen-stem (string-join `(,(make-debug-timestamp) ,@(map (λ (x)(if (string? x) x (format "~v" x))) items)))))))]))
-
-(make-message-logger-functions fatal)
-(make-message-logger-functions error)
-(make-message-logger-functions warning)
-(make-message-logger-functions info)
-(make-message-logger-functions debug)
-
-(define+provide (message . items)
-             (displayln (string-join `(,@(map (λ (x)(if (string? x) x (format "~v" x))) items)))))

pollen/private/external/include-template.rkt

@@ -0,0 +1,34 @@
+#lang racket/base
+(require (for-syntax racket/base
+                     racket/list
+                     syntax/parse)
+         (only-in scribble/text/syntax-utils include/text)
+         (only-in "output.rkt" output)
+         racket/match
+         racket/port)
+
+(provide include-template)
+
+;; Adaptation of function in web-server/templates library 
+;; to check for binary result and pass it through.
+;; Actually patches underlying bug in `output`.
+
+(define (finish result)
+  (match result
+    [(? bytes? bs) bs]
+    ;; list of expressions with byte string in last place.
+    ;; infer that user is trying to return a binary as the last value in a template,
+    ;; and treat it as a single binary value.
+    [(list _ ... (? bytes? bs)) bs]
+    [_ (with-output-to-string (λ () (output result)))]))
+
+(define-syntax (include-template stx)
+  (syntax-parse stx
+    [(_ (~optional (~seq #:command-char command-char:expr)) src:expr)
+     (quasisyntax/loc stx
+       (finish (include/text #,@(if (attribute command-char)
+                                    (list #'#:command-char #'command-char)
+                                    empty)
+                             src)))]))
+
+

pollen/private/external/logging.rkt

@@ -0,0 +1,69 @@
+#lang racket/base
+
+;; 181030: Needed for compatibility with Racket 6.0.
+;; This module introduced until 6.3.
+
+(require racket/contract/base)
+
+(provide log-level/c)
+
+(define log-level/c (or/c 'none 'fatal 'error 'warning 'info 'debug))
+(define log-spec? (listof (or/c symbol? #f)))
+(define log-event? (vector-immutable/c log-level/c string? any/c (or/c symbol? #f)))
+
+(provide/contract [with-intercepted-logging
+                   (->* ((-> log-event? any)
+                         (-> any)
+                         log-level/c)
+                        (#:logger logger?)
+                        #:rest log-spec?
+                        any)]
+                  [with-logging-to-port
+                   (->* (output-port? (-> any) log-level/c)
+                        (#:logger logger?)
+                        #:rest log-spec?
+                        any)])
+
+(define (receiver-thread receiver stop-chan intercept)
+  (thread
+   (lambda ()
+     (define (clear-events)
+       (let ([l (sync/timeout 0 receiver)])
+         (when l ; still something to read
+           (intercept l) ; interceptor gets the whole vector
+           (clear-events))))
+     (let loop ()
+       (let ([l (sync receiver stop-chan)])
+         (cond [(eq? l 'stop)
+                ;; we received all the events we were supposed
+                ;; to get, read them all (w/o waiting), then
+                ;; stop
+                (clear-events)]
+               [else ; keep going
+                (intercept l)
+                (loop)]))))))
+
+(define (with-intercepted-logging interceptor proc #:logger [logger #f]
+                                  . log-spec)
+  (let* ([orig-logger (current-logger)]
+         ;; Unless we're provided with an explicit logger to monitor we
+         ;; use a local logger to avoid getting messages that didn't
+         ;; originate from proc. Since it's a child of the original logger,
+         ;; the rest of the program still sees the log entries.
+         [logger      (or logger (make-logger #f orig-logger))]
+         [receiver    (apply make-log-receiver logger log-spec)]
+         [stop-chan   (make-channel)]
+         [t           (receiver-thread receiver stop-chan interceptor)])
+    (begin0
+        (parameterize ([current-logger logger])
+          (proc))
+      (channel-put stop-chan 'stop) ; stop the receiver thread
+      (thread-wait t))))
+
+(define (with-logging-to-port port proc #:logger [logger #f] . log-spec)
+  (apply with-intercepted-logging
+         #:logger logger
+         (lambda (l) (displayln (vector-ref l 1) ; actual message
+                                port))
+         proc
+         log-spec))

pollen/private/external/manual-history.rkt

@@ -10,7 +10,7 @@
 
 #|
 Need this to make pollen docs buildable on v6.0.
-`history` not added to scribble/manul till v6.1.
+`history` not added to scribble/manual till v6.1.
 |#
 
 (provide pollen-history)

pollen/private/include-template.rkt

@@ -1,33 +0,0 @@
-#lang racket/base
-(require (only-in scribble/text/syntax-utils include/text)
-         (only-in "output.rkt" output)
-         racket/list
-         (for-syntax racket/base
-                     racket/list
-                     syntax/parse)
-         racket/port)
-
-;; Adaptation of function in web-server/templates library 
-;; to check for binary result and pass it through.
-;; Actually patches underlying bug in `output`.
-(define-syntax (include-template stx)
-  (syntax-parse stx
-    [(_ (~optional (~seq #:command-char command-char:expr)) p:expr)
-     (quasisyntax/loc stx
-       (let ([result (include/text #,@(if (attribute command-char)
-                                          (list #'#:command-char #'command-char)
-                                          empty)
-                                   p)])
-         
-         (let ([result (cond
-                         [(bytes? result) result]
-                         ;; list of expressions with byte string in last place.
-                         ;; infer that user is trying to return a binary as the last value in a template,
-                         ;; and treat it as a single binary value.
-                         [(and (list? result) (bytes? (last result))) (last result)]
-                         [else result])])
-           (if (bytes? result) 
-               (with-output-to-bytes (λ () (write-bytes result))) 
-               (with-output-to-string (λ () (output result)))))))]))
-
-(provide include-template)

pollen/private/log.rkt

@@ -0,0 +1,14 @@
+#lang racket/base
+(require racket/format
+         racket/string
+         "external/logging.rkt")
+
+(provide (all-defined-out) (all-from-out "external/logging.rkt"))
+
+;; creates `pollen-logger` and associated functions:
+;; log-pollen-fatal, log-pollen-error, log-pollen-warning, 
+;; log-pollen-info, and log-pollen-debug
+(define-logger pollen) 
+
+(define (message . items)
+  (log-pollen-info (string-join (map ~a items) " ")))

pollen/private/main-base.rkt

@@ -1,29 +1,34 @@
 #lang racket/base
-(require (for-syntax racket/base syntax/strip-context "../setup.rkt" "split-metas.rkt")
-         "to-string.rkt" "../pagetree.rkt" "splice.rkt" "../setup.rkt" "../core.rkt"
-         (prefix-in doclang: "doclang-raw.rkt"))
+(require (for-syntax racket/base
+                     syntax/strip-context
+                     "../setup.rkt"
+                     "split-metas.rkt")
+         racket/match
+         racket/list
+         "to-string.rkt"
+         "../pagetree.rkt"
+         "splice.rkt"
+         "../setup.rkt"
+         "../core.rkt"
+         (prefix-in doclang: "external/doclang-raw.rkt"))
 (provide (except-out (all-from-out racket/base) #%module-begin)
          (rename-out [pollen-module-begin #%module-begin]))
 
-
 (define ((make-parse-proc parser-mode root-proc) xs)
   (define (stringify xs) (apply string-append (map to-string xs)))
-  (cond
-    [(eq? parser-mode default-mode-pagetree) (decode-pagetree xs)]
-    [(eq? parser-mode default-mode-markup) (apply root-proc (remove-voids xs))] 
-    [(eq? parser-mode default-mode-markdown)
+  (match parser-mode
+    [(== default-mode-pagetree) (decode-pagetree xs)]
+    [(== default-mode-markup) (apply root-proc (remove-voids xs))] 
+    [(== default-mode-markdown)
      (let* ([xs (stringify xs)]
             [xs ((dynamic-require 'markdown 'parse-markdown) xs)]
             [xs (map strip-empty-attrs xs)])
        (apply root-proc xs))]
-    [else (stringify xs)])) ; preprocessor mode
-
+    [_ (stringify xs)])) ; preprocessor mode
 
 (define (strip-leading-newlines doc)
   ;; drop leading newlines, as they're often the result of `defines` and `requires`
-  (or (memf (λ (ln) (and (not (equal? ln (setup:newline)))
-                         (not (equal? ln "")))) doc) null))
-
+  (dropf doc (λ (ln) (member ln (list (setup:newline) "")))))
 
 (define-syntax (pollen-module-begin stx)
   (syntax-case stx ()
@@ -38,7 +43,7 @@
           D