add runtime overrides to pollen/world (closes #60)

pull/84/head
Matthew Butterick 9 years ago
parent 6555af92e8
commit 0f396471e9

@ -7,7 +7,7 @@
(provide reset-cache current-cache make-cache cached-require cache-ref)
(define (get-cache-file-path)
(build-path (world:current-project-root) world:cache-filename))
(build-path (world:current-project-root) (world:get-cache-filename)))
(define (make-cache)
(define cache-file-path (get-cache-file-path))
@ -37,16 +37,16 @@
(hash-set! (current-cache) path (make-hash))
(define cache-hash (cache-ref path))
(hash-set! cache-hash 'mod-time (file-or-directory-modify-seconds path))
(hash-set! cache-hash world:main-pollen-export (dynamic-require path world:main-pollen-export))
(hash-set! cache-hash world:meta-pollen-export (dynamic-require path world:meta-pollen-export))
(hash-set! cache-hash (world:get-main-export) (dynamic-require path (world:get-main-export)))
(hash-set! cache-hash (world:get-meta-export) (dynamic-require path (world:get-meta-export)))
(write-to-file (serialize (current-cache)) (get-cache-file-path) #:exists 'replace)
(void))
(define (cached-require path-string key)
(when (not (current-cache)) (error "cached-require: No cache set up."))
(when (not (current-cache)) (error 'cached-require "No cache set up."))
(define path
(with-handlers ([exn:fail? (λ(exn) (error (format "cached-require: ~a is not a valid path" path-string)))])
(with-handlers ([exn:fail? (λ(exn) (error 'cached-require (format "~a is not a valid path" path-string)))])
(->complete-path path-string)))
(when (not (file-exists? path)) (error (format "cached-require: ~a does not exist" (path->string path))))

@ -18,7 +18,12 @@ render [dir] [dest] render project in dir (default is current dir)
render filename render filename only (can be source or output name)
publish copy project to desktop without source files
publish [dir] [dest] copy project in dir to dest without source files
(warning: overwrites existing dest dir)" ,(world:current-server-port))))
(warning: overwrites existing dest dir)
version print the version (~a)" ,(world:current-server-port) ,(world:get-pollen-version))))
(define (handle-version)
`(displayln ,(world:get-pollen-version)))
(define (handle-render path-args)
@ -64,7 +69,7 @@ publish [dir] [dest] copy project in dir to dest without source files
(define (handle-publish directory rest-args arg-command-name)
(define target-path (or
(and rest-args (not (null? rest-args)) (path->complete-path (string->path (car rest-args))))
(build-path (find-system-path 'desk-dir) (string->path (if (equal? arg-command-name "clone") "clone" world:publish-directory-name)))))
(build-path (find-system-path 'desk-dir) (string->path (if (equal? arg-command-name "clone") "clone" (world:get-publish-directory-name))))))
`(begin
(require racket/file pollen/file racket/list)

@ -12,7 +12,7 @@
(cond
[(and p-breaks (txexpr? x) (equal? (car x) 'p) (apply string-append `("\n" ,@(map ->string (map loop (get-elements x))) "\n")))]
[(txexpr? x) (apply string-append
(map ->string `(,world:command-marker ,(get-tag x)
(map ->string `(,(world:get-command-char) ,(get-tag x)
,@(if (not (null? (get-attrs x))) `("[" ,(attrs->pollen (get-attrs x)) "]") null)
,@(if (not (null? (get-elements x))) `("{" ,@(map loop (get-elements x)) "}" ) null))))]
[(symbol? x) (loop (entity->integer x))]

@ -280,7 +280,7 @@
;; turn the right items into <br> tags
(define+provide/contract (detect-linebreaks xc
#:separator [newline world:linebreak-separator]
#:separator [newline (world:get-linebreak-separator)]
#:insert [linebreak '(br)])
((txexpr-elements?) (#:separator string? #:insert xexpr?) . ->* . txexpr-elements?)
;; todo: should this test be not block + not whitespace?
@ -334,7 +334,7 @@
;; is x a paragraph break?
(define+provide/contract (paragraph-break? x #:separator [sep world:paragraph-separator])
(define+provide/contract (paragraph-break? x #:separator [sep (world:get-paragraph-separator)])
((any/c) (#:separator pregexp?) . ->* . coerce/boolean?)
(define paragraph-pattern (pregexp (format "^~a+$" sep)))
(and (string? x) (regexp-match paragraph-pattern x)))
@ -342,7 +342,7 @@
(define (newline? x)
(and (string? x) (equal? world:newline x)))
(and (string? x) (equal? (world:get-newline) x)))
(define (not-newline? x)
(not (newline? x)))
@ -379,7 +379,7 @@
;; detect paragraphs
;; todo: unit tests
(define+provide/contract (detect-paragraphs elements #:tag [tag 'p]
#:separator [sep world:paragraph-separator]
#:separator [sep (world:get-paragraph-separator)]
#:linebreak-proc [linebreak-proc detect-linebreaks]
#:force? [force-paragraph #f])
((txexpr-elements?) (#:tag symbol? #:separator string? #:linebreak-proc (txexpr-elements? . -> . txexpr-elements?) #:force? boolean?)

@ -50,7 +50,7 @@
(syntax-case stx ()
[(_ stem)
(let ([stem-datum (syntax->datum #'stem)])
(with-syntax ([file-ext (format-id stx "world:~a-source-ext" #'stem)]
(with-syntax ([world:get-stem-source-ext (format-id stx "world:get-~a-source-ext" #'stem)]
[stem-source? (format-id stx "~a-source?" #'stem)]
[get-stem-source (format-id stx "get-~a-source" #'stem)]
[has-stem-source? (format-id stx "has-~a-source?" #'stem)]
@ -60,7 +60,7 @@
#`(begin
;; does file have particular extension
(define+provide (stem-source? x)
(->boolean (and (pathish? x) (has-ext? (->path x) file-ext))))
(->boolean (and (pathish? x) (has-ext? (->path x) (world:get-stem-source-ext)))))
(define+provide (get-stem-source x)
(and (pathish? x)
@ -82,9 +82,9 @@
x
#,(if (equal? stem-datum 'scribble)
#'(if (x . has-ext? . 'html) ; different logic for scribble sources
(add-ext (remove-ext* x) file-ext)
(add-ext (remove-ext* x) (world:get-stem-source-ext))
#f)
#'(add-ext x file-ext))))
#'(add-ext x (world:get-stem-source-ext)))))
(and result (->path result)))
;; coerce either a source or output file to both
@ -111,8 +111,8 @@
(make-source-utility-functions pagetree)
(module-test-external
(require pollen/world)
(check-true (pagetree-source? (format "foo.~a" world:pagetree-source-ext)))
(check-false (pagetree-source? (format "~a.foo" world:pagetree-source-ext)))
(check-true (pagetree-source? (format "foo.~a" (world:get-pagetree-source-ext))))
(check-false (pagetree-source? (format "~a.foo" (world:get-pagetree-source-ext))))
(check-false (pagetree-source? #f)))
(make-source-utility-functions markup)
@ -177,7 +177,7 @@
(or (ends-with? (path->string path) "compiled"))))
(define+provide (cache-file? path)
(or (ends-with? (path->string path) world:cache-filename)))
(or (ends-with? (path->string path) (world:get-cache-filename))))
(define+provide (pollen-related-file? file)

@ -7,4 +7,4 @@
(define scribblings '(("scribblings/pollen.scrbl" (multi-page))))
(define raco-commands '(("pollen" (submod pollen/raco main) "issue Pollen command" #f)))
(define compile-omit-paths '("tests" "raco.rkt"))
(define test-omit-paths '("test-support"))
(define test-omit-paths '("tests/data"))

@ -1,5 +1,5 @@
#lang racket/base
(require (for-syntax racket/base racket/syntax) pollen/world)
(require (for-syntax racket/base racket/syntax pollen/world) pollen/world)
(provide (all-defined-out) (all-from-out pollen/world))
@ -13,54 +13,59 @@
(define-syntax (new-module-begin stx-arg)
(syntax-case stx-arg ()
[(_ body-exprs (... ...))
(syntax-protect
#'(#%module-begin
(module inner pollen/doclang-raw
;; doclang_raw is a version of scribble/doclang with the decoder disabled
;; first three lines are positional arguments for doclang-raw
doc-raw ; id of export
(λ(x) x) ; post-process function
() ; prepended exprs
(with-syntax ([local-meta-tag-name (format-id stx-arg (symbol->string (world:get-meta-tag-name)))]
[local-doc-export-name (format-id stx-arg (symbol->string (world:get-main-export)))]
[local-metas-export-name (format-id stx-arg (symbol->string (world:get-meta-export)))])
(syntax-protect
#'(#%module-begin
(module inner pollen/doclang-raw
;; doclang_raw is a version of scribble/doclang with the decoder disabled
;; first three lines are positional arguments for doclang-raw
doc-raw ; id of export
(λ(x) x) ; post-process function
() ; prepended exprs
;; Change behavior of undefined identifiers with #%top
;; Get project values from world
(require pollen/top pollen/world)
(provide (all-defined-out) (all-from-out pollen/top pollen/world))
body-exprs (... ...))
;; Change behavior of undefined identifiers with #%top
;; Get project values from world
(require pollen/top pollen/world)
(provide (all-defined-out) (all-from-out pollen/top pollen/world))
(require 'inner racket/list pollen/metas)
body-exprs (... ...))
(require 'inner racket/list pollen/metas)
;; in an inline module, reader-here-path and parser-mode are undefined
;; (because there's no reader)
;; but they'll become tag functions courtesy of #%top
;; so that's how we can detect if they are undefined
(define here-path (if (procedure? inner:reader-here-path)
"anonymous-module"
inner:reader-here-path))
(define parser-mode (if (procedure? inner:parser-mode)
mode-arg
inner:parser-mode))
(define doc-with-metas
`(placeholder-root
,@(cons (meta 'here-path: here-path)
(if (list? doc-raw)
(dropf doc-raw (λ(i) (equal? i "\n"))) ; discard all newlines at front of file
doc-raw))))
(define-values (doc-without-metas metas) (split-metas-to-hash doc-with-metas)) ; split out the metas
;; set up the 'doc export
(require pollen/decode)
(define doc (apply (cond
[(equal? parser-mode world:mode-pagetree) (λ xs ((dynamic-require 'pollen/pagetree 'decode-pagetree) xs))]
;; 'root is the hook for the decoder function.
;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...)
[(equal? parser-mode world:mode-markup) root]
[(equal? parser-mode world:mode-markdown) (λ xs (apply root (apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) (map to-string xs))))]
;; for preprocessor output, just make a string.
[else (λ xs (apply string-append (map to-string xs)))]) ; default mode is preprocish
(cdr doc-without-metas))) ;; cdr strips placeholder-root tag
;; hide the exports that were only for internal use.
(provide metas doc (except-out (all-from-out 'inner) doc-raw #%top))))]))))]))
;; in an inline module, reader-here-path and parser-mode are undefined
;; (because there's no reader)
;; but they'll become tag functions courtesy of #%top
;; so that's how we can detect if they are undefined
(define here-path (if (procedure? inner:reader-here-path)
"anonymous-module"
inner:reader-here-path))
(define parser-mode (if (procedure? inner:parser-mode)
mode-arg
inner:parser-mode))
(define doc-with-metas
`(placeholder-root
,@(cons `(local-meta-tag-name (here-path ,here-path))
(if (list? doc-raw)
(dropf doc-raw (λ(i) (equal? i "\n"))) ; discard all newlines at front of file
doc-raw))))
(define-values (doc-without-metas metas) (split-metas-to-hash doc-with-metas)) ; split out the metas
;; set up the 'doc export
(require pollen/decode)
(define doc (apply (cond
[(equal? parser-mode world:mode-pagetree) (λ xs ((dynamic-require 'pollen/pagetree 'decode-pagetree) xs))]
;; 'root is the hook for the decoder function.
;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...)
[(equal? parser-mode world:mode-markup) root]
[(equal? parser-mode world:mode-markdown) (λ xs (apply root (apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) (map to-string xs))))]
;; for preprocessor output, just make a string.
[else (λ xs (apply string-append (map to-string xs)))]) ; default mode is preprocish
(cdr doc-without-metas))) ;; cdr strips placeholder-root tag
;; hide the exports that were only for internal use.
(provide (rename-out [metas local-metas-export-name])
(rename-out [doc local-doc-export-name])
(except-out (all-from-out 'inner) doc-raw #%top)))))]))))]))

@ -9,7 +9,7 @@
(define (possible-meta-element? x)
(and (txexpr? x) (equal? world:meta-tag-name (get-tag x))))
(and (txexpr? x) (equal? (world:get-meta-tag-name) (get-tag x))))
(define (trivial-meta-element? x)
@ -47,10 +47,11 @@
(or (and (list? x) (symbol? (first x)) (string? (second x)))
(error 'is-meta-element? "error: meta must be a symbol / string pair, instead got: ~v" x)))
;; all metas are converted into "atomic meta" format
;; which is '(meta (key value ...))
(define (make-atomic-meta key . values)
`(meta (,key ,@values)))
`(,(world:get-meta-tag-name) (,key ,@values)))
(define (explode-meta-element me)
@ -62,10 +63,10 @@
(cond
[(has-meta-attrs me) ; might have txexpr elements, so preserve them
(define attrs (get-attrs me))
(loop (make-txexpr 'meta (cdr attrs) (get-elements me)) (cons (apply make-atomic-meta (car attrs)) acc))]
(loop (make-txexpr (world:get-meta-tag-name) (cdr attrs) (get-elements me)) (cons (apply make-atomic-meta (car attrs)) acc))]
[else ; has txexpr elements, but not meta-attrs
(define txexpr-elements (get-elements me)) ; elements were filtered for txexpr at loop entry
(loop (make-txexpr 'meta null (cdr txexpr-elements)) (cons (apply make-atomic-meta (car txexpr-elements)) acc))])]
(loop (make-txexpr (world:get-meta-tag-name) null (cdr txexpr-elements)) (cons (apply make-atomic-meta (car txexpr-elements)) acc))])]
[else (reverse acc)])))

@ -38,7 +38,7 @@
(define+provide/contract (decode-pagetree xs)
(txexpr-elements? . -> . any/c) ; because pagetree is being explicitly validated
(validate-pagetree
(decode (cons world:pagetree-root-node xs)
(decode (cons (world:get-pagetree-root-node) xs)
#:txexpr-elements-proc (λ(xs) (filter (compose1 not whitespace?) xs))
#:string-proc string->symbol))) ; because faster than ->pagenode
@ -85,8 +85,8 @@
(define+provide/contract (make-project-pagetree project-dir)
(pathish? . -> . pagetree?)
(with-handlers ([exn:fail? (λ(exn) (directory->pagetree project-dir))])
(define pagetree-source (build-path project-dir world:default-pagetree))
(cached-require pagetree-source world:main-pollen-export)))
(define pagetree-source (build-path project-dir (world:get-default-pagetree)))
(cached-require pagetree-source (world:get-main-export))))
(define+provide/contract (parent pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?))

@ -35,6 +35,7 @@
[(#f "help") (handle-help)]
[("start") (handle-start (path->directory-path first-arg-or-current-dir) port-arg)]
[("render") (handle-render (cons first-arg-or-current-dir (map very-nice-path (cdr (vector->list (current-command-line-arguments))))))]
[("version") (handle-version)]
[("clone" "publish") (handle-publish first-arg-or-current-dir rest-args arg-command-name)]
[else (handle-else arg-command-name)]))))

@ -14,9 +14,9 @@
(λ (path-string p)
(define read-inner (make-at-reader
#:command-char (if (or (equal? reader-mode world:mode-template)
(and (string? path-string) (regexp-match (pregexp (format "\\.~a$" world:template-source-ext)) path-string)))
world:template-command-marker
world:command-marker)
(and (string? path-string) (regexp-match (pregexp (format "\\.~a$" (world:get-template-source-ext))) path-string)))
(world:get-template-command-char)
(world:get-command-char))
#:syntax? #t
#:inside? #t))
(define file-contents (read-inner path-string p))
@ -33,9 +33,9 @@
(let* ([file-ext-pattern (pregexp "\\w+$")]
[here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))])
(cond
[(equal? here-ext world:pagetree-source-ext) world:mode-pagetree]
[(equal? here-ext world:markup-source-ext) world:mode-markup]
[(equal? here-ext world:markdown-source-ext) world:mode-markdown]
[(equal? here-ext (world:get-pagetree-source-ext)) world:mode-pagetree]
[(equal? here-ext (world:get-markup-source-ext)) world:mode-markup]
[(equal? here-ext (world:get-markdown-source-ext)) world:mode-markdown]
[else world:mode-preproc]))
reader-mode))
;; change names of exports for local use
@ -52,9 +52,9 @@
(module+ main
(require txexpr racket/string)
(if (or (equal? inner:parser-mode world:mode-preproc) (equal? inner:parser-mode world:mode-template))
(display doc)
(display ,(world:get-main-export))
(print (with-handlers ([exn:fail? (λ(exn) ((error '|pollen markup error| (string-join (cdr (string-split (exn-message exn) ": ")) ": "))))])
(validate-txexpr doc))))))
(validate-txexpr ,(world:get-main-export)))))))
file-contents)))

@ -34,7 +34,7 @@
(module-test-internal
(require racket/runtime-path)
(define-runtime-path sample-dir "test-support/samples")
(define-runtime-path sample-dir "test/data/samples")
(define samples (parameterize ([current-directory sample-dir])
(map path->complete-path (directory-list "."))))
(define-values (sample-01 sample-02 sample-03) (apply values samples))
@ -89,7 +89,7 @@
((or/c pagetree? pathish?) . -> . void?)
(define pagetree (if (pagetree? pagetree-or-path)
pagetree-or-path
(cached-require pagetree-or-path world:main-pollen-export)))
(cached-require pagetree-or-path (world:get-main-export))))
(parameterize ([current-directory (world:current-project-root)])
(for-each render-from-source-or-output-path (map ->complete-path (pagetree->list pagetree)))))
@ -177,7 +177,7 @@
(file-needed-rerequire? source-path) ; called for its reqrequire side effect only, so dynamic-require below isn't cached
(time (parameterize ([current-directory (->complete-path source-dir)])
;; BTW this next action has side effects: scribble will copy in its core files if they don't exist.
((dynamic-require 'scribble/render 'render) (list (dynamic-require source-path world:main-pollen-export)) (list source-path))))
((dynamic-require 'scribble/render 'render) (list (dynamic-require source-path (world:get-main-export))) (list source-path))))
(define result (file->string (->output-path source-path)))
(delete-file (->output-path source-path)) ; because render promises the data, not the side effect
result)
@ -187,7 +187,7 @@
(complete-path? . -> . (or/c string? bytes?))
(match-define-values (source-dir _ _) (split-path source-path))
(time (parameterize ([current-directory (->complete-path source-dir)])
(render-through-eval `(begin (require pollen/cache)(cached-require ,source-path ',world:main-pollen-export))))))
(render-through-eval `(begin (require pollen/cache)(cached-require ,source-path ',(world:get-main-export)))))))
(define/contract (render-markup-or-markdown-source source-path [maybe-template-path #f])
@ -200,14 +200,14 @@
(require (for-syntax racket/base))
(require pollen/include-template pollen/cache pollen/debug)
,(require-directory-require-files source-path)
(let ([doc (cached-require ,(path->string source-path) ',world:main-pollen-export)]
[metas (cached-require ,(path->string source-path) ',world:meta-pollen-export)])
(let ([,(world:get-main-export) (cached-require ,(path->string source-path) ',(world:get-main-export))]
[,(world:get-meta-export) (cached-require ,(path->string source-path) ',(world:get-meta-export))])
(local-require pollen/pagetree pollen/template pollen/top)
(define here (metas->here metas))
(define here (metas->here ,(world:get-meta-export)))
(cond
[(bytes? doc) doc] ; if doc is binary, just pass it through
[(bytes? ,(world:get-main-export)) ,(world:get-main-export)] ; if main export is binary, just pass it through
[else
(include-template #:command-char ,world:command-marker (file ,(->string (find-relative-path source-dir template-path))))]))))
(include-template #:command-char ,(world:get-command-char) (file ,(->string (find-relative-path source-dir template-path))))]))))
(time (parameterize ([current-directory source-dir]) ; because include-template wants to work relative to source location
(render-through-eval expr-to-eval))))
@ -227,12 +227,12 @@
(filter (λ(x) (->boolean x)) ; if any of the possibilities below are invalid, they return #f
(list
(parameterize ([current-directory (world:current-project-root)])
(let ([source-metas (cached-require source-path 'metas)])
(and ((->symbol world:template-meta-key) . in? . source-metas)
(build-path source-dir (select-from-metas (->string world:template-meta-key) source-metas))))) ; path based on metas
(let ([source-metas (cached-require source-path (world:get-meta-export))])
(and ((->symbol (world:get-template-meta-key)) . in? . source-metas)
(build-path source-dir (select-from-metas (->string (world:get-template-meta-key)) source-metas))))) ; path based on metas
(and (filename-extension output-path) (build-path (world:current-project-root)
(add-ext world:default-template-prefix (get-ext output-path))))))) ; path to default template
(and (filename-extension output-path) (build-path (world:current-server-extras-path) (add-ext world:fallback-template-prefix (get-ext output-path)))))))) ; fallback template
(add-ext (world:get-default-template-prefix) (get-ext output-path))))))) ; path to default template
(and (filename-extension output-path) (build-path (world:current-server-extras-path) (add-ext (world:get-fallback-template-prefix) (get-ext output-path)))))))) ; fallback template
(define/contract (file-needed-rerequire? source-path)

@ -9,7 +9,7 @@
@defmodule[pollen/cache]
The slowest part of a @racket[render] is parsing and decoding the source file. Often, previewing a single source file necessarily means decoding others (for instance templates, or other source files that are linked into the main source file). But usually, only one source file is changing at a time. Therefore, Pollen stores copies of the exports of source files — namely, whatever is stored in @code[(format "~a" world:main-pollen-export)] and @code[(format "~a" world:meta-pollen-export)] — in the cache so they can be reused.
The slowest part of a @racket[render] is parsing and decoding the source file. Often, previewing a single source file necessarily means decoding others (for instance templates, or other source files that are linked into the main source file). But usually, only one source file is changing at a time. Therefore, Pollen stores copies of the exports of source files — namely, whatever is stored in @code[(format "~a" world:main-export)] and @code[(format "~a" world:meta-export)] — in the cache so they can be reused.
@defparam[current-cache hash hash?]{A parameter that refers to the current cache. It is initialized with @racket[make-cache].

@ -55,4 +55,16 @@
(with-syntax ([id (generate-temporary)])
#'(begin
(define-runtime-path id name)
(image id xs ...)))]))
(image id xs ...)))]))
(require (for-syntax racket/syntax))
(define-syntax (defoverridable stx)
(syntax-case stx ()
[(_ name predicate? desc ...)
(with-syntax ([world:name (format-id stx "world:~a" #'name)]
[world:get-name (format-id stx "world:get-~a" #'name)]
[local:name (format-id stx "local:~a" #'name)])
#'(deftogether ((defthing world:name predicate?)
(defproc (world:get-name) predicate?))
desc ...))]))

@ -93,6 +93,7 @@ Make a copy of the project directory on the desktop, but without any source file
If you're already in your project directory and want to publish somewhere other than the desktop, use @racket[raco pollen publish _. _dest-dir].
@section{@racket[raco pollen version]}
Would you believe this prints the Pollen version number.

@ -331,7 +331,7 @@ But within a template, we need to tell Pollen how we want to convert the X-expre
Third, we need to include the content from our source file. By convention, every Pollen source file makes its output available through an exported variable named @code{doc}. A source file in preprocessor mode puts its text result in @code{doc}. And a source file in authoring mode puts its X-expression result in @code{doc}. So we put the variable @code{doc} inside the @code{body} tag.
@margin-note{You can change the name to something other than @code{doc} by changing @racket[world:main-pollen-export].}
@margin-note{You can change the name to something other than @code{doc} by changing @racket[world:main-export].}
@codeblock[#:keep-lang-line? #f]{
#lang pollen

@ -1,5 +1,5 @@
#lang scribble/manual
@(require "mb-tools.rkt")
@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/render))
@(define my-eval (make-base-eval))
@ -9,43 +9,76 @@
@defmodule[pollen/world]
A set of global values and parameters that are used throughout the Pollen system. If you don't like the defaults I've picked, change them.
Global values that are used throughout the Pollen system.
All identifiers are exported with the prefix @racket[world:], and are so documented below.
@section{Parameters}
I mean @italic{parameters} in the Racket sense, i.e. values that can be fed to @racket[parameterize].
@defthing[world:default-port integer?]
@defparam[world:current-server-port port integer?]{
A parameter that sets the HTTP port for the project server. Initialized to @racket[world:default-port], which defaults to 8080.}
A parameter that sets the HTTP port for the project server. Initialized to @racket[world:default-port].}
@deftogether[(
@defthing[world:main-pollen-export symbol?]
@defthing[world:meta-pollen-export symbol?]
)]
The two exports from a compiled Pollen source file. Initialized to @racket['doc] and @racket['metas], respectively.
@defparam[world:current-project-root port path?]{
A parameter that holds the root directory of the current project (e.g., the directory where you launched @code{raco pollen start}).}
@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.}
@(defthing world:directory-require string?)
File implicitly required into every Pollen source file from its directory. Initialized to @filepath{directory-require.rkt}.
@defparam[world:check-directory-requires-in-render? check? boolean?]{
A parameter that determines whether the @racket[world:directory-require] file is checked for changes on every pass through @racket[render]. (Can be faster to turn this off if you don't need it.) Initialized to @racket[#t].}
@defthing[world:server-extras-dir string?]
Name of directory where server support files live. Initialized to @tt{server-extras}.
@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.}
@section{Values that can be overwritten with @racket[local:]}
These values can be changed by overriding them in your @racket["directory-require.rkt"] source file. Use @racket[define] to make a variable with the same name as the one in @racket[pollen/world], but with the prefix @racket[local:] instead of @racket[world:]. Assign it whatever value you like. When Pollen runs, these definitions will supersede those in @racket[pollen/world].
For instance, suppose you wanted the main export of every Pollen source file to be called @racket[van-halen] rather than @racket[doc], the extension of Pollen markup files to be @racket[rock] rather than @racket[pm], and the command character to be @litchar{🎸} instead of @litchar{◊}. Your @racket["directory-require.rkt"] would include these defintions:
@fileblock["directory-require.rkt"
@codeblock{
#lang racket/base
(provide (all-defined-out))
(define local:main-export 'van-halen)
(define local:markup-source-ext 'rock)
(define local:command-char #\🎸)
}]
Though any of the values below can be overridden, it may not always be wise to do so. For instance, if you redefined @racket[world:fallback-template-prefix], you would simply break the fallback-template mechanism, because it would look for files that don't exist. But we don't live in a nanny state, so you are entrusted to say what you mean and accept the consequences.
Of course, you can restore the defaults simply by deleting these defined values from @racket["directory-require.rkt"].
These overridable values also come with a corresponding @racket[get-] function that will return the @racket[local:] value if it exists, otherwise the @racket[world:] value. In the example above, @racket[world:command-char] would be @litchar{◊} no matter what, but @racket[world:get-command-char] would return @litchar{🎸}.
@defoverridable[default-port integer?]{
Determines the default HTTP port for the project server. Initialized to @racket[8080].}
@defoverridable[main-export symbol?]{The main X-expression exported from a compiled Pollen source file. Initialized to @racket[doc].}
@defoverridable[meta-export symbol?]{The meta hashtable exported from a compiled Pollen source file. Initialized to @racket[metas].}
@defoverridable[world:meta-tag-name symbol?]{Name of the tag used to mark metas within Pollen source.}
@defoverridable[world:directory-require string?]{File implicitly required into every Pollen source file from its directory. Initialized to @filepath{directory-require.rkt}.}
@defoverridable[world:server-extras-dir string?]{Name of directory where server support files live. Initialized to @tt{server-extras}.}
@deftogether[(
@defthing[world:preproc-source-ext symbol?]
@defthing[world:markup-source-ext symbol?]
@defthing[world:markdown-source-ext symbol?]
@defthing[world:null-source-ext symbol?]
@defthing[world:pagetree-source-ext symbol?]
@defthing[world:template-source-ext symbol?]
@defthing[world:scribble-source-ext symbol?]
@defoverridable[preproc-source-ext symbol?]
@defoverridable[markup-source-ext symbol?]
@defoverridable[markdown-source-ext symbol?]
@defoverridable[null-source-ext symbol?]
@defoverridable[pagetree-source-ext symbol?]
@defoverridable[template-source-ext symbol?]
@defoverridable[scribble-source-ext symbol?]
)]
File extensions for Pollen source files, initialized to the following values:
@ -58,53 +91,32 @@ File extensions for Pollen source files, initialized to the following values:
@(linebreak)@racket[world:scribble-source-ext] = @code[(format "'~a" world:scribble-source-ext)]
@defthing[world:decodable-extensions (listof symbol?)]
File extensions that are eligible for decoding.
@defoverridable[decodable-extensions (listof symbol?)]{File extensions that are eligible for decoding.}
@deftogether[(
@(defthing world:mode-auto symbol?)
@(defthing world:mode-preproc symbol?)
@(defthing world:mode-markup symbol?)
@(defthing world:mode-markdown symbol?)
@(defthing world:mode-pagetree symbol?)
)]
Mode indicators for the Pollen reader and parser. Initialized to the following values:
@defoverridable[default-pagetree string?]{Pagetree that Pollen dashboard loads by default in each directory. Initialized to @filepath{index.ptree}.}
@racket[world:mode-auto] = @code[(format "'~a" world:mode-auto)]
@(linebreak)@racket[world:mode-preproc] = @code[(format "'~a" world:mode-preproc)]
@(linebreak)@racket[world:mode-markup] = @code[(format "'~a" world:mode-markup)]
@(linebreak)@racket[world:mode-markdown] = @code[(format "'~a" world:mode-markdown)]
@(linebreak)@racket[world:mode-pagetree] = @code[(format "'~a" world:mode-pagetree)]
@defoverridable[pagetree-root-node symbol?]{Name of the root node in a decoded pagetree. It's ignored by the code, so its only role is to clue you in that you're looking at something that came out of the pagetree decoder. Initialized to @code{'pagetree-root}.}
@defthing[world:default-pagetree string?]
Pagetree that Pollen dashboard loads by default in each directory. Initialized to @filepath{index.ptree}.
@defthing[world:pagetree-root-node symbol?]
Name of the root node in a decoded pagetree. It's ignored by the code, so its only role is to clue you in that you're looking at something that came out of the pagetree decoder. Initialized to @code{'pagetree-root}.
@defoverridable[command-char char?]{The magic character that indicates a Pollen command, function, or variable. Initialized to @racket[#\◊].}
@defoverridable[default-template-prefix string?]{Prefix of the default template. Initialized to @code{"template"}.}
@defthing[world:command-marker char?]
The magic character that indicates a Pollen command, function, or variable. Initialized to @racket[#\◊].
@defthing[world:default-template-prefix string?]
Prefix of the default template. Initialized to @code{"template"}.
@defoverridable[fallback-template-prefix string?]{Used to generate the name of the fallback template (i.e., the template used to render a Pollen markup file when no other template can be found). Prefix is combined with the output suffix of the source file. Initialized to @code{"fallback"}.}
@defthing[world:fallback-template-prefix string?]
Used to generate the name of the fallback template (i.e., the template used to render a Pollen markup file when no other template can be found). Prefix is combined with the output suffix of the source file. Initialized to @code{"fallback"}.
@defthing[world:template-meta-key symbol?]
Meta key used to store a template name for that particular source file. Initialized to @racket['template].
@defoverridable[template-meta-key symbol?]{Meta key used to store a template name for that particular source file. Initialized to @racket['template].}
@deftogether[(
@(defthing world:newline string?)
@(defthing world:linebreak-separator string?)
@(defthing world:paragraph-separator string?)
@(defoverridable world:newline string?)
@(defoverridable world:linebreak-separator string?)
@(defoverridable world:paragraph-separator string?)
)]
Default separators used in decoding. The first two are initialized to @racket["\n"]; the third to @racket["\n\n"].
@(defthing world:dashboard-css string?)
CSS file used for the dashboard. Initialized to @filepath{poldash.css}.
@defoverridable[dashboard-css string?]{CSS file used for the dashboard. Initialized to @filepath{poldash.css}.}
@(defthing world:paths-excluded-from-dashboard (listof path?))
Paths not shown in the Pollen dashboard.
@defoverridable[paths-excluded-from-dashboard (listof path?)]{Paths not shown in the Pollen dashboard.}

@ -25,7 +25,7 @@
(meta ([charset "UTF-8"]))
(link ([rel "stylesheet"]
[type "text/css"]
[href ,(format "/~a" world:dashboard-css)])))
[href ,(format "/~a" (world:get-dashboard-css))])))
(body
,content-xexpr (div ((id "pollen-logo"))))))
@ -41,7 +41,7 @@
(define client (request-client-ip req))
(define localhost-client "::1")
(define url-string (url->string (request-uri req)))
(message "request:" (string-replace url-string world:default-pagetree " dashboard")
(message "request:" (string-replace url-string (world:get-default-pagetree) " dashboard")
(if (not (equal? client localhost-client)) (format "from ~a" client) "")))
;; pass string args to route, then
@ -61,7 +61,7 @@
((complete-path?) (#:render boolean?) . ->* . txexpr?)
(when wants-render (render-from-source-or-output-path path))
(dynamic-rerequire path) ; stores module mod date; reloads if it's changed
(dynamic-require path world:main-pollen-export))
(dynamic-require path (world:get-main-export)))
;; todo: rewrite this test, obsolete since filename convention changed
;;(module+ test
@ -160,7 +160,7 @@
(define dirlinks (cons "/" (map (λ(ps) (format "/~a/" (apply build-path ps)))
(for/list ([i (in-range (length (cdr dirs)))])
(take (cdr dirs) (add1 i))))))
`(tr (th ((colspan "3")) ,@(add-between (map (λ(dir dirlink) `(a ((href ,(format "~a~a" dirlink world:default-pagetree))) ,(->string dir))) dirs dirlinks) "/"))))
`(tr (th ((colspan "3")) ,@(add-between (map (λ(dir dirlink) `(a ((href ,(format "~a~a" dirlink (world:get-default-pagetree)))) ,(->string dir))) dirs dirlinks) "/"))))
(define (make-path-row filename-path)
(define filename (->string filename-path))
@ -170,7 +170,7 @@
(append (list
(cond ; main cell
[(directory-exists? (build-path dashboard-dir filename)) ; links subdir to its dashboard
(cons (format "~a/~a" filename world:default-pagetree) (format "~a/" filename))]
(cons (format "~a/~a" filename (world:get-default-pagetree)) (format "~a/" filename))]
[(and source (equal? (get-ext source) "scrbl"))
(cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) " (from " ,(->string (find-relative-path dashboard-dir source)) ")")))]
[source (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) "." ,(get-ext source))))]
@ -186,12 +186,12 @@
[(pagetree-source? filename) empty-cell]
[else (cons (format "out/~a" filename) "out")]))))))
(define (ineligible-path? x) (member x world:paths-excluded-from-dashboard))
(define (ineligible-path? x) (member x (world:get-paths-excluded-from-dashboard)))
(define project-paths
(filter-not ineligible-path? (map ->path (pagetree->list
(if (file-exists? dashboard-ptree)
(cached-require (->path dashboard-ptree) world:main-pollen-export)
(cached-require (->path dashboard-ptree) (world:get-main-export))
(directory->pagetree dashboard-dir))))))
(body-wrapper #:title (format "~a" dashboard-dir)

@ -20,12 +20,12 @@
[((string-arg) ... "xexpr" (string-arg)) route-xexpr]
[else route-default]))
(message (format "Welcome to Pollen ~a" world:pollen-version) (format "(Racket ~a)" (version)))
(message (format "Welcome to Pollen ~a" (world:get-pollen-version)) (format "(Racket ~a)" (version)))
(message (format "Project root is ~a" (world:current-project-root)))
(define server-name (format "http://localhost:~a" (world:current-server-port)))
(message (format "Project server is ~a" server-name) "(Ctrl-C to exit)")
(message (format "Project dashboard is ~a/~a" server-name world:default-pagetree))
(message (format "Project dashboard is ~a/~a" server-name (world:get-default-pagetree)))
(message "Ready to rock")
(parameterize ([error-print-width 1000]

@ -24,8 +24,8 @@
(define doc-result (select-from-doc key value-source))
(and doc-result (car doc-result)))
(cond
[(or (hash? value-source) (equal? value-source world:meta-pollen-export)) (select-from-metas key value-source)]
[(equal? value-source world:main-pollen-export) (do-doc-result)]
[(or (hash? value-source) (equal? value-source (world:get-meta-export))) (select-from-metas key value-source)]
[(equal? value-source (world:get-main-export)) (do-doc-result)]
[else
(define metas-result (and (not (txexpr? value-source)) (select-from-metas key value-source)))
(or metas-result (do-doc-result))]))
@ -86,7 +86,7 @@
[(pagenode? pagenode-or-path) (pagenode->path pagenode-or-path)]
[else pagenode-or-path])))
(if source-path
(cached-require source-path world:meta-pollen-export)
(cached-require source-path (world:get-meta-export))
(error (format "get-metas: no source found for '~a' in directory ~a" pagenode-or-path (current-directory)))))
@ -96,7 +96,7 @@
[(pagenode? pagenode-or-path) (pagenode->path pagenode-or-path)]
[else pagenode-or-path])))
(if source-path
(cached-require source-path world:main-pollen-export)
(cached-require source-path (world:get-main-export))
(error (format "get-doc: no source found for '~a' in directory ~a" pagenode-or-path (current-directory)))))

@ -0,0 +1,18 @@
#lang racket/base
(provide (all-defined-out))
(define (root . xs)
`(rootover ,@xs))
(define local:pollen-version "42")
(define local:preproc-source-ext 'ppover)
(define local:markup-source-ext 'pmover)
(define local:markdown-source-ext 'pmdover)
(define local:null-source-ext 'p)
(define local:pagetree-source-ext 'ptreeover)
(define local:command-char #\∆)
(define local:main-export 'docover)
(define local:meta-export 'metasover)
(define local:meta-tag-name 'metaover)

@ -0,0 +1,2 @@
#lang pollen
∆(number->string (+ 1 1))

@ -0,0 +1,3 @@
#lang pollen
∆metaover{∆dog{Roxy}}
∆(number->string (+ 1 1))

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,6 @@
#lang pollen
(require (prefix-in foo: "samples/sample-01.html.pm"))
test
====
|foo:doc|

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -1,4 +1,4 @@
#lang racket/base
#lang at-exp racket/base
(require rackunit racket/port racket/system racket/runtime-path compiler/find-exe)
(module test-default pollen
@ -32,21 +32,23 @@
;; define-runtime-path only allowed at top level
(define-runtime-path test.ptree "../test-support/test.ptree")
(define-runtime-path test.html.pm "../test-support/test.html.pm")
(define-runtime-path test.html.pmd "../test-support/test.html.pmd")
(define-runtime-path test.html.pp "../test-support/test.html.pp")
(define-runtime-path test.no-ext "../test-support/test.no-ext")
(define-runtime-path test.ptree "data/test.ptree")
(define-runtime-path test.html.pm "data/test.html.pm")
(define-runtime-path test-import.html.pm "data/test-import.html.pm")
(define-runtime-path test.html.pmd "data/test.html.pmd")
(define-runtime-path test.html.pp "data/test.html.pp")
(define-runtime-path test.no-ext "data/test.no-ext")
;; `find-exe` avoids reliance on $PATH of the host system
(define racket-path (find-exe))
(when racket-path
(define (run path)
(define cmd-string (format "~a ~a" racket-path path))
(define cmd-string (format "'~a' ~a" racket-path path))
(with-output-to-string (λ() (system cmd-string))))
(check-equal? (run test.ptree) "'(pagetree-root test ====)")
(check-equal? (run test.html.pm) "'(root \"test\" \"\\n\" \"====\")")
(check-equal? (run test.html.pm) @string-append{'(root "test" "\n" "====")})
(check-equal? (run test-import.html.pm) @string-append{'(root "test" "\n" "====" "\n" (root "This is sample 01."))})
(check-equal? (run test.html.pmd) "'(root (h1 ((id \"test\")) \"test\"))")
(check-equal? (run test.html.pp) "test\n====")
(check-equal? (run test.no-ext) "test\n===="))

@ -0,0 +1,45 @@
#lang at-exp racket/base
(require rackunit racket/port racket/system racket/runtime-path compiler/find-exe pollen/world)
;; define-runtime-path only allowed at top level
(define-runtime-path override-dir "data/override")
(define-runtime-path test.ptree "data/override/test.ptree")
(define-runtime-path test.html.pm "data/override/test.html.pm")
(define-runtime-path test.html.pmd "data/override/test.html.pmd")
(define-runtime-path test.html.pp "data/override/test.html.pp")
(define-runtime-path test.ptreeover "data/override/test.ptreeover")
(define-runtime-path test.html.pmover "data/override/test.html.pmover")
(define-runtime-path test.html.pmdover "data/override/test.html.pmdover")
(define-runtime-path test.html.ppover "data/override/test.html.ppover")
(define-runtime-path test-cmd.html.ppover "data/override/test-cmd.html.ppover")
(define-runtime-path test-exports.html.ppover "data/override/test-exports.html.ppover")
(define-runtime-path test-require.html.pmover "data/override/test-require.html.pmover")
;; `find-exe` avoids reliance on $PATH of the host system
(define racket-path (find-exe))
;; parameterize needed to pick up override file
(parameterize ([current-directory override-dir]
[world:current-project-root override-dir])
(when racket-path
(define (run path)
(define cmd-string (format "'~a' ~a" racket-path path))
(with-output-to-string (λ() (system cmd-string))))
;; raco is in same dir as racket
(define path-to-raco (path->string (simplify-path (build-path (find-exe) 'up "raco"))))
;; files with ordinary extensions will not be recognized in override dir, and thus behave like preproc
(check-equal? (run test.ptree) "test\n====")
(check-equal? (run test.html.pm) "test\n====")
(check-equal? (run test.html.pmd) "test\n====")
(check-equal? (run test.html.pp) "test\n====")
(check-equal? (run test.ptreeover) "'(pagetree-root test ====)")
(check-equal? (run test.html.pmover) "'(rootover \"test\" \"\\n\" \"====\")")
(check-equal? (run test.html.pmdover) "'(rootover (h1 ((id \"test\")) \"test\"))")
(check-equal? (run test.html.ppover) "test\n====")
(check-equal? (run test-cmd.html.ppover) "2")
(check-equal? (dynamic-require test-exports.html.ppover 'docover) "\n2")
(check-equal? (hash-ref (dynamic-require test-exports.html.ppover 'metasover) 'dog) "Roxy")
(check-equal? (dynamic-require test-require.html.pmover 'docover) '(rootover "foobar"))
(check-equal? (with-output-to-string (λ _ (system (format "'~a' pollen version" path-to-raco)))) "42\n")))

@ -1,18 +1,41 @@
#lang racket/base
(require (for-syntax racket/base racket/syntax))
(require racket/runtime-path)
(provide (prefix-out world: (all-defined-out)))
(define pollen-version "0.001")
(define preproc-source-ext 'pp)
(define markup-source-ext 'pm)
(define markdown-source-ext 'pmd)
(define null-source-ext 'p)
(define pagetree-source-ext 'ptree)
(define template-source-ext 'pt)
(define scribble-source-ext 'scrbl)
(define current-project-root (make-parameter (current-directory)))
(define directory-require "directory-require.rkt")
(define (get-path-to-override)
(build-path (current-project-root) directory-require))
;; parameters should not be made settable.
(define-syntax (define-settable stx)
(syntax-case stx ()
[(_ name default-value)
(with-syntax ([base-name (format-id stx "~a" #'name)]
[local:name (format-id stx "local:~a" #'name)]
[get-name (format-id stx "get-~a" #'name)]
[fail-thunk-name (format-id stx "fail-thunk-~a" #'name)] )
#'(begin
(define base-name default-value)
(define fail-thunk-name (λ _ base-name))
(define get-name (λ _ (with-handlers ([exn:fail? fail-thunk-name])
(dynamic-require (get-path-to-override) 'local:name fail-thunk-name))))))]))
(define-settable pollen-version "0.001")
(define-settable preproc-source-ext 'pp)
(define-settable markup-source-ext 'pm)
(define-settable markdown-source-ext 'pmd)
(define-settable null-source-ext 'p)
(define-settable pagetree-source-ext 'ptree)
(define-settable template-source-ext 'pt)
(define-settable scribble-source-ext 'scrbl)
;; these are deliberately not settable because they're just internal signalers, no effect on external interface
(define mode-auto 'auto)
(define mode-preproc 'pre)
(define mode-markup 'markup)
@ -20,44 +43,40 @@
(define mode-pagetree 'ptree)
(define mode-template 'template)
(define cache-filename "pollen.cache")
(define-settable cache-filename "pollen.cache")
(define decodable-extensions (list markup-source-ext pagetree-source-ext))
(define-settable decodable-extensions (list (get-markup-source-ext) (get-pagetree-source-ext)))
(define default-pagetree "index.ptree")
(define pagetree-root-node 'pagetree-root)
(define-settable default-pagetree (format "index.~a" (get-pagetree-source-ext)))
(define-settable pagetree-root-node 'pagetree-root)
(define command-marker #\◊)
(define template-command-marker #\∂)
(define-settable command-char #\◊)
(define-settable template-command-char #\∂)
(define default-template-prefix "template")
(define fallback-template-prefix "fallback")
(define template-meta-key "template")
(define-settable default-template-prefix "template")
(define-settable fallback-template-prefix "fallback")
(define-settable template-meta-key "template")
(define main-pollen-export 'doc) ; don't forget to change fallback template too
(define meta-pollen-export 'metas)
(define meta-tag-name 'meta)
(define-settable main-export 'doc) ; don't forget to change fallback template too
(define-settable meta-export 'metas)
(define-settable meta-tag-name 'meta)
(define directory-require "directory-require.rkt")
(define newline "\n")
(define linebreak-separator newline)
(define paragraph-separator "\n\n")
(define-settable newline "\n")
(define-settable linebreak-separator (get-newline))
(define-settable paragraph-separator "\n\n")
(define paths-excluded-from-dashboard
(map string->path (list "poldash.css" "compiled")))
(define-settable paths-excluded-from-dashboard (map string->path (list "poldash.css" "compiled")))
(define current-project-root (make-parameter (current-directory)))
(define-settable default-port 8080)
(define default-port 8080)
(define current-server-port (make-parameter default-port))
(define current-server-port (make-parameter (get-default-port)))
(define dashboard-css "poldash.css")
(define-settable dashboard-css "poldash.css")
(define-runtime-path server-extras-dir "server-extras")
(define current-server-extras-path (make-parameter server-extras-dir))
(define check-directory-requires-in-render? (make-parameter #t))
(define publish-directory-name "publish")
(define-settable publish-directory-name "publish")
Loading…
Cancel
Save