Make Pollen source files (pagetrees in particular) more composable

pull/102/head
Matthew Butterick 9 years ago
parent 4780aa40a6
commit 84fc2ca026

@ -10,9 +10,8 @@
(define-syntax (*module-begin stx) (define-syntax (*module-begin stx)
(syntax-case stx () (syntax-case stx ()
[(_ . body) [(_ id . body)
(with-syntax ([id #'doc-raw] ; name of the main export from doclang-raw (with-syntax ([post-process #'(λ(x) x)]
[post-process #'(λ(x) x)]
[exprs #'()]) [exprs #'()])
#'(#%module-begin #'(#%module-begin
(doc-begin id post-process exprs . body)))])) (doc-begin id post-process exprs . body)))]))

@ -1,7 +1,7 @@
#lang racket/base #lang racket/base
(provide get-language-info) (provide get-language-info)
(define (get-language-info data) (define (get-language-info top-here-path)
(lambda (key default) (λ(key default)
(case key (case key
[(configure-runtime) '(#(pollen/runtime-config configure #f))] [(configure-runtime) `(#(pollen/runtime-config configure ,top-here-path))]
[else default]))) [else default])))

@ -34,14 +34,16 @@
[(VALUE (... ...)) (datum->syntax #'(EXPR (... ...)) meta-values)] [(VALUE (... ...)) (datum->syntax #'(EXPR (... ...)) meta-values)]
[METAS (format-id #'(EXPR (... ...)) "~a" (world:current-meta-export))] [METAS (format-id #'(EXPR (... ...)) "~a" (world:current-meta-export))]
[META-MOD (format-symbol "~a" (world:current-meta-export))] [META-MOD (format-symbol "~a" (world:current-meta-export))]
[DOC (format-id #'(EXPR (... ...)) "~a" (world:current-main-export))]) [DOC (format-id #'(EXPR (... ...)) "~a" (world:current-main-export))]
[DOC-RAW (generate-temporary)]); prevents conflicts with other imported Pollen sources
(replace-context #'(EXPR (... ...)) (replace-context #'(EXPR (... ...))
#'(#%module-begin #'(#%module-begin
(module META-MOD racket/base (module META-MOD racket/base
(provide (all-defined-out)) (provide (all-defined-out))
(define METAS (apply hash (append (list 'KEY VALUE) (... ...))))) (define METAS (apply hash (append (list 'KEY VALUE) (... ...)))))
(module inner pollen/doclang-raw ; exports result as doc-raw (module inner pollen/doclang-raw
DOC-RAW ; positional arg for doclang-raw that sets name of export.
(require pollen/top pollen/world) (require pollen/top pollen/world)
(provide #%top (all-defined-out) (all-from-out pollen/world)) (provide #%top (all-defined-out) (all-from-out pollen/world))
EXPR-WITHOUT-METAS (... ...)) EXPR-WITHOUT-METAS (... ...))
@ -58,6 +60,6 @@
[else ; for preprocessor output, just make a string [else ; for preprocessor output, just make a string
(λ xs (apply string-append (map to-string xs)))])] (λ xs (apply string-append (map to-string xs)))])]
;; drop leading newlines, as they're often the result of `defines` and `requires` ;; drop leading newlines, as they're often the result of `defines` and `requires`
[doc-elements (dropf doc-raw (λ(ln) (equal? ln "\n")))]) [doc-elements (dropf DOC-RAW (λ(ln) (equal? ln "\n")))])
(apply proc doc-elements))) (apply proc doc-elements)))
(provide DOC METAS (except-out (all-from-out 'inner) doc-raw #%top))))))])))) ; hide internal exports (provide DOC METAS (except-out (all-from-out 'inner) DOC-RAW #%top))))))])))) ; hide internal exports

@ -37,9 +37,15 @@
(define+provide/contract (decode-pagetree xs) (define+provide/contract (decode-pagetree xs)
(txexpr-elements? . -> . any/c) ; because pagetree is being explicitly validated (txexpr-elements? . -> . any/c) ; because pagetree is being explicitly validated
(define pt-root-tag (world:current-pagetree-root-node))
(define (splice-nested-pagetree xs)
(apply append (for/list ([x (in-list xs)])
(if (and (txexpr? x) (eq? (get-tag x) pt-root-tag))
(get-elements x)
(list x)))))
(validate-pagetree (validate-pagetree
(decode (cons (world:current-pagetree-root-node) xs) (decode (cons pt-root-tag xs)
#:txexpr-elements-proc (λ(xs) (filter (compose1 not whitespace?) xs)) #:txexpr-elements-proc (compose1 splice-nested-pagetree (λ(xs) (filter-not whitespace? xs)))
#:string-proc string->symbol))) ; because faster than ->pagenode #:string-proc string->symbol))) ; because faster than ->pagenode
@ -53,6 +59,7 @@
x)))) x))))
(define+provide (pagetree? x) (define+provide (pagetree? x)
(with-handlers ([exn:fail? (λ(e) #f)]) (with-handlers ([exn:fail? (λ(e) #f)])
(->boolean (validate-pagetree x)))) (->boolean (validate-pagetree x))))
@ -61,7 +68,9 @@
(check-true (pagetree? '(foo))) (check-true (pagetree? '(foo)))
(check-true (pagetree? '(foo (hee)))) (check-true (pagetree? '(foo (hee))))
(check-true (pagetree? '(foo (hee (uncle foo))))) (check-true (pagetree? '(foo (hee (uncle foo)))))
(check-false (pagetree? '(foo (hee hee (uncle foo)))))) (check-false (pagetree? '(foo (hee hee (uncle foo)))))
(check-equal? (decode-pagetree '(one two (pagetree-root three (pagetree-root four five) six) seven eight))
'(pagetree-root one two three four five six seven eight)))
(define+provide/contract (directory->pagetree dir) (define+provide/contract (directory->pagetree dir)
@ -76,7 +85,7 @@
(define (sort-names xs) (sort xs #:key ->string string<?)) (define (sort-names xs) (sort xs #:key ->string string<?))
;; put subdirs in list ahead of files (so they appear at the top) ;; put subdirs in list ahead of files (so they appear at the top)
(append (sort-names subdirectories) (sort-names pagetree-sources) (sort-names other-files))) (append (sort-names subdirectories) (sort-names pagetree-sources) (sort-names other-files)))
;; in general we don't filter the directory list for the automatic pagetree. ;; in general we don't filter the directory list for the automatic pagetree.
;; this can be annoying sometimes but it's consistent with the policy of avoiding magic behavior. ;; this can be annoying sometimes but it's consistent with the policy of avoiding magic behavior.
;; certain files (leading dot) will be ignored by `directory-list` anyhow. ;; certain files (leading dot) will be ignored by `directory-list` anyhow.

@ -36,7 +36,7 @@
(define post-parser-syntax (define post-parser-syntax
(with-syntax ([HERE-KEY (format-id source-stx "~a" (world:current-here-path-key))] (with-syntax ([HERE-KEY (format-id source-stx "~a" (world:current-here-path-key))]
[HERE-PATH (datum->syntax source-stx reader-here-path)] [HERE-PATH (datum->syntax source-stx reader-here-path)]
[POLLEN-MOD (format-symbol "~a" 'pollen-lang-module)] [POLLEN-MOD (format-symbol "~a" (gensym))] ; prevents conflicts with other imported Pollen sources
[PARSER-MODE-VALUE (format-symbol "~a" parser-mode)] [PARSER-MODE-VALUE (format-symbol "~a" parser-mode)]
[DIRECTORY-REQUIRES (datum->syntax source-stx (require+provide-directory-require-files path-string))] [DIRECTORY-REQUIRES (datum->syntax source-stx (require+provide-directory-require-files path-string))]
[(SOURCE-LINE ...) source-stx] [(SOURCE-LINE ...) source-stx]
@ -53,10 +53,10 @@
SOURCE-LINE ...) SOURCE-LINE ...)
(require (submod pollen/runtime-config show) 'POLLEN-MOD) (require (submod pollen/runtime-config show) 'POLLEN-MOD)
(provide (all-from-out 'POLLEN-MOD)) (provide (all-from-out 'POLLEN-MOD))
(show DOC inner:parser-mode))))) (show DOC inner:parser-mode HERE-PATH))))) ; HERE-PATH acts as "local" runtime config
(syntax-property post-parser-syntax (syntax-property post-parser-syntax
'module-language 'module-language
'#(pollen/language-info get-language-info #f)))) `#(pollen/language-info get-language-info ,reader-here-path)))) ; reader-here-path acts as "top" runtime config
(define-syntax-rule (define+provide-reader-in-mode mode) (define-syntax-rule (define+provide-reader-in-mode mode)

@ -7,16 +7,19 @@
(define show-enabled (make-parameter #f)) (define show-enabled (make-parameter #f))
(define (show doc parser-mode) (define (show doc parser-mode here-path)
(when (show-enabled) ;; we only want the top doc to print in the runtime environment
(if (or (equal? parser-mode world:mode-preproc) ;; otherwise if a Pollen source imports others, they will all print their docs in sequence.
(equal? parser-mode world:mode-template)) ;; so only print if the current here-path is the top path, which is stored in the `show-enabled` parameter.
(when (and (show-enabled) (equal? here-path (show-enabled)))
(if (or (eq? parser-mode world:mode-preproc)
(eq? parser-mode world:mode-template))
(display doc) (display doc)
(print (with-handlers ([exn:fail? (λ(exn) ((error '|pollen markup error| ((dynamic-require 'racket/string 'string-join) (cdr ((dynamic-require 'racket/string 'string-split) (exn-message exn) ": ")) ": "))))]) (print (with-handlers ([exn:fail? (λ(exn) ((error '|pollen markup error| ((dynamic-require 'racket/string 'string-join) (cdr ((dynamic-require 'racket/string 'string-split) (exn-message exn) ": ")) ": "))))])
((dynamic-require 'txexpr 'validate-txexpr) doc))))))) ((dynamic-require 'txexpr 'validate-txexpr) doc)))))))
(require 'show) (require 'show)
(define (configure data) (define (configure top-here-path)
(show-enabled #t)) (show-enabled top-here-path))

@ -116,6 +116,87 @@ Experienced programmers may want to know that because a pagetree is just an X-ex
Note that you need to take more care when building a pagetree by hand. Pagenodes are symbols, not strings, thus the use of @racket[string->symbol] is mandatory. One benefit of using a pagetree source file is that it takes care of this housekeeping for you. Note that you need to take more care when building a pagetree by hand. Pagenodes are symbols, not strings, thus the use of @racket[string->symbol] is mandatory. One benefit of using a pagetree source file is that it takes care of this housekeeping for you.
@section{Nesting pagetrees}
You can put other pagetrees within a pagetree. Since every pagetree is an X-expression, you can nest pagetrees as you would ordinary X-expressions. Suppose we have this pagetree:
@fileblock["sub.ptree" @codeblock{
#lang pollen
three
four
}]
And we want to add it to an existing pagetree:
@fileblock["index.ptree" @codeblock{
#lang pollen
one
two
five
six}]
You can @racket[require] @filepath{sub.ptree} normally to import its @racket[doc]:
@fileblock["index.ptree" @codeblock{
#lang pollen
◊(require "sub.ptree")
one
two
◊doc
five
six}]
And you'll get this:
@repl-output{'(pagetree-root one two three four five six)}
Pollen does one bit of housekeeping for you, which is that it automatically drops the root node of the imported pagetree, and splices the remaining nodes into the parent pagetree at the insertion point. Otherwise you'd get this, which is probably not what you wanted:
@repl-output{'(pagetree-root one two (pagetree-root three four) five six)}
But if you do want the imported pagetree under a subnode, just add a containing pagenode as usual:
@fileblock["index.ptree" @codeblock{
#lang pollen
◊(require "sub.ptree")
one
two
◊subtree{
◊doc
}
five
six}]
Which will give you:
@repl-output{'(pagetree-root one two (subtree three four) five six)}
If you want to combine a number of pagetrees, @racket[require] can get cumbersome because you have to juggle multiple @racket[doc] imports (which can be done with @racket[prefix-in], but it's still juggling). Instead, you can use @racket[dynamic-require] to put each imported pagetree where you want it.
@fileblock["index.ptree" @codeblock{
#lang pollen
one
two
◊(dynamic-require "sub.ptree" 'doc)
five
six
◊(dynamic-require "sub-two.ptree" 'doc)
nine
ten
}]
Nesting pagetrees won't circumvent the usual rule against duplicate pagenodes. So this pagetree, which tries to nest @filepath{sub.ptree} twice, won't work:
@fileblock["index.ptree" @codeblock{
#lang pollen
one
two
◊(dynamic-require "sub.ptree" 'doc)
◊(dynamic-require "sub.ptree" 'doc)
five
six
}]
@section{The automatic pagetree} @section{The automatic pagetree}
In situations where Pollen needs a pagetree but can't find one, it will automatically synthesize a pagetree from a listing of files in the directory. This arises most frequently when @secref["Using_the_dashboard" #:doc '(lib "pollen/scribblings/pollen.scrbl")] in a directory that doesn't contain an explicit @filepath{index.ptree}. This way, you can get going with a project without having to stop for @racketfont{.ptree} housekeeping. In situations where Pollen needs a pagetree but can't find one, it will automatically synthesize a pagetree from a listing of files in the directory. This arises most frequently when @secref["Using_the_dashboard" #:doc '(lib "pollen/scribblings/pollen.scrbl")] in a directory that doesn't contain an explicit @filepath{index.ptree}. This way, you can get going with a project without having to stop for @racketfont{.ptree} housekeeping.

@ -48,8 +48,7 @@
(with-output-to-string (λ() (system cmd-string)))) (with-output-to-string (λ() (system cmd-string))))
(check-equal? (run test.ptree) "'(pagetree-root test ====)") (check-equal? (run test.ptree) "'(pagetree-root test ====)")
(check-equal? (run test.html.pm) @string-append{'(root "test" "\n" "====")}) (check-equal? (run test.html.pm) @string-append{'(root "test" "\n" "====")})
;; todo: this one's a little weird. Pollen-to-Pollen require prints the result of required file on import. (check-equal? (run test-import.html.pm) @string-append{'(root "test" "\n" "====" "\n" (root "This is sample 01."))})
(check-equal? (run test-import.html.pm) @string-append{'(root "This is sample 01.")'(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.pmd) "'(root (h1 ((id \"test\")) \"test\"))")
(check-equal? (run test.html.pp) "test\n====") (check-equal? (run test.html.pp) "test\n====")
(check-equal? (run test.no-ext) "test\n====")) (check-equal? (run test.no-ext) "test\n===="))

Loading…
Cancel
Save