add support for multiple rendering targets (closes #49)

pull/102/head
Matthew Butterick 9 years ago
parent 3eb972a23a
commit 76e47ed9d3

@ -1,5 +1,5 @@
#lang racket/base #lang racket/base
(require racket/path racket/file compiler/cm file/cache sugar/coerce sugar/list "project.rkt" "world.rkt" "rerequire.rkt" "cache-ns.rkt" "debug.rkt" "file.rkt" racket/place) (require racket/path racket/file compiler/cm file/cache sugar/coerce sugar/list "project.rkt" "rerequire.rkt" "cache-ns.rkt" "debug.rkt" "file.rkt" racket/place "world.rkt")
;; The cache is a hash with paths as keys. ;; The cache is a hash with paths as keys.
;; The cache values are also hashes, with key/value pairs for that path. ;; The cache values are also hashes, with key/value pairs for that path.
@ -72,28 +72,31 @@
(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 source-path exists, use that instead (append (list (and template-path (or (->source-path 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.
;; problem is that cache could appear valid on another filesystem (based on relative pathnames & mod dates) ;; 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). ;; but would actually be invalid (because the `here-path` names are wrong).
(define poly-flag (and (has-inner-poly-ext? source-path) (world:current-poly-target)))
(define path+mod-time-pairs (define path+mod-time-pairs
(map (λ(ps) (and ps (let ([cp (->complete-path ps)]) (map (λ(ps) (and ps (let ([cp (->complete-path ps)])
(cons (path->string cp) (file-or-directory-modify-seconds cp))))) path-strings)) (cons (path->string cp) (file-or-directory-modify-seconds cp))))) path-strings))
path+mod-time-pairs) (cons poly-flag path+mod-time-pairs))
(define (key->source-path key) (define (key->source-path key)
(car (car key))) (car (cadr key)))
(define-namespace-anchor anchor-to-this-namespace)
(define (path->hash path) (define (path->hash path)
;; new namespace forces dynamic-require to re-instantiate 'path' ;; new namespace forces dynamic-require to re-instantiate 'path'
;; otherwise it gets cached in current namespace. ;; otherwise it gets cached in current namespace.
(define drfs (get-directory-require-files path)) (define drfs (get-directory-require-files path))
(for-each managed-compile-zo (or drfs null)) (for-each managed-compile-zo (or drfs null))
(define-values (path-dir path-name _) (split-path path)) (define path-dir (dirname path))
(apply hash (apply hash
(let ([doc-key (world:current-main-export)] (let ([doc-key (world:current-main-export)]
[meta-key (world:current-meta-export)]) [meta-key (world:current-meta-export)])
@ -104,6 +107,7 @@
;; so it's just simpler to get both at once and be done with it. ;; 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 savings of avoiding two cache fetches at the outset outweighs
;; the benefit of not reloading doc when you just need metas. ;; the benefit of not reloading doc when you just need metas.
(namespace-attach-module (namespace-anchor->namespace anchor-to-this-namespace) 'pollen/world) ; brings in params
(list doc-key (dynamic-require path doc-key) meta-key (dynamic-require path meta-key)))))) (list doc-key (dynamic-require path doc-key) meta-key (dynamic-require path meta-key))))))
@ -116,7 +120,7 @@
(make-directory dir))))) (make-directory dir)))))
(define (make-cache-dirs path) (define (make-cache-dirs path)
(define-values (path-dir path-filename _) (split-path path)) (define path-dir (dirname path))
(define cache-dir (build-path path-dir (world:current-cache-dir-name))) (define cache-dir (build-path path-dir (world:current-cache-dir-name)))
(define private-cache-dir (build-path cache-dir "private")) (define private-cache-dir (build-path cache-dir "private"))
(my-make-directory* private-cache-dir) ; will also make cache-dir, if needed (my-make-directory* private-cache-dir) ; will also make cache-dir, if needed
@ -139,12 +143,13 @@
#:max-cache-size (world:current-compile-cache-max-size)) #:max-cache-size (world:current-compile-cache-max-size))
(file->value dest-file)) (file->value dest-file))
(define (cached-require path-string subkey) (define (cached-require path-string subkey)
(define path (with-handlers ([exn:fail? (λ _ (error 'cached-require (format "~a is not a valid path" path-string)))]) (define path (with-handlers ([exn:fail? (λ _ (raise-argument-error 'cached-require "valid path-string" path-string))])
(->complete-path path-string))) (->complete-path path-string)))
(when (not (file-exists? path)) (when (not (file-exists? path))
(error (format "cached-require: ~a does not exist" path))) (raise-argument-error 'cached-require "path to existing file" path))
(cond (cond
[(world:current-compile-cache-active path) [(world:current-compile-cache-active path)
@ -152,4 +157,5 @@
(hash-ref (hash-ref! ram-cache key (λ _ (hash-ref (hash-ref! ram-cache key (λ _
(cache-ref! key (λ _ (path->hash path))))) subkey)] (cache-ref! key (λ _ (path->hash path))))) subkey)]
[else (parameterize ([current-namespace (make-base-namespace)]) [else (parameterize ([current-namespace (make-base-namespace)])
(namespace-attach-module (namespace-anchor->namespace anchor-to-this-namespace) 'pollen/world) ; brings in params
(dynamic-require path subkey))])) (dynamic-require path subkey))]))

@ -1,5 +1,5 @@
#lang racket/base #lang racket/base
(require pollen/world pollen/render racket/file racket/path sugar/coerce pollen/file pollen/pagetree racket/string racket/list) (require pollen/world pollen/render racket/file racket/path sugar/coerce pollen/file pollen/pagetree racket/string racket/list racket/vector racket/cmdline)
;; The use of dynamic-require throughout this file is intentional: ;; The use of dynamic-require throughout this file is intentional:
;; this way, low-dependency raco commands (like "version") are faster. ;; this way, low-dependency raco commands (like "version") are faster.
@ -12,12 +12,18 @@
(vector-ref (current-command-line-arguments) 0))) (vector-ref (current-command-line-arguments) 0)))
(dispatch command-name)) (dispatch command-name))
(define (get-first-arg-or-current-dir [clargs (current-command-line-arguments)])
(normalize-path
(with-handlers ([exn:fail? (λ(exn) (current-directory))])
;; incoming path argument is handled as described in docs for current-directory
(very-nice-path (vector-ref clargs 1)))))
(define-syntax-rule (polcom arg0 args ...)
(parameterize ([current-command-line-arguments (list->vector (map symbol->string (list 'arg0 'args ...)))])
(dispatch (with-handlers ([exn:fail? (λ _ #f)])
(vector-ref (current-command-line-arguments) 0)))))
(define (dispatch command-name) (define (dispatch command-name)
(define (get-first-arg-or-current-dir)
(normalize-path
(with-handlers ([exn:fail? (λ(exn) (current-directory))])
;; incoming path argument is handled as described in docs for current-directory
(very-nice-path (vector-ref (current-command-line-arguments) 1)))))
(case command-name (case command-name
[("test" "xyzzy") (handle-test)] [("test" "xyzzy") (handle-test)]
[(#f "help") (handle-help)] [(#f "help") (handle-help)]
@ -26,11 +32,7 @@
(string->number (vector-ref (current-command-line-arguments) 2)))) (string->number (vector-ref (current-command-line-arguments) 2))))
(handle-start (path->directory-path (get-first-arg-or-current-dir)) port-arg)] (handle-start (path->directory-path (get-first-arg-or-current-dir)) port-arg)]
;; "second" arg is actually third in command line args, so use cddr not cdr ;; "second" arg is actually third in command line args, so use cddr not cdr
[("render") (handle-render (cons (get-first-arg-or-current-dir) [("render") (handle-render)] ; render parses its own args from current-command-line-arguments
(let ([clargs (vector->list (current-command-line-arguments))])
(if (>= (length clargs) 3)
(map very-nice-path (cddr clargs))
null))))]
[("version") (handle-version)] [("version") (handle-version)]
[("reset") (handle-reset (get-first-arg-or-current-dir))] [("reset") (handle-reset (get-first-arg-or-current-dir))]
[("setup") (handle-setup (get-first-arg-or-current-dir))] [("setup") (handle-setup (get-first-arg-or-current-dir))]
@ -76,8 +78,20 @@ version print the version (~a)" (world:current-server-port) (worl
((dynamic-require 'pollen/cache 'preheat-cache) directory-maybe)) ((dynamic-require 'pollen/cache 'preheat-cache) directory-maybe))
(define (handle-render path-args) (define (handle-render)
(parameterize ([current-directory (world:current-project-root)]) (define render-target-wanted (make-parameter (world:current-poly-target)))
(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))]
#:args other-args
other-args))
(define path-args (if (empty? parsed-args)
(list (current-directory))
parsed-args))
(parameterize ([current-directory (world:current-project-root)]
[world:current-poly-target (render-target-wanted)])
(define first-arg (car path-args)) (define first-arg (car path-args))
(if (directory-exists? first-arg) (if (directory-exists? first-arg)
(let ([dir first-arg]) ; now we know it's a dir (let ([dir first-arg]) ; now we know it's a dir

@ -4,6 +4,12 @@
(require (only-in racket/path filename-extension)) (require (only-in racket/path filename-extension))
(require "world.rkt" sugar/define sugar/file sugar/string sugar/coerce sugar/test) (require "world.rkt" sugar/define sugar/file sugar/string sugar/coerce sugar/test)
;; because it comes up all the time
(define+provide/contract (dirname path)
(coerce/path? . -> . path?)
(define-values (dir name dir?) (split-path path))
dir)
;; for files like svg that are not source in pollen terms, ;; for files like svg that are not source in pollen terms,
;; but have a textual representation separate from their display. ;; but have a textual representation separate from their display.
(define+provide/contract (sourceish? x) (define+provide/contract (sourceish? x)
@ -83,64 +89,99 @@
(check-equal? (unescape-ext "foo$bar$$html" #\$) (->path "foo$bar$.html"))) (check-equal? (unescape-ext "foo$bar$$html" #\$) (->path "foo$bar$.html")))
(define+provide (ext-in-poly-targets? ext [x #f])
(member (->symbol ext) (apply world:current-poly-targets (if x (list x) null))))
(module-test-external
(check-equal? (ext-in-poly-targets? 'html) '(html))
(check-equal? (ext-in-poly-targets? 'missing) #f))
(define+provide (has-poly-ext? x)
(equal? (get-ext x) (->string (world:current-poly-source-ext))))
(module-test-external
(check-true (has-poly-ext? "foo.poly"))
(check-false (has-poly-ext? "foo.wrong")))
(define+provide (has-inner-poly-ext? x)
(and (get-ext x) (has-poly-ext? (unescape-ext (remove-ext x)))))
(module-test-external
(check-true (has-inner-poly-ext? "foo.poly.pm"))
(check-true (has-inner-poly-ext? "foo_poly.pp"))
(check-false (has-inner-poly-ext? "foo.poly"))
(check-false (has-inner-poly-ext? "foo.wrong.pm")))
(define-syntax (make-source-utility-functions stx) (define-syntax (make-source-utility-functions stx)
(syntax-case stx () (syntax-case stx ()
[(_ stem) [(_ stem)
(let ([stem-datum (syntax->datum #'stem)]) (with-syntax ([world:current-stem-source-ext (format-id stx "world:current-~a-source-ext" #'stem)]
(with-syntax ([world:current-stem-source-ext (format-id stx "world:current-~a-source-ext" #'stem)] [stem-source? (format-id stx "~a-source?" #'stem)]
[stem-source? (format-id stx "~a-source?" #'stem)] [get-stem-source (format-id stx "get-~a-source" #'stem)]
[get-stem-source (format-id stx "get-~a-source" #'stem)] [has-stem-source? (format-id stx "has-~a-source?" #'stem)]
[has-stem-source? (format-id stx "has-~a-source?" #'stem)] [has/is-stem-source? (format-id stx "has/is-~a-source?" #'stem)]
[has/is-stem-source? (format-id stx "has/is-~a-source?" #'stem)] [->stem-source-path (format-id stx "->~a-source-path" #'stem)]
[->stem-source-path (format-id stx "->~a-source-path" #'stem)] [->stem-source-paths (format-id stx "->~a-source-paths" #'stem)]
[->stem-source-paths (format-id stx "->~a-source-paths" #'stem)] [->stem-source+output-paths (format-id stx "->~a-source+output-paths" #'stem)])
[->stem-source+output-paths (format-id stx "->~a-source+output-paths" #'stem)]) #`(begin
#`(begin ;; does file have particular extension
;; does file have particular extension (define+provide (stem-source? x)
(define+provide (stem-source? x) (->boolean (and (pathish? x) (has-ext? (->path x) (world:current-stem-source-ext)))))
(->boolean (and (pathish? x) (has-ext? (->path x) (world:current-stem-source-ext)))))
;; non-theoretical: want the first possible source that exists in the filesystem
;; non-theoretical: want the first possible source that exists in the filesystem (define+provide (get-stem-source x)
(define+provide (get-stem-source x) (and (pathish? x)
(and (pathish? x) (let ([source-paths (->stem-source-paths (->path x))])
(let ([source-paths (->stem-source-paths (->path x))]) (and source-paths (ormap (λ(sp) (and (file-exists? sp) sp)) source-paths)))))
(and source-paths (ormap (λ(sp) (and (file-exists? sp) sp)) source-paths)))))
;; does the source-ified version of the file exist
;; does the source-ified version of the file exist (define+provide (has-stem-source? x)
(define+provide (has-stem-source? x) (->boolean (get-stem-source x)))
(->boolean (get-stem-source x)))
;; it's a file-ext source file, or a file that's the result of a file-ext source
;; it's a file-ext source file, or a file that's the result of a file-ext source (define+provide (has/is-stem-source? x)
(define+provide (has/is-stem-source? x) (->boolean (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list stem-source? has-stem-source?)))))
(->boolean (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list stem-source? has-stem-source?)))))
;; get first possible source path (does not check filesystem)
;; get first possible source path (does not check filesystem) (define+provide/contract (->stem-source-path x)
(define+provide/contract (->stem-source-path x) (pathish? . -> . (or/c #f path?))
(pathish? . -> . (or/c #f path?)) (define paths (->stem-source-paths x))
(define paths (->stem-source-paths x)) (and paths (car paths)))
(and paths (car paths)))
;; get all possible source paths (does not check filesystem)
;; get all possible source paths (does not check filesystem) (define+provide/contract (->stem-source-paths x)
(define+provide/contract (->stem-source-paths x) (pathish? . -> . (or/c #f (non-empty-listof path?)))
(pathish? . -> . (or/c #f (non-empty-listof path?))) (define results (if (stem-source? x)
(define results (if (stem-source? x) (list x) ; already has the source extension
(list x) ; already has the source extension #,(if (eq? (syntax->datum #'stem) 'scribble)
#,(if (eq? stem-datum 'scribble) #'(if (x . has-ext? . 'html) ; different logic for scribble sources
#'(if (x . has-ext? . 'html) ; different logic for scribble sources (list (add-ext (remove-ext* x) (world:current-stem-source-ext)))
(list (add-ext (remove-ext* x) (world:current-stem-source-ext))) #f)
#f) #'(let ([x-ext (get-ext x)]
#'(list* (add-ext x (world:current-stem-source-ext)) [source-ext (world:current-stem-source-ext)])
(if (get-ext x) (append
(list (add-ext (escape-last-ext x) (world:current-stem-source-ext))) (list (add-ext x source-ext)) ; standard
null))))) (if x-ext ; has existing ext, therefore needs escaped version
(and results (map ->path results))) (append
(list (add-ext (escape-last-ext x) source-ext))
;; coerce either a source or output file to both (if (ext-in-poly-targets? x-ext x) ; needs multi + escaped multi
(define+provide/contract (->stem-source+output-paths path) (let ([x-multi (add-ext (remove-ext x) (world:current-poly-source-ext))])
(pathish? . -> . (values path? path?)) (list
;; get the real source path if available, otherwise a theoretical path (add-ext x-multi (world:current-stem-source-ext))
(values (->complete-path (or (get-stem-source path) (->stem-source-path path))) (add-ext (escape-last-ext x-multi) source-ext)))
(->complete-path (->output-path path)))))))])) null))
null))))))
(and results (map ->path results)))
;; coerce either a source or output file to both
(define+provide/contract (->stem-source+output-paths path)
(pathish? . -> . (values path? path?))
;; get the real source path if available, otherwise a theoretical path
(values (->complete-path (or (get-stem-source path) (->stem-source-path path)))
(->complete-path (->output-path path))))))]))
(make-source-utility-functions preproc) (make-source-utility-functions preproc)
@ -160,7 +201,8 @@
(check-false (preproc-source? "foo.bar")) (check-false (preproc-source? "foo.bar"))
(check-false (preproc-source? #f)) (check-false (preproc-source? #f))
(check-equal? (->preproc-source-paths (->path "foo.pp")) (list (->path "foo.pp"))) (check-equal? (->preproc-source-paths (->path "foo.pp")) (list (->path "foo.pp")))
(check-equal? (->preproc-source-paths (->path "foo.html")) (list (->path "foo.html.pp") (->path "foo_html.pp"))) (check-equal? (->preproc-source-paths (->path "foo.html")) (list (->path "foo.html.pp") (->path "foo_html.pp")
(->path "foo.poly.pp") (->path "foo_poly.pp")))
(check-equal? (->preproc-source-paths "foo") (list (->path "foo.pp"))) (check-equal? (->preproc-source-paths "foo") (list (->path "foo.pp")))
(check-equal? (->preproc-source-paths 'foo) (list (->path "foo.pp"))) (check-equal? (->preproc-source-paths 'foo) (list (->path "foo.pp")))
(check-equal? (->preproc-source-path (->path "foo.pp")) (->path "foo.pp")) (check-equal? (->preproc-source-path (->path "foo.pp")) (->path "foo.pp"))
@ -184,7 +226,8 @@
(check-false (markup-source? "foo.p")) (check-false (markup-source? "foo.p"))
(check-false (markup-source? #f)) (check-false (markup-source? #f))
(check-equal? (->markup-source-paths (->path "foo.pm")) (list (->path "foo.pm"))) (check-equal? (->markup-source-paths (->path "foo.pm")) (list (->path "foo.pm")))
(check-equal? (->markup-source-paths (->path "foo.html")) (list (->path "foo.html.pm") (->path "foo_html.pm"))) (check-equal? (->markup-source-paths (->path "foo.html")) (list (->path "foo.html.pm") (->path "foo_html.pm")
(->path "foo.poly.pm") (->path "foo_poly.pm")))
(check-equal? (->markup-source-paths "foo") (list (->path "foo.pm"))) (check-equal? (->markup-source-paths "foo") (list (->path "foo.pm")))
(check-equal? (->markup-source-paths 'foo) (list (->path "foo.pm"))) (check-equal? (->markup-source-paths 'foo) (list (->path "foo.pm")))
(check-equal? (->markup-source-path (->path "foo.pm")) (->path "foo.pm")) (check-equal? (->markup-source-path (->path "foo.pm")) (->path "foo.pm"))
@ -211,7 +254,11 @@
(define+provide/contract (->output-path x) (define+provide/contract (->output-path x)
(coerce/path? . -> . coerce/path?) (coerce/path? . -> . coerce/path?)
(cond (cond
[(or (markup-source? x) (preproc-source? x) (null-source? x) (markdown-source? x) (template-source? x)) (unescape-ext (remove-ext x))] [(or (markup-source? x) (preproc-source? x) (null-source? x) (markdown-source? x) (template-source? x))
(define output-path (unescape-ext (remove-ext x)))
(if (has-poly-ext? output-path)
(add-ext (remove-ext output-path) (or (world:current-poly-target) (car (world:current-poly-targets))))
output-path)]
[(scribble-source? x) (add-ext (remove-ext x) 'html)] [(scribble-source? x) (add-ext (remove-ext x) 'html)]
[else x])) [else x]))
@ -227,7 +274,9 @@
(check-equal? (->output-path 'foo_html.p) (->path "foo.html")) (check-equal? (->output-path 'foo_html.p) (->path "foo.html"))
(check-equal? (->output-path (->path "/Users/mb/git/foo_html.p")) (->path "/Users/mb/git/foo.html")) (check-equal? (->output-path (->path "/Users/mb/git/foo_html.p")) (->path "/Users/mb/git/foo.html"))
(check-equal? (->output-path "foo_xml.p") (->path "foo.xml")) (check-equal? (->output-path "foo_xml.p") (->path "foo.xml"))
(check-equal? (->output-path 'foo_barml.p) (->path "foo.barml"))) (check-equal? (->output-path 'foo_barml.p) (->path "foo.barml"))
(check-equal? (->output-path "foo.poly.pm") (->path "foo.html"))
(check-equal? (->output-path "foo_poly.pp") (->path "foo.html")))
(define+provide/contract (project-files-with-ext ext) (define+provide/contract (project-files-with-ext ext)
(coerce/symbol? . -> . complete-paths?) (coerce/symbol? . -> . complete-paths?)

@ -13,11 +13,19 @@
[(_ (~optional (~seq #:command-char command-char:expr)) p:expr) [(_ (~optional (~seq #:command-char command-char:expr)) p:expr)
(quasisyntax/loc stx (quasisyntax/loc stx
(let ([result (include/text #,@(if (attribute command-char) (let ([result (include/text #,@(if (attribute command-char)
(list #'#:command-char #'command-char) (list #'#:command-char #'command-char)
empty) empty)
p)]) p)])
(if (bytes? result)
(with-output-to-bytes (λ () (write-bytes result))) (let ([result (cond
(with-output-to-string (λ () (output result))))))])) [(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) (provide include-template)

@ -1,7 +1,7 @@
#lang racket/base #lang racket/base
(require racket/file racket/path racket/match compiler/cm) (require racket/file racket/path compiler/cm)
(require sugar/test sugar/define sugar/file) (require sugar/test sugar/define sugar/file)
(require "file.rkt" "cache.rkt" "world.rkt" "debug.rkt" "pagetree.rkt" "project.rkt" "template.rkt" "rerequire.rkt" "cache-ns.rkt") (require "file.rkt" "cache.rkt" "debug.rkt" "pagetree.rkt" "project.rkt" "template.rkt" "rerequire.rkt" "cache-ns.rkt" "world.rkt")
;; used to track renders according to modification dates of component files ;; used to track renders according to modification dates of component files
(define mod-date-hash (make-hash)) (define mod-date-hash (make-hash))
@ -85,7 +85,7 @@
(cond (cond
[(ormap (λ(test) (test so-path)) (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source? has/is-template-source?)) [(ormap (λ(test) (test so-path)) (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source? has/is-template-source?))
(let-values ([(source-path output-path) (->source+output-paths so-path)]) (let-values ([(source-path output-path) (->source+output-paths so-path)])
(render-to-file-if-needed source-path output-path))] (render-to-file-if-needed source-path #f output-path))]
[(pagetree-source? so-path) (render-pagetree so-path)])) [(pagetree-source? so-path) (render-pagetree so-path)]))
(void)) (void))
@ -100,24 +100,25 @@
[else #f])) [else #f]))
(define/contract+provide (render-to-file-if-needed source-path [template-path #f] [maybe-output-path #f]) (define/contract+provide (render-to-file-if-needed source-path [maybe-template-path #f] [maybe-output-path #f])
((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . void?) ((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . void?)
(define output-path (or maybe-output-path (->output-path source-path))) (define output-path (or maybe-output-path (->output-path source-path)))
(define template-path (get-template-for source-path)) (define template-path (or maybe-template-path (get-template-for source-path output-path)))
(when (render-needed? source-path template-path output-path) (when (render-needed? source-path template-path output-path)
(render-to-file source-path template-path output-path))) (render-to-file source-path template-path output-path)))
(define/contract+provide (render-to-file source-path [template-path #f] [maybe-output-path #f]) (define/contract+provide (render-to-file source-path [maybe-template-path #f] [maybe-output-path #f])
((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . void?) ((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . void?)
(define output-path (or maybe-output-path (->output-path source-path))) (define output-path (or maybe-output-path (->output-path source-path)))
(define render-result (render source-path template-path)) ; will either be string or bytes (define template-path (or maybe-template-path (get-template-for source-path output-path)))
(define render-result (render source-path template-path output-path)) ; will either be string or bytes
(display-to-file render-result output-path #:exists 'replace (display-to-file render-result output-path #:exists 'replace
#:mode (if (string? render-result) 'text 'binary))) #:mode (if (string? render-result) 'text 'binary)))
(define/contract+provide (render source-path [template-path #f]) (define/contract+provide (render source-path [maybe-template-path #f] [maybe-output-path #f])
((complete-path?) ((or/c #f complete-path?)) . ->* . (or/c string? bytes?)) ((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . (or/c string? bytes?))
(define render-proc (define render-proc
(cond (cond
[(ormap (λ(test render-proc) (and (test source-path) render-proc)) [(ormap (λ(test render-proc) (and (test source-path) render-proc))
@ -125,24 +126,28 @@
(list render-null-source render-preproc-source render-markup-or-markdown-source render-scribble-source render-markup-or-markdown-source render-preproc-source))] (list render-null-source render-preproc-source render-markup-or-markdown-source render-scribble-source render-markup-or-markdown-source render-preproc-source))]
[else (error (format "render: no rendering function found for ~a" source-path))])) [else (error (format "render: no rendering function found for ~a" source-path))]))
(message (format "rendering: /~a" (find-relative-path (world:current-project-root) source-path))) (define output-path (or maybe-output-path (->output-path source-path)))
(define render-result (apply render-proc (cons source-path (if template-path (list template-path) null)))) (define template-path (or maybe-template-path (get-template-for source-path output-path)))
(message (format "rendering: /~a as /~a" (find-relative-path (world:current-project-root) source-path)
(find-relative-path (world:current-project-root) output-path)))
(define render-result (parameterize ([world:current-poly-target (->symbol (get-ext output-path))])
(apply render-proc (list source-path template-path output-path))))
;; wait till last possible moment to store mod dates, because render-proc may also trigger its own subrenders ;; wait till last possible moment to store mod dates, because render-proc may also trigger its own subrenders
;; e.g., of a template. ;; e.g., of a template.
(update-mod-date-hash source-path template-path) (update-mod-date-hash source-path template-path)
render-result) render-result)
(define/contract (render-null-source source-path) (define/contract (render-null-source source-path . ignored-paths)
(complete-path? . -> . bytes?) ((complete-path?) #:rest any/c . ->* . bytes?)
;; All this does is copy the source. Hence, "null". ;; All this does is copy the source. Hence, "null".
;; todo: add test to avoid copying if unnecessary (good idea in case the file is large) ;; todo: add test to avoid copying if unnecessary (good idea in case the file is large)
(file->bytes source-path)) (file->bytes source-path))
(define/contract (render-scribble-source source-path) (define/contract (render-scribble-source source-path . ignored-paths)
(complete-path? . -> . string?) ((complete-path?) #:rest any/c . ->* . string?)
(match-define-values (source-dir source-filename _) (split-path source-path)) (define source-dir (dirname source-path))
(dynamic-rerequire source-path) ; to suppress namespace caching by dynamic-require below (dynamic-rerequire source-path) ; to suppress namespace caching by dynamic-require below
(define scribble-render (dynamic-require 'scribble/render 'render)) (define scribble-render (dynamic-require 'scribble/render 'render))
(time (parameterize ([current-directory (->complete-path source-dir)]) (time (parameterize ([current-directory (->complete-path source-dir)])
@ -158,17 +163,21 @@
result) result)
(define/contract (render-preproc-source source-path) (define/contract (render-preproc-source source-path . ignored-paths)
(complete-path? . -> . (or/c string? bytes?)) ((complete-path?) #:rest any/c . ->* . (or/c string? bytes?))
(match-define-values (source-dir _ _) (split-path source-path)) (define source-dir (dirname source-path))
(time (parameterize ([current-directory (->complete-path source-dir)]) (time (parameterize ([current-directory (->complete-path source-dir)])
(render-through-eval `(begin (require pollen/cache)(cached-require ,source-path ',(world:current-main-export))))))) (render-through-eval `(begin (require pollen/cache)
(cached-require ,source-path ',(world:current-main-export)))))))
(define/contract (render-markup-or-markdown-source source-path [maybe-template-path #f]) (define/contract (render-markup-or-markdown-source source-path [maybe-template-path #f] [maybe-output-path #f])
((complete-path?) ((or/c #f complete-path?)) . ->* . (or/c string? bytes?)) ((complete-path?) ((or/c #f complete-path?)(or/c #f complete-path?)) . ->* . (or/c string? bytes?))
(match-define-values (source-dir _ _) (split-path source-path)) (define source-dir (dirname source-path))
(define template-path (or maybe-template-path (get-template-for source-path))) (define output-path (or maybe-output-path (->output-path source-path)))
(define template-path (or maybe-template-path (get-template-for source-path output-path)))
(when (not template-path)
(raise-result-error 'render-markup-or-markdown-source "valid template path" template-path))
(render-from-source-or-output-path template-path) ; because template might have its own preprocessor source (render-from-source-or-output-path template-path) ; because template might have its own preprocessor source
(define expr-to-eval (define expr-to-eval
`(begin `(begin
@ -194,28 +203,70 @@
(or (markup-source? path) (markdown-source? path))) (or (markup-source? path) (markdown-source? path)))
(define/contract+provide (get-template-for source-path) (define identity (λ(x) x))
(complete-path? . -> . (or/c #f complete-path?)) (define/contract+provide (get-template-for source-path [maybe-output-path #f])
(match-define-values (source-dir _ _) (split-path source-path)) ((complete-path?)((or/c #f complete-path?)) . ->* . (or/c #f complete-path?))
(and (templated-source? source-path) ; doesn't make sense if it's not a templated source format
(let ([output-path (->output-path source-path)]) (define (file-exists-or-has-source? p) ; p could be #f
(or ; Build the possible paths and use the first one that either exists, or has existing source (template, preproc, or null) (and p (ormap (λ(proc) (file-exists? (proc p))) (list identity ->template-source-path ->preproc-source-path ->null-source-path)) p))
(ormap (λ(p) (if (ormap file-exists? (list p (->template-source-path p) (->preproc-source-path p) (->null-source-path p))) p #f))
(filter (λ(x) (->boolean x)) ; if any of the possibilities below are invalid, they return #f (define (get-template)
(list (define source-dir (dirname source-path))
;; this op touches the cache so set up current-directory correctly (define output-path (or maybe-output-path (->output-path source-path)))
(parameterize ([current-directory (world:current-project-root)]) (define output-path-ext (get-ext output-path))
(let ([source-metas (cached-require source-path (world:current-meta-export))]) (define (get-template-from-metas)
(and (hash-has-key? source-metas (->symbol (world:current-template-meta-key))) (with-handlers ([exn:fail:contract? (λ _ #f)]) ; in case source-path doesn't work with cached-require
(build-path source-dir (select-from-metas (->string (world:current-template-meta-key)) source-metas))))) ; path based on metas (parameterize ([current-directory (world:current-project-root)])
(and (filename-extension output-path) (build-path (world:current-project-root) (let* ([source-metas (cached-require source-path (world:current-meta-export))]
(add-ext (world:current-default-template-prefix) (get-ext output-path))))))) ; path to default template [template-name-or-names (select-from-metas (world:current-template-meta-key) source-metas)] ; #f or atom or list
(and (filename-extension output-path) (build-path (world:current-server-extras-path) (add-ext (world:current-fallback-template-prefix) (get-ext output-path)))))))) ; fallback template [template-name (cond
[(list? template-name-or-names)
(define result
(memf (λ(tn) (equal? (get-ext tn) output-path-ext)) template-name-or-names)) ; #f or list
(and result (car result))]
[else template-name-or-names])])
(and template-name (build-path source-dir template-name))))))
(define (get-default-template)
(and output-path-ext
(build-path (world:current-project-root)
(add-ext (world:current-default-template-prefix) output-path-ext))))
(define (get-fallback-template)
(and output-path-ext
(build-path (world:current-server-extras-path)
(add-ext (world:current-fallback-template-prefix) output-path-ext))))
(or (file-exists-or-has-source? (get-template-from-metas))
(file-exists-or-has-source? (get-default-template))
(file-exists-or-has-source? (get-fallback-template))))
(and (templated-source? source-path) (get-template)))
(module-test-external
(require pollen/world sugar/file sugar/coerce)
(define fallback.html (build-path (world:current-server-extras-path)
(add-ext (world:current-fallback-template-prefix) 'html)))
(check-equal? (get-template-for (->complete-path "foo.poly.pm")) fallback.html)
(check-equal? (get-template-for (->complete-path "foo.html.pm")) fallback.html)
(define fallback.svg (build-path (world:current-server-extras-path)
(add-ext (world:current-fallback-template-prefix) 'svg)))
(parameterize ([world:current-poly-target 'svg])
(check-equal? (get-template-for (->complete-path "foo.poly.pm")) fallback.svg)
(check-equal? (get-template-for (->complete-path "foo.html.pm")) fallback.html))
(define fallback.missing (build-path (world:current-server-extras-path)
(add-ext (world:current-fallback-template-prefix) 'missing)))
(parameterize ([world:current-poly-target 'missing])
(check-false (get-template-for (->complete-path "foo.poly.pm")))
(check-equal? (get-template-for (->complete-path "foo.html.pm")) fallback.html)))
(define-namespace-anchor anchor-to-this-namespace)
(define/contract (render-through-eval expr-to-eval) (define/contract (render-through-eval expr-to-eval)
(list? . -> . (or/c string? bytes?)) (list? . -> . (or/c string? bytes?))
(parameterize ([current-namespace (make-base-namespace)] (parameterize ([current-namespace (make-base-namespace)]
[current-output-port (current-error-port)]) [current-output-port (current-error-port)])
(namespace-attach-module (namespace-anchor->namespace anchor-to-this-namespace) 'pollen/world) ; brings in params
(eval expr-to-eval))) (eval expr-to-eval)))

@ -53,6 +53,8 @@ Or, if you can find a better digital-publishing tool, use that. But I'm never go
@include-section["tutorial-third.scrbl"] @include-section["tutorial-third.scrbl"]
@include-section["tutorial-fourth.scrbl"]
@include-section["tutorial-mini.scrbl"] @include-section["tutorial-mini.scrbl"]
@include-section["raco.scrbl"] @include-section["raco.scrbl"]

Binary file not shown.

After

Width:  |  Height:  |  Size: 38 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 25 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 37 KiB

@ -82,6 +82,20 @@ Alternatively, the command can take a variable number of path arguments. @racket
> raco pollen render foo.html.pm bar.html.pm zam.css.pp > raco pollen render foo.html.pm bar.html.pm zam.css.pp
> raco pollen render *.html.pm} > raco pollen render *.html.pm}
Paths can also be specified as output rather than input paths, and the corresponding source paths will be discovered:
@terminal{
> raco pollen render foo.html
> raco pollen render foo.html bar.html zam.css}
The optional @exec{-t} or @exec{--target} switch specifies the render target for multi-output source files. If the target is omitted, the renderer will use whatever target appears first in @racket[(world:current-poly-targets)].
@terminal{
> raco pollen render -t pdf foo.poly.pm}
See also @seclink["raco-pollen-render-poly"].
@bold{Warning}: In all cases, the newly rendered output file will overwrite any previous output file.
@section{@exec{raco pollen publish}} @section{@exec{raco pollen publish}}

@ -91,7 +91,7 @@ As a publishing system, Pollen includes:
@item{@bold{A programming language.} The Pollen language is a variant of Scribble, with specific dialects tailored to different kinds of source files. You don't need to use the programming features to do useful work, but they're available when you need them.} @item{@bold{A programming language.} The Pollen language is a variant of Scribble, with specific dialects tailored to different kinds of source files. You don't need to use the programming features to do useful work, but they're available when you need them.}
@item{@bold{A set of tools & libraries.} Pollen targets HTML output. So it includes a variety of tools that cure common HTML annoyances, including a CSS preprocessor.} @item{@bold{A set of tools & libraries.} Pollen can produce output in any format, but it's especially useful for markup-style formats like XML and HTML.}
@item{@bold{A development environment.} Pollen works with the DrRacket IDE. It also includes a project web server so you can dynamically preview and revise your publication.} @item{@bold{A development environment.} Pollen works with the DrRacket IDE. It also includes a project web server so you can dynamically preview and revise your publication.}

@ -151,7 +151,7 @@ the output name @filepath{poem.html}
(If you want to name the file @filepath{something-else.html.pp}, be my guest. There's no special meaning associated with the prefix of a source file, only the suffixes.) (If you want to name the file @filepath{something-else.html.pp}, be my guest. There's no special meaning associated with the prefix of a source file, only the suffixes.)
@margin-note{You're welcome to change the name of your source files from the desktop. On Mac OS X and Windows, however, the desktop interface often hides file extensions, so check the properties of the file afterward to make sure you got the name you expected.} @margin-note{If your system or text editor gives you grief for having two file extensions, you can use the underscore (@litchar{_}) to join the inner extension. So instead of @filepath{poem.html.pp}, the file would be named @filepath{poem_html.pp}. This filename will work exactly the same way, and still result in @filepath{poem.html} when rendered.}
In a convenient location (e.g., your home directory or the desktop) create a new directory for your project called @code{tutorial}. In this new directory, save your DrRacket file as @filepath{poem.html.pp}. In a convenient location (e.g., your home directory or the desktop) create a new directory for your project called @code{tutorial}. In this new directory, save your DrRacket file as @filepath{poem.html.pp}.

@ -1,100 +1,470 @@
#lang scribble/manual #lang scribble/manual
@(require scribble/eval (for-label pollen/world pollen/tag racket/base pollen/template txexpr)) @(require scribble/eval racket/date (for-label racket/file racket/system pollen/decode plot pollen/world pollen/tag racket/base pollen/template txexpr racket/list racket/string))
@(require "mb-tools.rkt") @(require "mb-tools.rkt")
@(define my-eval (make-base-eval)) @(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/decode pollen/template pollen/tag xml racket/list txexpr)) @(my-eval `(require pollen pollen/decode pollen/template pollen/tag xml racket/list txexpr))
@title[#:tag "third-tutorial"]{Fourth tutorial} @title[#:tag "fourth-tutorial"]{Fourth tutorial}
In previous tutorial projects, we've maintained a one-to-one relationship between source files and output files. In this tutorial, however, you'll learn how to generate output in multiple formats from a single Pollen source file. You'll learn about:
@itemlist[ @itemlist[
@item{You can use any function in any kind of source file} @item{Setting up & using @tt{poly} source files}
@item{Decoding} @item{The @tt{config} submodule}
@item{Metas} @item{Branching tag functions}
@item{Hierarchical pagetrees} @item{Using Pollen to generate binary data}
@item{Forcing unbound-identifier errors} ]
@item{Embedding HTML or XML} If you want the shortest possible introduction to Pollen, try the @secref["quick-tour"].
]
@section[#:tag-prefix "tutorial-4"]{Prerequisites}
@section{Sharing data between preprocessor files} I'll assume you've completed the @secref["third-tutorial"] and that you understand the principles of Pollen markup mode — creating source files, converting them to X-expressions, and then combining them with templates to make output files.
The preprocessor is useful for inserting variables that hold values. But variables are only useful when they can be shared among multiple files. Let's look at one way to do that. I'll also assume that you're comfortable with @seclink["Attaching_behavior_to_tags"] with tag functions, and that you can read and write basic Racket functions. Most of this tutorial is programming — easy programming, but programming nonetheless.
Any value in a Pollen file that's set up using @racket[define] can be pulled into another Pollen file using the @racket[require] function. For instance, let's set up another preprocessor file in the same directory as @racketvalfont["brennan.md.pp"], called @racketvalfont["dale.md.pp"]: @section{Multiple-output publishing and its discontents}
@filebox["dale.md.pp"]{@verbatim{ Publishing documents in multiple output formats is a common need. A common solution is to write or render your document in one output format, and then convert to others as needed. And, for simple documents, this can work well enough.
#lang pollen
My name is _Dale_, and I enjoy: But in general, writing your document directly in an output format, like Markdown or HTML, is a bad idea. Why? Because output formats are just that — output formats. They're optimized to store the kind of information that the output device needs, not the information that the writer might want. Thus, using them as input formats means losing a huge amount of expressivity. I discussed this issue in @seclink["The_case_against_Markdown"]. Markdown is (too) often valorized as an authoring format, but it's not expressive or semantic. It's just a way of notating HTML, which is merely a boring and limited output format.
+ super-duper boring sauce Converting a document from one input format to another is better — at least you get the benefit of using a more expressive input format. The problem is that richness doesn't necessarily carry through as you convert between formats, which involves simplifying assumptions about how certain entities map to each other. Again, that's not a knock on document converters like @link["http://pandoc.org"]{Pandoc} — if your document is simple enough, and you're satisfied with the assumptions made during the conversion process, great.
+ at least 3 fish nuggets}} But if you're not, you're stuck.
In the project server, this will produce the expected output:
@nested[#:style 'code-inset]{@verbatim{ @subsection{And let's not leave out programmability}
My name is _Dale_, and I enjoy:
+ super-duper boring sauce @secref["the-book-is-a-program"], right? Even if you love your input format, it's probably not programmable. For instance, casting my eye across the @link["http://pandoc.org"]{input formats supported} by Pandoc, I don't see any that are natively programmable in a general-purpose language. So pick your favorite. If you like the expressiveness and efficiency that programming can provide, then you're still stuck.
+ at least 3 fish nuggets}}
Now, let's update the content using values defined in @racketvalfont{brennan.md.pp}. We do this by adding the @racket[require] command to the top of our file: @subsection{One source, multiple outputs}
@filebox["dale.md.pp"]{@verbatim{ Instead, what if we rendered multiple document output formats from one programmable source file?
#lang pollen
The software-development analogy is the problem of compiling code for multiple platforms. In that case, you would never take compiled code for one platform and try to ``convert'' it for use on another platform. And you would do everything possible to avoid maintaining separate sources for each platform. Rather, the ideal solution is to have one master source that can be compiled to each platform.
Before we go further, let's be honest: though this has always been the ideal solution, it's always been a difficult problem. Creating common source often means giving up some of the optimizations that might be available on a specific platform. The result is that cross-platform apps are often not as fast or sleek as their native-platform counterparts. (For proof, see every Java desktop app ever made.)
With documents, however, the good news is that we're not creating software code, exactly — we're creating data files. So as a technical matter, the problem is simpler.
Moreover, document output formats may be different in technical details, but there's a lot of overlap between the ideas they encode — for instance, there's always a way of specifying the font and point size, of specifying the page margins, and so forth. So it should, in principle, be possible to encode these entities in a high-level way in our source, abstracted from the output-level details.
@subsection{Scribble vs. Pollen}
By the way, I'm not claiming here that I've discovered the document-processing equivalent of the Higgs boson. Many tools offer multiple-output publishing, including @other-doc['(lib "scribblings/scribble/scribble.scrbl")], which is the foundation of Pollen.
Let me be clear: Scribble does a great job with this. If you have a project that fits with Scribble's document model and rendering model, then it may be a better option than Pollen. Scribble can do lots of things that Pollen cannot.
So why prefer Pollen? Pollen is more open-ended. Though Pollen adopts Scribble's syntax, it omits a lot of the heavy lifting that Scribble does on the back end. In one sense, this creates more work for the Pollen user, because certain things need to be recreated. But in another sense, it creates an opportunity, because it also removes the restrictions that Scribble needs to impose. You have maximum control from start to finish. Complex things are possible, but simple things remain simple.
@section{Making a multiple-output project}
◊(require "brennan.md.pp") A multiple-output project works pretty much the same way as a single-output project. The main difference is that you need to name your source files differently, update your @filepath{pollen.rkt} file to identify the output types you want to target, and alter your tag functions to handle those types.
My name is _Dale_, and I enjoy:
+ super-duper boring sauce @subsection{The @tt{poly} output type}
+ at least 3 fish nuggets}} In the previous tutorials, you saw how Pollen source files correspond to certain output file types by use of a double file extension: the first extension identifies the output-file type, and the second extension identifies the source-file type. So to end up with an output file called @filepath{document.html}, using Pollen markup (indicated by the extension @filepath{pm}), you'd create a source file called @filepath{document.html.pm}.
The three values that we defined in @racketvalfont{brennan.md.pp} — @racketvalfont{sauce-type}, @racketvalfont{nugget-type}, and @racketvalfont{nugget-quantity} — will now be available in @racketvalfont{dale.md.pp} under the same names, so we can insert them into the Markdown in the same way: In a multiple-output project, a source file no longer has a one-to-one correspondence with a specific output type. To indicate this, we'll instead use the special @tt{poly} extension. So our @filepath{document.html.pm} will become @filepath{document.poly.pm}.
@filebox["dale.md.pp"]{@verbatim{ @margin-note{The @tt{poly} extension is the default, but can be changed for a project by using the @racket[world:current-poly-source-ext] setting.}
Let's set up a new multi-output project for a résumé. Find a convenient directory and create a new @tt{poly} source file as follows:
@fileblock["cv.poly.pm" @codeblock{
#lang pollen #lang pollen
◊(require "brennan.md.pp") ◊heading{Brennan Huff}
Today is ◊(get-date). I ◊emph{really} want this job.
}]
Yes, this is the worst résumé ever. Yours, I'm certain, would be better.
Other than the new @tt{poly} extension, this file is no different than ones we've seen before. It starts with @code{#lang pollen}. It has some text and tags. And the @tt{pm} extension indicates that we're using Pollen markup.
You can, of course, use any Pollen source dialect you like for a @tt{poly} source. I like Pollen markup best, of course, so we'll use that here.
@subsection{Poly sources in the project server}
Start the project server in your tutorial directory. In your browser, you should see something like this:
@image/rp["poly-ps-html.png" #:scale 0.45]
``Why does it say @filepath{cv.html}? I thought we had a multi-output source file.'' You do. But since we haven't yet identified any render formats for a poly source file, Pollen assumes HTML. This also allows you to click through to see a result right away:
@browser{Brennan Huff Today is . I really want this job.}
This proves that our source file is working. It looks dumb, however, because we haven't defined any sensible tag functions. So let's add a @filepath{pollen.rkt} file to our project directory as follows:
@fileblock["pollen.rkt" @codeblock|{
#lang racket/base
(require racket/date)
(provide (all-defined-out))
(define (get-date)
(date->string (current-date)))
(define (heading . xs)
`(h2 ,@xs))
(define (emph . xs)
`(strong ,@xs))
}|]
The @racket[get-date] tag function will insert the current date as a string. The @racket[heading] and @racket[emph] tag functions will become typical HTML @racket[h2] and @racket[strong] tags respectively. (If it's unclear why this is so, this would be a good time to review @seclink["Using_Racket_s_function_libraries"] and @seclink["Returning_an_X-expression"].)
When we refresh the file in the project server, we'll see something more reasonable:
@browser{
@bold{@larger{Brennan Huff}}
Today is @(date->string (current-date)). I @bold{really} want this job.
}
@subsection{Adding output targets for @tt{poly} sources}
Though Pollen imputes HTML as a target for poly sources by default, if you only wanted HTML, you wouldn't be using a poly source. So our next step will be to explicitly define the output targets that we want to associate with poly sources.
@subsubsection{Using the @tt{config} submodule}
We'll do this by setting the @racket[world:current-poly-targets] value in our @filepath{pollen.rkt}. If you haven't investigated it yet, the @racket[pollen/world] module offers @seclink["settable-values"] that allow you to configure certain Pollen characteristics from within a @filepath{pollen.rkt} file. The example on that page, for instance, shows how to change the markup source extension and the Pollen command character.
The idea is that you add a @racket[config] submodule to your @filepath{pollen.rkt} file with a @racket[define] statement for the value. Because we're defining the local value, we drop the @racket[world:current-] prefix and just call it @racket[poly-targets]. Our value will be a list of file extensions denoting the targets. To start, let's set our output formats to HTML and plain text, which we'll denote with the list of extensions @racket['(html txt)].
@margin-note{I'm glossing over the details of @seclink["submodules" #:doc '(lib "scribblings/guide/guide.scrbl")], but they're one of the best-considered features of the Racket language. What makes submodules so handy is that they are truly independent: you can load a submodule from a source file without running the main body of the file. Thus, tasks like this — setting configuration values — that might require separate files in other languages can be handled as submodules in Racket.}
@fileblock["pollen.rkt" @codeblock|{
#lang racket/base
(require racket/date)
(provide (all-defined-out))
(module config racket/base
(provide (all-defined-out))
(define poly-targets '(html txt)))
(define (get-date)
(date->string (current-date)))
(define (heading . xs)
`(h2 ,@xs))
(define (emph . xs)
`(strong ,@xs))
}|]
Though you ordinarily don't have to restart the project server to see changes in @filepath{pollen.rkt}, you do for @racket[config] values, because they're stashed in a submodule. On restart, the project server will look like this:
@image/rp["poly-ps-html-txt.png" #:scale 0.45]
What's happened is that @racket[world:current-poly-targets] now reflects the settings in @filepath{pollen.rkt}. The project server sees that we want to associate poly files with HTML and plain-text targets, and accordingly shows us two entries in the project-server listing: @filepath{cv.html.pm} and @filepath{cv.txt.pm}. As the adjacent message indicates, these are not new source files on disk, but rather implied by @filepath{cv.poly.pm}.
If you click on @filepath{cv.html.pm}, you'll see the same HTML output that you saw before. If you click on @filepath{cv.txt.pm}, however, you'll see this:
@terminal{
(root (h2 Brennan Huff)
Today is Monday, August 31st, 2015 . I (strong really) want this job.
)}
Don't panic. What we're seeing is the X-expression generated from the @filepath{cv.poly.pm} file, but formatted as plain text rather than HTML. It looks wrong because we haven't updated our project to handle plain-text output.
@subsection{Adding support for another output format}
The goal of this whole endeavor is to derive multiple output files from one source file. Thus, to make our résumé look right in plain text, we won't change anything in the source file. But we will add a template and update our tag functions.
@subsubsection{Adding a template for @tt{.txt}}
@seclink["Templates" #:tag-prefixes '("tutorial-2")] should be familiar to you by now. As usual, the name of the template is @tt{template} plus the relevant file extension, so in this case @filepath{template.txt}. Add the file as follows:
@fileblock["template.txt" @codeblock|{
◊(local-require racket/list)
◊(apply string-append (filter string? (flatten doc)))
}|]
What we're doing here is converting the X-expression to text in a smarter way. We use @racket[local-require] to bring in @racket[racket/list] so we can use the @racket[flatten] function. Then, to understand what the next line does, just read it from the inside out: ``Take the @racket[doc] export from the source file (which is an X-expression), @racket[flatten] it into a list, @racket[filter] out everything that's not a @racket[string?] (creating a list that's only strings) and @racket[apply] the @racket[string-append] function to these, resulting in one big string.'' Which is exactly what we need for a plain-text file.
When you return to the project server and click on @filepath{cv.txt.pm}, you'll see the result:
@terminal{
Brennan Huff
Today is Monday, August 31st, 2015. I really want this job.}
So far, so good. We've got legible plain text. But we've completely lost our formatting. Let's fix that.
@subsubsection{Branching tag functions}
The other half of supporting a new output format is making the tag functions mean something sensible. For HTML, we used tag functions to map our @racket[heading] markup tag to HTML's @racket[h2] tag, and our @racket[emph] tag to @racket[strong].
But plain text doesn't have @racket[h2] or @racket[strong]. So how about this: when we're rendering to plain text, let's make our @racket[heading] tag mean @tt{UPPERCASE TEXT}, and our @racket[emph] tag will mean adding @tt{**surrounding asterisks**}.
``So how do we make our tags mean one thing for HTML and a different thing for plain text?'' We make @italic{branching tag functions} that do different things depending on what the current rendering target for poly sources is.
That value, in fact, is stored in a Pollen @seclink["parameterize" #:doc '(lib "scribblings/guide/guide.scrbl")]{parameter} called @racket[(world:current-poly-target)]. What we're going to do is rewrite our tag functions to behave differently based on the value of this parameter. Update your @filepath{pollen.rkt} as follows:
@fileblock["pollen.rkt" @codeblock|{
#lang racket/base
(require racket/date pollen/world)
(provide (all-defined-out))
(module config racket/base
(provide (all-defined-out))
(define poly-targets '(html txt)))
(define (get-date)
(date->string (current-date)))
(define (heading . xs)
(case (world:current-poly-target)
[(txt) (map string-upcase xs)]
[else `(h2 ,@xs)]))
(define (emph . xs)
(case (world:current-poly-target)
[(txt) `("**" ,@xs "**")]
[else `(strong ,@xs)]))
}|]
Here, I've chosen to use @racket[case] because it's compact. But you can use any conditional structure you want (@racket[cond] would be another obvious choice). You can see that in the tag functions for @racket[heading] and @racket[emph], we've added a branch for the @racket[txt] output format. As promised, for @racket[heading] we're capitalizing the text, and in @racket[emph] we're adding double asterisks.
@margin-note{Could you use @racket[(html)] rather than @racket[else] for the second case? Sure. Should you? It's good practice to write conditionals with an @racket[else] because it guarantees that there's always a result. If @racket[case] (or @racket[cond]) doesn't find a matching clause, it returns @racket[void], which can be surprising or annoying. But do what you like. I'm not the @racket[else] police.}
Now when we return to the project server and refresh @filepath{cv.txt.pm}, we see our groovy plain-text formatting:
@terminal{
BRENNAN HUFF
Today is Monday, August 31st, 2015. I **really** want this job.}
By the way, the reason I included @racket[get-date] in this tutorial is to illustrate that not every function in a multi-output project necessarily needs to branch. (Static variables probably wouldn't either, though they could.) It produces a string, which is usable in either HTML or plain text. We just need to add branching to the tag functions that need context-specific behavior.
@subsection{Adding support for LaTeX output}
To add more output formats, we just repeat the same tasks: add a rendering target to our @racket[config] submodule, update any branching tag functions, and add a template for the new format.
Let's see how fast we can add support for LaTeX output. Here's the updated @filepath{pollen.rkt}:
@fileblock["pollen.rkt" @codeblock|{
#lang racket/base
(require racket/date pollen/world)
(provide (all-defined-out))
(module config racket/base
(provide (all-defined-out))
(define poly-targets '(html txt ltx)))
(define (get-date)
(date->string (current-date)))
(define (heading . xs)
(case (world:current-poly-target)
[(ltx) (apply string-append `("{\\huge " ,@xs "}"))]
[(txt) (map string-upcase xs)]
[else `(h2 ,@xs)]))
(define (emph . xs)
(case (world:current-poly-target)
[(ltx) (apply string-append `("{\\bf " ,@xs "}"))]
[(txt) `("**" ,@xs "**")]
[else `(strong ,@xs)]))
}|]
Notice that we added a @racket[ltx] extension to the list of @racket[poly-targets]. We also updated @racket[heading] and @racket[emph] to use comparable LaTeX commands.
Then a @filepath{template.ltx}:
@fileblock["template.ltx" @codeblock|{
\documentclass[a4paper,12pt]{letter}
\begin{document}
◊(local-require racket/list)
◊(apply string-append (filter string? (flatten doc)))
\end{document}
}|]
Notice that all we did here was take our @filepath{template.txt} (which turned an X-expression into a string) and wrap it in the bare minimum LaTeX boilerplate. (Confidential to LaTeX fans: please don't write to complain about my rudimentary LaTeX. It's a tutorial. I trust you to do better.)
Restart the project server to reify the changes to @racket[poly-targets]. When you restart, you'll see a link for @filepath{cv.ltx.pm}. Click it and you'll get this:
@terminal{
\documentclass[a4paper,12pt]{letter}
\begin{document}
{\huge Brennan Huff}
Today is Monday, August 31st, 2015. I {\bf really} want this job.
\end{document}}
That's it. LaTeX achieved.
@subsection{Adding support for PDF output}
Still not satisfied? Still want to see one more cute Pollen trick?
OK, you win. Let's not stop at LaTeX — let's go all the way to PDF using the LaTeX PDF converter, known as @exec{pdflatex}. (This is a command-line program that must be installed on your machine for this trick to work.)
How do we do this? We'll follow the pattern we've already established, but with one wrinkle. To make a PDF, we need to generate LaTeX output first. So we actually don't need to add new branches to our tag functions — we'll just let PDF piggyback on our LaTeX branches. The big difference will be in the template, where instead of returning a LaTeX source file, we'll send it through @exec{pdflatex} and get the binary PDF file that results.
First, we update @filepath{pollen.rkt}:
@fileblock["pollen.rkt" @codeblock|{
#lang racket/base
(require racket/date pollen/world)
(provide (all-defined-out))
(module config racket/base
(provide (all-defined-out))
(define poly-targets '(html txt ltx pdf)))
(define (get-date)
(date->string (current-date)))
(define (heading . xs)
(case (world:current-poly-target)
[(ltx pdf) (apply string-append `("{\\huge " ,@xs "}"))]
[(txt) (map string-upcase xs)]
[else `(h2 ,@xs)]))
(define (emph . xs)
(case (world:current-poly-target)
[(ltx pdf) (apply string-append `("{\\bf " ,@xs "}"))]
[(txt) `("**" ,@xs "**")]
[else `(strong ,@xs)]))
}|]
You can see that we've simply added the @racket[pdf] extension in three places: in the list of @racket[poly-targets], and to the @racket[ltx] branches of our tag functions. (In a @racket[case] statement, putting multiple values in a branch means ``match any of these values.'') Easy.
Not as easy: the template —
@fileblock["template.pdf.p" @codeblock|{
◊(local-require racket/file racket/system)
◊(define latex-source ◊string-append{
\documentclass[a4paper,12pt]{letter}
\begin{document}
◊(apply string-append (cdr doc))
\end{document}})
◊(define working-directory
(build-path (current-directory) "pollen-latex-work"))
◊(unless (directory-exists? working-directory)
(make-directory working-directory))
◊(define temp-ltx-path (build-path working-directory "temp.ltx"))
◊(display-to-file latex-source temp-ltx-path #:exists 'replace)
◊(define command (format "pdflatex '~a'" temp-ltx-path))
◊(if (system command)
(file->bytes (build-path working-directory "temp.pdf"))
(error "pdflatex: rendering error"))
}|]
I know that only the serious nerds are still with me, but let's quickly narrate what's happening here.
First, we use @filepath{template.pdf.p} rather than @filepath{template.pdf} for our template name. This is the @seclink["Null___p_extension_"] in use. Operating systems assume that files with a @racket[pdf] extension contain binary data, not text. The @racket[p] extension just shields the file from this assumption. It will simply be converted to @filepath{template.pdf} on render.
A quick narrative of the rest:
@codeblock|{
◊(local-require racket/file racket/system)
}|
We need @racket[racket/file] for @racket[display-to-file] and @racket[file->bytes]; we need @racket[racket/system] for @racket[system] (to use the command line).
@codeblock|{
◊(define latex-source ◊string-append{
\documentclass[a4paper,12pt]{letter}
\begin{document}
◊(apply string-append (cdr doc))
\end{document}})
}|
This is the same as our @filepath{template.ltx} from before, but stored in a variable. The @racket[string-append] is needed here because the curly braces create a list of strings, and we want a single string.
@codeblock|{
◊(define working-directory
(build-path (current-directory) "pollen-latex-work"))
◊(unless (directory-exists? working-directory)
(make-directory working-directory))
◊(define temp-ltx-path (build-path working-directory "temp.ltx"))
◊(display-to-file latex-source temp-ltx-path #:exists 'replace)
}|
Create a temporary working directory (because @exec{pdflatex} creates a bunch of ancillary log files) and write our LaTeX source to a @filepath{temp.ltx} file.
@codeblock|{
◊(define command (format "pdflatex '~a'" temp-ltx-path))
◊(if (system command)
(file->bytes (build-path working-directory "temp.pdf"))
(error "pdflatex: rendering error"))
}|
Issue the @exec{pdflatex} command, using our newly created @filepath{temp.ltx} as the source. Finally, pick up the PDF that was created and return it as a byte string (= binary data).
Restart the project server and click on @filepath{cv.pdf.pm}, and you'll see the rendered PDF right in the browser:
@image/rp["poly-ps-pdf.png" #:scale 0.45]
My name is _Dale_, and I enjoy: ``Why didn't you just write to @filepath{cv.pdf}?'' Because when Pollen is running this render, it expects to end up with the data that it will write to @filepath{cv.pdf}. In previous examples, the templates provided text-based data for Pollen to write into a destination file. In this case, we're providing binary data (which Pollen will handle correctly.) If the template wrote to @filepath{cv.pdf} directly and returned @racket[void], it would be treated as an error.
+ super-duper ◊sauce-type sauce In fact, because Pollen handles binary files equally well, you could use it to make, say, an audio rendering of a source file. But that will be left as an exercise to you, dear reader.
+ at least ◊nugget-quantity ◊nugget-type nuggets}} @section[#:tag "raco-pollen-render-poly"]{Using @exec{raco pollen render} with @tt{poly} sources}
Reload the file in the project server, and you'll see the imported values: Poly source files work as usual with @exec{@seclink["raco_pollen_render"]}.
@nested[#:style 'code-inset]{@verbatim{ You can give it the name of an output file, and it will figure out that a poly source file should be used:
My name is _Dale_, and I enjoy:
+ super-duper fancy sauce @terminal{
> raco pollen render cv.pdf
rendering: /cv.poly.pm as /cv.pdf}
+ at least 12 chicken nuggets}} @terminal{
> raco pollen render cv.txt
rendering: /cv.poly.pm as /cv.txt}
If you give it the name of a poly source file without further specification, it will generate output using the first format on your list of @racket[poly-targets] (in this case HTML):
@margin-note{Those familiar with Racket know that Racket makes you explicitly @racket[provide] any variables you want to export. To make life simpler, Pollen inverts this behavior and automatically exports all defined symbols using @racket[(provide (all-defined-out))]. For more about the differences in behavior between Racket and Pollen, see @secref["File_formats" #:doc '(lib "pollen/scribblings/pollen.scrbl")].} @terminal{
> raco pollen render cv.poly.pm
rendering: /cv.poly.pm as /cv.html}
To generate output from a poly source for a particular target, use the @exec{-t} or @exec{--target} flag to specify:
@terminal{
> raco pollen render -t txt cv.poly.pm
rendering: /cv.poly.pm as /cv.txt}
@terminal{
> raco pollen render --target pdf cv.poly.pm
rendering: /cv.poly.pm as /cv.pdf}
@section{Fourth tutorial complete}
True, I originally designed Pollen with HTML output in mind. But this tutorial gives you a sense of how its model for converting source files to output files is flexible and open-ended. If you're not afraid of a little programming — made easier by having all the facilities of Racket available within your project — you can generate any text or binary output from a Pollen source file.

@ -779,7 +779,7 @@ barticle.html.pmd
You also probably noticed that the files are in a different order than they were in the automatic pagetree: @filepath{carticle.html} is first, followed by @filepath{article.html} and then @filepath{barticle.html}. This too is deliberate, so we can see what happens with a differently ordered pagetree. You also probably noticed that the files are in a different order than they were in the automatic pagetree: @filepath{carticle.html} is first, followed by @filepath{article.html} and then @filepath{barticle.html}. This too is deliberate, so we can see what happens with a differently ordered pagetree.
Pagetrees don't change nearly as often as other source files, so as a performance optimization, the project server does @italic{not} dynamically reflect changes to pagetrees. To see the effect of this new pagetree on our project, you'll need to go to your terminal window and stop the project server with @onscreen{Ctrl+C}, and then restart it. Which will take all of three seconds. Pagetrees don't change as often as other source files, so as a performance optimization, the project server doesn't automatically reload pagetrees when they change. To trigger a reload of the pagetree, you have two options. You can either go to your terminal window and stop the project server with @onscreen{Ctrl+C}, and then restart it. Or, if you make a change to a source file that relies on the pagetree (in this case, one of the @filepath{pmd} source files), the pagetree will be reloaded.
Now refresh @filepath{carticle.html}. You'll notice that the navigation links are different. You won't see a previous-page link — because @filepath{carticle.html} is now the first page in the pagetree — and the next page will show up as @filepath{article.html}. Click through to @filepath{article.html}, and you'll see the navigation likewise updated. Click through to @filepath{barticle.html}, and you'll see ... Now refresh @filepath{carticle.html}. You'll notice that the navigation links are different. You won't see a previous-page link — because @filepath{carticle.html} is now the first page in the pagetree — and the next page will show up as @filepath{article.html}. Click through to @filepath{article.html}, and you'll see the navigation likewise updated. Click through to @filepath{barticle.html}, and you'll see ...

@ -1113,8 +1113,5 @@ OK, that was a humongous tutorial. Congratulations on making it through.
But your reward is that you now understand all the core concepts of the Pollen publishing system, including the most important ones: the flexibility of Pollen markup, and the connection between tags and functions. But your reward is that you now understand all the core concepts of the Pollen publishing system, including the most important ones: the flexibility of Pollen markup, and the connection between tags and functions.
Armed with this knowledge, you have everything you need to start doing useful things with Pollen. I hope you enjoy using it as much as I've enjoyed making it!

@ -25,6 +25,8 @@ A parameter that holds the root directory of the current project (e.g., the dire
@defparam[world:current-server-extras-path dir path?]{ @defparam[world:current-server-extras-path dir path?]{
A parameter that reports the path to the directory of support files for the project server. Initialized to @racket[#f], but set to a proper value when the server runs.} A parameter that reports the path to the directory of support files for the project server. Initialized to @racket[#f], but set to a proper value when the server runs.}
@defparam[world:current-poly-target target symbol??]{
A parameter that reports the current rendering target for @racket[poly] source files. Initialized to @racket['html].}
@section[#:tag "settable-values"]{Settable values} @section[#:tag "settable-values"]{Settable values}
@ -129,3 +131,9 @@ Default separators used in decoding. The first two are initialized to @racket["\
@defoverridable[unpublished-path? (path? . -> . boolean?)]{Predicate that determines whether a path is omitted from @secref{raco_pollen_publish} operations. If the predicate is @racket[#t], then the path is omitted. The default, therefore, is @racket[#f].} @defoverridable[unpublished-path? (path? . -> . boolean?)]{Predicate that determines whether a path is omitted from @secref{raco_pollen_publish} operations. If the predicate is @racket[#t], then the path is omitted. The default, therefore, is @racket[#f].}
@defoverridable[here-path-key symbol?]{Key used to store the absolute path of the current source file in its @racket[metas] hashtable. Default is @racket['here-path].} @defoverridable[here-path-key symbol?]{Key used to store the absolute path of the current source file in its @racket[metas] hashtable. Default is @racket['here-path].}
@defoverridable[poly-source-ext symbol?]{Extension that indicates a source file can target multiple output types. Default is @racket['poly].}
@defoverridable[poly-targets (listof symbol?)]{List of symbols that denotes the possible targets of a @racket['poly] source file. Default is @racket['(html)].}

@ -1 +1 @@
◊doc (format "~a" doc)

@ -33,7 +33,7 @@
(define/contract (string->request u) (define/contract (string->request u)
(string? . -> . request?) (string? . -> . request?)
(make-request #"GET" (string->url u) empty (make-request #"GET" (string->url u) empty
(delay empty) #f "1.2.3.4" 80 "4.3.2.1")) (delay empty) #f "1.2.3.4" 80 "4.3.2.1"))
;; print message to console about a request ;; print message to console about a request
(define/contract (logger req) (define/contract (logger req)
@ -84,8 +84,8 @@
(p "filename =" ,(->string relative-path)) (p "filename =" ,(->string relative-path))
(p "size = " ,(bytecount->string (file-size path))) (p "size = " ,(bytecount->string (file-size path)))
,@(when/splice (not (equal? (get-ext path) "svg")) ,@(when/splice (not (equal? (get-ext path) "svg"))
`(p "width = " ,(->string (image-width img)) " " `(p "width = " ,(->string (image-width img)) " "
"height = " ,(->string (image-height img)))) "height = " ,(->string (image-height img))))
(a ((href ,img-url)) (img ((style "width:100%;border:1px solid #eee")(src ,img-url)))))) (a ((href ,img-url)) (img ((style "width:100%;border:1px solid #eee")(src ,img-url))))))
(require file/unzip) (require file/unzip)
@ -140,58 +140,90 @@
(match-define (cons href text) href+text) (match-define (cons href text) href+text)
(filter-not void? `(td ,(when text (filter-not void? `(td ,(when text
(if href (if href
`(a ((href ,href)) ,text) `(a ((href ,href)) ,text)
text))))) text)))))
(define (make-parent-row) (define (make-parent-row)
(define title (string-append "Project root" (if (equal? (world:current-project-root) dashboard-dir) (format " = ~a" dashboard-dir) ""))) (define title (string-append "Project root" (if (equal? (world:current-project-root) dashboard-dir) (format " = ~a" dashboard-dir) "")))
(define dirs (cons title (if (not (equal? (world:current-project-root) dashboard-dir)) (define dirs (cons title (if (not (equal? (world:current-project-root) dashboard-dir))
(explode-path (find-relative-path (world:current-project-root) dashboard-dir)) (explode-path (find-relative-path (world:current-project-root) dashboard-dir))
null))) null)))
(define dirlinks (cons "/" (map (λ(ps) (format "/~a/" (apply build-path ps))) (define dirlinks (cons "/" (map (λ(ps) (format "/~a/" (apply build-path ps)))
(for/list ([i (in-range (length (cdr dirs)))]) (for/list ([i (in-range (length (cdr dirs)))])
(take (cdr dirs) (add1 i)))))) (take (cdr dirs) (add1 i))))))
`(tr (th ((colspan "3")) ,@(add-between (map (λ(dir dirlink) `(a ((href ,(format "~a~a" dirlink (world:current-default-pagetree)))) ,(->string dir))) dirs dirlinks) "/")))) `(tr (th ((colspan "3")) ,@(add-between (map (λ(dir dirlink) `(a ((href ,(format "~a~a" dirlink (world:current-default-pagetree)))) ,(->string dir))) dirs dirlinks) "/"))))
(define (make-path-row filename-path) (define (make-path-row filename source)
(define filename (->string filename-path))
(define possible-source (->source-path (build-path dashboard-dir filename-path)))
(define source (and possible-source (->string (find-relative-path dashboard-dir possible-source))))
`(tr ,@(map make-link-cell `(tr ,@(map make-link-cell
(append (list (append (list
(cond ; main cell (cond ; main cell
[(directory-exists? (build-path dashboard-dir filename)) ; links subdir to its dashboard [(directory-exists? (build-path dashboard-dir filename)) ; links subdir to its dashboard
(cons (format "~a/~a" filename (world:current-default-pagetree)) (format "~a/" filename))] (cons (format "~a/~a" filename (world:current-default-pagetree)) (format "~a/" filename))]
[(and source (equal? (get-ext source) "scrbl")) [(and source (equal? (get-ext source) "scrbl")) ; scribble source
(cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) " (from " ,(->string (find-relative-path dashboard-dir source)) ")")))] (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) " (from " ,(->string (find-relative-path dashboard-dir source)) ")")))]
;; use remove-ext because source may have escaped extension in it [source ; ordinary source. use remove-ext because source may have escaped extension in it
[source (cons #f `(a ((href ,filename)) ,(->string (remove-ext source)) (span ((class "file-ext")) "." ,(get-ext source))))] (define source-first-ext (get-ext source))
[else (cons filename filename)]) (define source-minus-ext (unescape-ext (remove-ext source)))
(define source-second-ext (get-ext source-minus-ext))
(cond ; in cell (cond ; multi source. expand to multiple output files.
[source (cons (format "in/~a" source) "in")] [(and source-second-ext (equal? source-second-ext (->string (world:current-poly-source-ext (->complete-path source)))))
[(or (pagetree-source? filename) (sourceish? filename)) (cons (format "in/~a" filename) "in")] (define source-base (remove-ext source-minus-ext))
[else empty-cell]) (define output-names (map (λ(ext) (->string (add-ext source-base ext))) (world:current-poly-targets (->complete-path source))))
(cons #f `(span ,@(map (λ(on) `(a ((href ,on)) ,on (span ((class "file-ext")) "." ,source-first-ext ,(format " (from ~a)" (->string (find-relative-path dashboard-dir source)))))) output-names)))]
(cond ; out cell [else
[(directory-exists? (build-path dashboard-dir filename)) (cons #f #f)] (define extra-row-string
[(pagetree-source? filename) empty-cell] (if (equal? source-minus-ext (remove-ext source)) ; escaped and unescaped versions are equal
[else (cons (format "out/~a" filename) "out")])))))) "" ; no extra string needed
(format " (from ~a)" (->string (find-relative-path dashboard-dir source)))))
(cons #f `(a ((href ,filename)) ,(->string source-minus-ext) (span ((class "file-ext")) "." ,source-first-ext ,extra-row-string)))])]
[else ; other non-source file
(cons filename filename)])
(cond ; 'in' cell
[source (cons (format "in/~a" source) "in")]
[(or (pagetree-source? filename) (sourceish? filename)) (cons (format "in/~a" filename) "in")]
[else empty-cell])
(cond ; 'out' cell
[(directory-exists? (build-path dashboard-dir filename)) (cons #f #f)]
[(pagetree-source? filename) empty-cell]
[else (cons (format "out/~a" filename) "out")]))))))
(define (ineligible-path? x) (member x (world:current-paths-excluded-from-dashboard))) (define (ineligible-path? x) (member x (world:current-paths-excluded-from-dashboard)))
(define project-paths (define project-paths
(filter-not ineligible-path? (map ->path (pagetree->list (filter-not ineligible-path? (map ->path (pagetree->list
(if (file-exists? dashboard-ptree) (with-handlers ([exn:fail:contract? (λ _ (directory->pagetree dashboard-dir))])
(cached-require (->path dashboard-ptree) (world:current-main-export)) (cached-require (->path dashboard-ptree) (world:current-main-export)))))))
(directory->pagetree dashboard-dir))))))
(body-wrapper #:title (format "~a" dashboard-dir) (body-wrapper #:title (format "~a" dashboard-dir)
`(table `(table
,@(cons (make-parent-row) ,@(cons (make-parent-row)
(if (not (null? project-paths)) (cond
(map make-path-row project-paths) [(not (null? project-paths))
(list '(tr (td ((class "no-files")) "No files yet in this directory") (td) (td)))))))) (define path-source-pairs
(map
(λ(p) (define source
(let ([possible-source (->source-path (build-path dashboard-dir p))])
(and possible-source (->string (find-relative-path dashboard-dir possible-source)))))
(cons p source))
project-paths))
(define-values (reversed-unique-path-source-pairs seen-paths) ; delete pairs with duplicate sources
(for/fold ([psps empty][seen-source-paths empty])
([psp (in-list path-source-pairs)])
(define source-path (cdr psp))
(if (and source-path (member source-path seen-source-paths))
(values psps seen-source-paths) ; skip the pair
(values (cons psp psps) (cons source-path seen-source-paths)))))
(define unique-path-source-pairs (reverse reversed-unique-path-source-pairs))
(define filenames (map (compose1 ->string car) unique-path-source-pairs))
(define sources (map cdr unique-path-source-pairs))
(parameterize ([current-directory dashboard-dir])
(map make-path-row filenames sources))]
[else (list '(tr (td ((class "no-files")) "No files yet in this directory") (td) (td)))])))))
(define route-dashboard (route-wrapper dashboard)) (define route-dashboard (route-wrapper dashboard))
@ -208,8 +240,8 @@
(define base (world:current-project-root)) (define base (world:current-project-root))
(define file (url->path (request-uri req))) (define file (url->path (request-uri req)))
(if (eq? (system-path-convention-type) 'windows) (if (eq? (system-path-convention-type) 'windows)
(build-path base file) ; because url->path returns a relative path for 'windows (build-path base file) ; because url->path returns a relative path for 'windows
(reroot-path file base))) ; and a complete path for 'unix (reroot-path file base))) ; and a complete path for 'unix
;; default route ;; default route
(define (route-default req) (define (route-default req)

@ -0,0 +1,18 @@
#lang racket/base
(require pollen/world)
(provide (all-defined-out))
(module config racket/base
(provide (all-defined-out))
(define poly-targets '(html txt))
(define compile-cache-active #f))
(define (heading . xs)
(case (world:current-poly-target)
[(txt) (map string-upcase xs)]
[else `(h2 ,@xs)]))
(define (emph . xs)
(case (world:current-poly-target)
[(txt) `("**" ,@xs "**")]
[else `(strong ,@xs)]))

@ -0,0 +1 @@
◊(format "~v" doc)

@ -0,0 +1,2 @@
◊(local-require racket/list)
◊(apply string-append (filter string? (flatten doc)))

@ -0,0 +1,2 @@
#lang pollen
heading{title} is emph{big}

@ -1 +1,2 @@
◊(format "~a" doc) ◊(local-require racket/list)
◊(apply string-append (filter string? (flatten doc)))

@ -0,0 +1,14 @@
#lang at-exp racket/base
(require rackunit pollen/world racket/runtime-path pollen/render)
;; define-runtime-path only allowed at top level
(define-runtime-path poly-dir "data/poly")
(define-runtime-path poly-source "data/poly/test.poly.pm")
(parameterize ([current-directory poly-dir]
[world:current-project-root poly-dir]
[current-output-port (open-output-string)])
(parameterize ([world:current-poly-target 'txt])
(check-equal? (render poly-source) "TITLE is **big**"))
(parameterize ([world:current-poly-target 'html])
(check-equal? (render poly-source) (format "~v" '(root (h2 "title") " is " (strong "big"))))))

@ -23,7 +23,7 @@
(define (id) "first")} pollen.rkt #:exists 'replace) (define (id) "first")} pollen.rkt #:exists 'replace)
(render-to-file-if-needed markup.txt.pm) (render-to-file-if-needed markup.txt.pm)
(check-equal? (file->string markup.txt) "(root first)") (check-equal? (file->string markup.txt) "first")
(render-to-file-if-needed pre.txt.pp) (render-to-file-if-needed pre.txt.pp)
(check-equal? (file->string pre.txt) "first") (check-equal? (file->string pre.txt) "first")
@ -33,7 +33,7 @@
(define (id) "second")} pollen.rkt #:exists 'replace) (define (id) "second")} pollen.rkt #:exists 'replace)
(render-to-file-if-needed markup.txt.pm) (render-to-file-if-needed markup.txt.pm)
(check-equal? (file->string markup.txt) "(root second)") (check-equal? (file->string markup.txt) "second")
(render-to-file-if-needed pre.txt.pp) (render-to-file-if-needed pre.txt.pp)
(check-equal? (file->string pre.txt) "second")) (check-equal? (file->string pre.txt) "second"))

@ -105,3 +105,7 @@
(define-settable unpublished-path? (λ(path) #f)) (define-settable unpublished-path? (λ(path) #f))
(define-settable here-path-key 'here-path) (define-settable here-path-key 'here-path)
(define-settable poly-source-ext 'poly) ; extension that signals source can be used for multiple output targets
(define-settable poly-targets '(html)) ; current target applied to multi-output source files
(define current-poly-target (make-parameter (car (current-poly-targets))))
Loading…
Cancel
Save