mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

v3 candidate

Browse Source
pull/225/head
Matthew Butterick 4 years ago
parent 9332a94c32
commit 39d3719321
16 changed files with 86 additions and 92 deletions
Show Stats Download Patch File Download Diff File

2
info.rkt
Unescape Escape View File

@ -1,7 +1,7 @@
#lang info
(define collection 'multi)
(define version "2.2")
(define version "3.0")
(define deps '(["base" #:version "6.3"]
["txexpr" #:version "0.2"]
["sugar" #:version "0.2"]

4
pollen/cache.rkt
Unescape Escape View File

@ -61,7 +61,7 @@
(cached-require-base path-string subkey 'cached-require))
(define+provide (cached-doc path-string)
(cached-require-base path-string (setup:main-export) 'cached-doc))
(cached-require-base path-string pollen-main-export 'cached-doc))
(define+provide (cached-metas path-string)
(cached-require-base path-string (setup:meta-export) 'cached-metas))
(cached-require-base path-string pollen-meta-export 'cached-metas))

6
pollen/core.rkt
Unescape Escape View File

@ -1,7 +1,7 @@
#lang racket/base
(require (for-syntax
racket/base
"private/splice.rkt")
"private/constants.rkt")
racket/match
txexpr/base
xml/path
@ -120,7 +120,7 @@
(define-syntax (when/splice stx)
(syntax-case stx ()
[(_ COND . BODY)
(with-syntax ([SPLICING-TAG (datum->syntax stx splice-signal-tag)])
(with-syntax ([SPLICING-TAG (datum->syntax stx pollen-splicing-tag)])
#'(if COND
(SPLICING-TAG . BODY)
(SPLICING-TAG)))]))
@ -130,7 +130,7 @@
(define-syntax (for/splice/base stx)
(syntax-case stx ()
[(_ ITERATORS . BODY)
(with-syntax ([SPLICING-TAG (datum->syntax stx splice-signal-tag)]
(with-syntax ([SPLICING-TAG (datum->syntax stx pollen-splicing-tag)]
[FORM (or (syntax-property stx 'form) #'for/list)])
#'(apply SPLICING-TAG (FORM ITERATORS
(SPLICING-TAG . BODY))))]))

4
pollen/file.rkt
Unescape Escape View File

@ -16,8 +16,8 @@
(check-equal? (->preproc-source-path "foo") (->path "foo.pp"))
(check-equal? (->preproc-source-path 'foo) (->path "foo.pp"))
(check-true (pagetree-source? (format "foo.~a" (setup:pagetree-source-ext))))
(check-false (pagetree-source? (format "~a.foo" (setup:pagetree-source-ext))))
(check-true (pagetree-source? (format "foo.~a" pollen-pagetree-source-ext)))
(check-false (pagetree-source? (format "~a.foo" pollen-pagetree-source-ext)))
(check-false (pagetree-source? #f))
(check-true (markup-source? "foo.pm"))

10
pollen/private/cache-utils.rkt
Unescape Escape View File

@ -82,10 +82,6 @@
(for-each caching-zo-compiler (cons path (or (get-directory-require-files path) null)))
; recycle namespace
(current-namespace)]))
(define doc-key (setup:main-export))
(define meta-key (setup:meta-export))
(unless (and (symbol? doc-key) (symbol? meta-key))
(raise-argument-error 'path->hash "symbols for doc and meta key" (cons doc-key meta-key)))
;; I monkeyed around with using the metas submodule to pull out the metas (for speed)
;; but in practice most files get their doc requested too.
;; so it's just simpler to get both at once and be done with it.
@ -97,8 +93,8 @@
(define metas-missing-thunk (λ () (hasheq)))
(parameterize ([current-namespace compilation-namespace]
[current-directory (dirname path)])
(hasheq doc-key (dynamic-require path doc-key doc-missing-thunk)
meta-key (dynamic-require path meta-key metas-missing-thunk))))
(hasheq pollen-main-export (dynamic-require path pollen-main-export doc-missing-thunk)
pollen-meta-export (dynamic-require path pollen-meta-export metas-missing-thunk))))
(define (my-make-directory* dir)
(define base (dirname dir))
@ -110,7 +106,7 @@
(define (make-cache-dirs path)
(define path-dir (dirname path))
(define cache-dir (build-path path-dir (setup:cache-dir-name) (setup:cache-subdir-name)))
(define cache-dir (build-path path-dir pollen-cache-dir-name pollen-cache-subdir-name))
(define private-cache-dir (build-path cache-dir "private"))
(my-make-directory* private-cache-dir) ; will also make cache-dir, if needed
(values cache-dir private-cache-dir))

21
pollen/private/constants.rkt
Unescape Escape View File

@ -0,0 +1,21 @@
#lang racket/base
(provide (prefix-out pollen- (all-defined-out)))
(define main-export 'doc) ; don't forget to change fallback template too
(define meta-export 'metas)
(define meta-tag-name 'meta)
(define define-meta-name 'define-meta)
(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 poly-source-ext 'poly) ; extension that signals source can be used for multiple output targets
(define cache-dir-name "compiled")
(define cache-subdir-name "pollen")
(define template-prefix "template")
(define fallback-template-prefix "fallback")
(define template-meta-key "template")
(define old-cache-names '("pollen.cache" "pollen-cache"))
(define splicing-tag '@)

14
pollen/private/file-utils.rkt
Unescape Escape View File

@ -128,7 +128,7 @@
(define+provide (has-poly-ext? x)
(equal? (get-ext x) (->string (setup:poly-source-ext))))
(equal? (get-ext x) (->string pollen-poly-source-ext)))
(module-test-external
(check-true (has-poly-ext? "foo.poly"))
@ -147,7 +147,7 @@
(define-syntax (define-utility-functions stx)
(syntax-case stx ()
[(_ STEM)
(with-syntax ([SETUP:STEM-SOURCE-EXT (format-id stx "setup:~a-source-ext" #'STEM)]
(with-syntax ([STEM-SOURCE-EXT (format-id stx "pollen-~a-source-ext" #'STEM)]
[STEM-SOURCE? (format-id stx "~a-source?" #'STEM)]
[GET-STEM-SOURCE (format-id stx "get-~a-source" #'STEM)]
[HAS/IS-STEM-SOURCE? (format-id stx "has/is-~a-source?" #'STEM)]
@ -158,7 +158,7 @@
;; does file have particular extension
(define+provide (STEM-SOURCE? x)
#;(any/c . -> . boolean?)
(and (pathish? x) (has-ext? (->path x) (SETUP:STEM-SOURCE-EXT)) #true))
(and (pathish? x) (has-ext? (->path x) STEM-SOURCE-EXT) #true))
;; non-theoretical: want the first possible source that exists in the filesystem
(define+provide (GET-STEM-SOURCE x)
@ -185,19 +185,19 @@
(list x) ; already has the source extension
#,(if (eq? (syntax->datum #'STEM) 'scribble)
#'(if (x . has-ext? . 'html) ; different logic for scribble sources
(list (add-ext (remove-ext* x) (SETUP:STEM-SOURCE-EXT)))
(list (add-ext (remove-ext* x) STEM-SOURCE-EXT))
#false)
#'(let ([x-ext (get-ext x)]
[source-ext (SETUP:STEM-SOURCE-EXT)])
[source-ext STEM-SOURCE-EXT])
(cons
(add-ext x source-ext) ; standard
(if x-ext ; has existing ext, therefore needs escaped version
(cons
(add-ext (escape-last-ext x) source-ext)
(if (ext-in-poly-targets? x-ext x) ; needs multi + escaped multi
(let ([x-multi (add-ext (remove-ext x) (setup:poly-source-ext))])
(let ([x-multi (add-ext (remove-ext x) pollen-poly-source-ext)])
(list
(add-ext x-multi (SETUP:STEM-SOURCE-EXT))
(add-ext x-multi STEM-SOURCE-EXT)
(add-ext (escape-last-ext x-multi) source-ext)))
null))
null))))))

8
pollen/private/main-base.rkt
Unescape Escape View File

@ -38,12 +38,12 @@
(define-syntax (pollen-module-begin stx)
(syntax-case stx ()
[(_ PARSER-MODE . EXPRS)
(with-syntax ([META-HASH (split-metas #'EXPRS (setup:define-meta-name))]
[METAS-ID (setup:meta-export)]
[METAS-ID-CALLER (datum->syntax #'EXPRS (setup:meta-export))]
(with-syntax ([META-HASH (split-metas #'EXPRS pollen-define-meta-name)]
[METAS-ID pollen-meta-export]
[METAS-ID-CALLER (datum->syntax #'EXPRS pollen-meta-export)]
[ROOT-ID (datum->syntax #'EXPRS (setup:main-root-node))]
[POLLEN/TOP (datum->syntax #'EXPRS 'pollen/top)]
[DOC-ID (setup:main-export)]
[DOC-ID pollen-main-export]
[ALL-DEFINED-OUT (datum->syntax #'EXPRS '(all-defined-out))])
#'(doclang:#%module-begin
DOC-ID ; positional arg for doclang-raw: name of export

2
pollen/private/project-server-routes.rkt
Unescape Escape View File

@ -193,7 +193,7 @@
(define source-minus-ext (unescape-ext (remove-ext source)))
(define source-second-ext (get-ext source-minus-ext))
(cond ; multi source. expand to multiple output files.
[(and source-second-ext (equal? source-second-ext (->string (setup:poly-source-ext (->complete-path source)))))
[(and source-second-ext (equal? source-second-ext (->string pollen-poly-source-ext)))
(define source-base (remove-ext source-minus-ext))
(define output-names (map (λ (ext) (->string (add-ext source-base ext))) (setup:poly-targets (->complete-path source))))
(cons #f `(div ,@(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)))]

22
pollen/private/reader-base.rkt
Unescape Escape View File

@ -22,9 +22,9 @@
[(eq? reader-mode default-mode-auto)
(let ([val (cond [(get-ext reader-here-path) => string->symbol])])
(cond
[(eq? val (setup:pagetree-source-ext)) default-mode-pagetree]
[(eq? val (setup:markup-source-ext)) default-mode-markup]
[(eq? val (setup:markdown-source-ext)) default-mode-markdown]
[(eq? val pollen-pagetree-source-ext) default-mode-pagetree]
[(eq? val pollen-markup-source-ext) default-mode-markup]
[(eq? val pollen-markdown-source-ext) default-mode-markdown]
[else default-mode-preproc]))]
[else reader-mode]))
@ -48,9 +48,9 @@
[HERE-PATH reader-here-path]
[HERE-KEY (setup:here-path-key)]
[SOURCE-LINES source-stx]
[DOC (setup:main-export)]
[META-MOD (setup:meta-export)]
[METAS-ID (setup:meta-export)]
[DOC pollen-main-export]
[META-MOD pollen-meta-export]
[METAS-ID pollen-meta-export]
[PARSER-MODE-FROM-READER parser-mode-from-reader])
#'(module runtime-wrapper racket/base
(module configure-runtime racket/base
@ -119,11 +119,11 @@
[(drracket:default-extension)
(symbol->string
(cond
[(eq? mode default-mode-auto) (setup:preproc-source-ext)]
[(eq? mode default-mode-preproc) (setup:preproc-source-ext)]
[(eq? mode default-mode-markdown) (setup:markdown-source-ext)]
[(eq? mode default-mode-markup) (setup:markup-source-ext)]
[(eq? mode default-mode-pagetree) (setup:pagetree-source-ext)]))]
[(eq? mode default-mode-auto) pollen-preproc-source-ext]
[(eq? mode default-mode-preproc) pollen-preproc-source-ext]
[(eq? mode default-mode-markdown) pollen-markdown-source-ext]
[(eq? mode default-mode-markup) pollen-markup-source-ext]
[(eq? mode default-mode-pagetree) pollen-pagetree-source-ext]))]
[else default])))
(define-syntax-rule (reader-module-begin mode . _)

4
pollen/private/render-helper.rkt
Unescape Escape View File

@ -29,8 +29,8 @@
(let ([source-path (syntax->datum #'SOURCE-PATH-STRING)])
(with-syntax ([DIRECTORY-REQUIRE-FILES
(replace-context #'here (require-directory-require-files source-path))]
[DOC-ID (setup:main-export source-path)]
[METAS-ID (setup:meta-export source-path)]
[DOC-ID pollen-main-export]
[METAS-ID pollen-meta-export]
[COMMAND-CHAR (setup:command-char source-path)])
#'(#%module-begin
DIRECTORY-REQUIRE-FILES

14
pollen/private/splice.rkt
Unescape Escape View File

@ -1,10 +1,10 @@
#lang racket/base
(require racket/match
racket/list)
racket/list
"constants.rkt")
(provide (all-defined-out))
;; (string->symbol (format "~a" #\u200B))
(define splice-signal-tag '@)
(define (attrs? x)
(match x
@ -18,7 +18,7 @@
[(cons (== splicing-tag eq?) _) #true]
[_ #false]))
(define (splice x [splicing-tag splice-signal-tag])
(define (splice x [splicing-tag pollen-splicing-tag])
; (listof txexpr-elements?) . -> . (listof txexpr-elements?))
(let loop ([x x])
(if (list? x) ; don't exclude `attrs?` here, because it will exclude valid splice input like '((@ "foo"))
@ -32,14 +32,14 @@
(module+ test
(require rackunit)
(check-equal? (splice `((div 1 (,splice-signal-tag 2 "" (,splice-signal-tag 3 (div 4 (,splice-signal-tag 5))) 6) "" 7)))
(check-equal? (splice `((div 1 (,pollen-splicing-tag 2 "" (,pollen-splicing-tag 3 (div 4 (,pollen-splicing-tag 5))) 6) "" 7)))
'((div 1 2 3 (div 4 5) 6 7)))
(check-equal? (splice `((,splice-signal-tag 1 (,splice-signal-tag 2 "" (,splice-signal-tag 3 (div 4 (,splice-signal-tag 5))) 6) "" 7)))
(check-equal? (splice `((,pollen-splicing-tag 1 (,pollen-splicing-tag 2 "" (,pollen-splicing-tag 3 (div 4 (,pollen-splicing-tag 5))) 6) "" 7)))
'(1 2 3 (div 4 5) 6 7))
(check-equal? (splice `((,splice-signal-tag "foo" "" "bar"))) '("foo" "bar"))
(check-equal? (splice `((,pollen-splicing-tag "foo" "" "bar"))) '("foo" "bar"))
(check-equal? (splice null) null)
(check-equal? (splice '(a ((href "")(foo "bar")) "zam")) '(a ((href "")(foo "bar")) "zam"))
(check-equal? (splice `((,splice-signal-tag "str"))) '("str")))
(check-equal? (splice `((,pollen-splicing-tag "str"))) '("str")))
;; this will strip all empty lists.

12
pollen/render.rkt
Unescape Escape View File

@ -383,7 +383,7 @@
(parameterize ([current-directory (current-project-root)])
(define source-metas (cached-metas source-path))
(define template-name-or-names ; #f or atom or list
(select-from-metas (setup:template-meta-key source-path) source-metas))
(select-from-metas pollen-template-meta-key source-metas))
(define template-name (if (list? template-name-or-names)
(findf (λ (tn) (eq? (get-ext tn) output-path-ext)) template-name-or-names)
template-name-or-names))
@ -391,13 +391,13 @@
(define (get-default-template source-path output-path-ext)
(and output-path-ext
(let ([default-template-filename (add-ext (setup:template-prefix source-path) output-path-ext)])
(let ([default-template-filename (add-ext pollen-template-prefix output-path-ext)])
(find-upward-from source-path default-template-filename file-exists-or-has-source?))))
(define (get-fallback-template source-path output-path-ext)
(and output-path-ext
(build-path (current-server-extras-path)
(add-ext (setup:fallback-template-prefix source-path) output-path-ext))))
(add-ext pollen-fallback-template-prefix output-path-ext))))
(define (template-cache-key source-path output-path)
(paths->key 'template source-path (current-poly-target) output-path))
@ -432,18 +432,18 @@
(module-test-external
(require pollen/setup sugar/file sugar/coerce)
(define fallback.html (build-path (current-server-extras-path)
(add-ext (setup:fallback-template-prefix) 'html)))
(add-ext pollen-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 (current-server-extras-path)
(add-ext (setup:fallback-template-prefix) 'svg)))
(add-ext pollen-fallback-template-prefix 'svg)))
(parameterize ([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 (current-server-extras-path)
(add-ext (setup:fallback-template-prefix) 'missing)))
(add-ext pollen-fallback-template-prefix 'missing)))
(parameterize ([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)))

7
pollen/scribblings/version-history.scrbl
Unescape Escape View File

@ -25,9 +25,16 @@ Beyond keeping the commit history available, I make no promise to maintain the p
@section{Changelog}
@subsection{Version 3.0}
Changed rendering model to share a namespace between sequential renders, improving speed.
Added @racket[--force] switch to @secref["raco_pollen_render" #:doc '(lib "pollen/scribblings/pollen.scrbl")].
Added @racket[--dry-run] switch to @secref["raco_pollen_publish" #:doc '(lib "pollen/scribblings/pollen.scrbl")].
Downgraded the following @racket[pollen/setup] values from configurable to fixed: @racket[splicing-tag], @racket[preproc-source-ext], @racket[markup-source-ext], @racket[markdown-source-ext], @racket[null-source-ext], @racket[pagetree-source-ext], @racket[template-source-ext], @racket[scribble-source-ext], @racket[poly-source-ext], @racket[cache-dir-name], @racket[cache-subdir-name], @racket[template-prefix], @racket[fallback-template-prefix], @racket[template-meta-key], @racket[main-export], @racket[meta-export], @racket[meta-tag-name], @racket[define-meta-name].
@subsection{Version 2.2}
Added @racket[--null] and @racket[--dry-run] switches to @secref["raco_pollen_render" #:doc '(lib "pollen/scribblings/pollen.scrbl")].

42
pollen/setup.rkt
Unescape Escape View File

@ -1,6 +1,8 @@
#lang racket/base
(require (for-syntax racket/base racket/syntax)
racket/runtime-path)
racket/runtime-path
"private/constants.rkt")
(provide (all-from-out "private/constants.rkt"))
(define-syntax-rule (define+provide ID EXPR ...)
(begin
@ -55,28 +57,11 @@
'NAME
(λ () DEFAULT-NAME))))))]))
(define-syntax (define-settable-not stx)
(syntax-case stx ()
[(_ NAME DEFAULT-VALUE)
(with-syntax ([DEFAULT-NAME (format-id stx "default-~a" #'NAME)]
[NAME-THUNKED (format-id stx "~a" #'NAME)])
#'(begin
(provide (prefix-out setup: NAME-THUNKED) DEFAULT-NAME)
(define DEFAULT-NAME DEFAULT-VALUE)
;; can take a dir argument that sets start point for (get-path-to-override) search.
(define (NAME-THUNKED [dir #false]) DEFAULT-NAME)))]))
(define-settable cache-watchlist null)
(define-settable envvar-watchlist null)
(define-settable-not preproc-source-ext 'pp)
(define-settable-not markup-source-ext 'pm)
(define-settable-not markdown-source-ext 'pmd)
(define-settable-not null-source-ext 'p)
(define-settable-not pagetree-source-ext 'ptree)
(define-settable-not template-source-ext 'pt)
(define-settable-not scribble-source-ext 'scrbl)
;; these are deliberately not settable because they're just internal signalers, no effect on external interface
(define+provide default-mode-auto 'auto)
(define+provide default-mode-preproc 'pre)
@ -85,29 +70,17 @@
(define+provide default-mode-pagetree 'ptree)
(define+provide default-mode-template 'template)
(define-settable old-cache-names '("pollen.cache" "pollen-cache"))
(define-settable-not cache-dir-name "compiled")
(define-settable-not cache-subdir-name "pollen")
(define+provide default-cache-names (list* (cache-dir-name) (old-cache-names)))
(define+provide default-cache-names (cons pollen-cache-dir-name pollen-old-cache-names))
(define-settable decodable-extensions (list (markup-source-ext) (pagetree-source-ext)))
(define-settable decodable-extensions (list pollen-markup-source-ext pollen-pagetree-source-ext))
(define-settable main-pagetree (format "index.~a" (pagetree-source-ext)))
(define-settable main-pagetree (format "index.~a" pollen-pagetree-source-ext))
(define-settable pagetree-root-node 'pagetree-root)
(define-settable main-root-node 'root)
(define-settable command-char #\◊)
(define-settable template-command-char #\∂)
(define-settable-not template-prefix "template")
(define-settable-not fallback-template-prefix "fallback")
(define-settable-not template-meta-key "template")
(define-settable-not main-export 'doc) ; don't forget to change fallback template too
(define-settable-not meta-export 'metas)
(define-settable-not meta-tag-name 'meta)
(define-settable-not define-meta-name 'define-meta)
;; tags from https://developer.mozilla.org/en-US/docs/Web/HTML/Block-level_elements
(define-settable block-tags (cons (main-root-node) '(address article aside blockquote body canvas dd div dl fieldset figcaption figure footer form h1 h2 h3 h4 h5 h6 header hgroup hr li main nav noscript ol output p pre section table tfoot ul video)))
@ -152,7 +125,6 @@
(define-settable here-path-key 'here-path)
(define-settable-not 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+provide current-poly-target (make-parameter (car (poly-targets))))

6
pollen/template/html.rkt
Unescape Escape View File

@ -6,10 +6,8 @@
(define paren-match (cadr matches))
paren-match)
(define splicing-tag splice-signal-tag)
(define (has-outer-splice-tag? x)
(and (pair? x) (eq? (get-tag x) splicing-tag)))
(and (pair? x) (eq? (get-tag x) pollen-splicing-tag)))
(define+provide/contract (->html x-arg-maybe-spliced
#:tag [tag #f]
@ -31,7 +29,7 @@
(define x (if (list? x-arg)
(splice (if (txexpr? x-arg)
x-arg
(cons 'html x-arg)) splicing-tag) ; list of txexpr-elements
(cons 'html x-arg)) pollen-splicing-tag) ; list of txexpr-elements
x-arg))
(when (and (not (txexpr? x)) attrs (not tag))

Write Preview
Loading…
Cancel
Save