change `meta` tags to `define-meta` and add `metas` submodule

pull/84/head
Matthew Butterick 9 years ago
parent 9a6176ae58
commit bbab98f0a5

@ -27,6 +27,9 @@
(map (λ(ps) (define cp (->complete-path ps))
(cons (path->string cp) (file-or-directory-modify-seconds cp))) path-strings))
(define (key->source-path-key key)
(list (car key)))
(define (key->source-path key)
(car (car key)))
@ -35,15 +38,16 @@
(and directory-require-files (map dynamic-rerequire directory-require-files))
(void))
(require sugar/debug)
(define (path->hash path)
(define (path->hash path subkey)
(dynamic-rerequire path)
;; new namespace forces dynamic-require to re-instantiate 'path'
;; otherwise it gets cached in current namespace.
(parameterize ([current-namespace (make-base-namespace)])
(hash (world:current-main-export) (dynamic-require path (world:current-main-export))
(world:current-meta-export) (dynamic-require path (world:current-meta-export)))))
(hash subkey (dynamic-require (if (eq? subkey (world:current-meta-export))
`(submod ,path ,subkey) ; use metas submodule for speed
path) subkey))))
;; include this from 6.2 for compatibility back to 6.0 (formerly `make-parent-directory*`)
(define (make-parent-directory p)
@ -74,17 +78,20 @@
(cond
[(world:current-compile-cache-active)
(define key (paths->key path))
(define key (let ([possible-key (paths->key path)])
(if (eq? subkey (world:current-meta-export))
(key->source-path-key possible-key)
possible-key)))
;; use multiple pickup files to avoid locking issues.
;; pickup-file hierarchy just mirrors the project hierarchy.
(define dest-file (build-path cache-dir (path->string (find-relative-path (world:current-project-root) (string->path (format "~a.rktd" (key->source-path key)))))))
(define dest-file (build-path cache-dir (path->string (find-relative-path (world:current-project-root) (string->path (format "~a#~a.rktd" (key->source-path key) subkey))))))
(make-parent-directory dest-file)
(hash-ref (hash-ref! ram-cache key (λ _
(cache-file dest-file
#:exists-ok? #t
key
cache-dir
(λ _ (write-to-file (path->hash path) dest-file #:exists 'replace))
(λ _ (write-to-file (path->hash path subkey) dest-file #:exists 'replace))
#:max-cache-size (world:current-compile-cache-max-size))
(file->value dest-file))) subkey)]
[else (parameterize ([current-namespace (make-base-namespace)])

@ -10,9 +10,12 @@
(define-syntax (*module-begin stx)
(syntax-case stx ()
[(_ id post-process exprs . body)
[(_ . body)
(with-syntax ([id #'doc-raw]
[post-process #'(λ(x) x)]
[exprs #'()])
#'(#%module-begin
(doc-begin id post-process exprs . body))]))
(doc-begin id post-process exprs . body)))]))
(define-syntax (doc-begin stx)
(syntax-case stx ()

@ -1,5 +1,5 @@
#lang racket/base
(require (for-syntax racket/base racket/syntax pollen/world) pollen/world)
(require (for-syntax racket/base racket/syntax pollen/world) pollen/decode pollen/pagetree racket/list pollen/world markdown)
(provide (all-defined-out) (all-from-out pollen/world))
@ -11,56 +11,31 @@
(syntax-case stx ()
[(_ EXPR (... ...))
(with-syntax ([DOC (datum->syntax stx (world:current-main-export))]
[METAS (datum->syntax stx (world:current-meta-export))]
[META (datum->syntax stx (world:current-meta-tag-name))]
[INNER (datum->syntax stx ''inner)])
#'(#%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
(module inner pollen/doclang-raw ; exports result as doc-raw
(require pollen/top pollen/world)
(provide (all-defined-out) (all-from-out pollen/top pollen/world))
(provide #%top (all-defined-out) (all-from-out pollen/world))
EXPR (... ...))
(require INNER 'inner pollen/metas) ; import inner twice: INNER for external use, 'inner for internal
;; 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))
(require INNER 'inner) ; import inner twice: INNER for external use, 'inner for internal
;; set up the DOC export
(define doc-elements (if (list? doc-raw) ; discard all newlines at front of file
((dynamic-require 'racket/list 'dropf) doc-raw (λ(i) (equal? i "\n")))
doc-raw)) ; single line
(define doc-with-metas (list* 'placeholder-root `(META (here-path ,here-path)) doc-elements))
(define-values (doc-without-metas METAS) (split-metas-to-hash doc-with-metas))
(define DOC
(let ([proc (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 (dynamic-require 'pollen/decode 'to-string) xs))))]
;; for preprocessor output, just make a string.
[else (λ xs (apply string-append (map (dynamic-require 'pollen/decode 'to-string) xs)))])]
[doc-elements-without-metas (cdr doc-without-metas)])
(apply proc doc-elements-without-metas)))
(let* ([parser-mode-defined? (procedure? inner:parser-mode)] ; if not defined, #%top makes it a procedure
[parser-mode (if parser-mode-defined?
MODE-ARG
inner:parser-mode)]
[proc (cond
[(eq? parser-mode world:mode-pagetree) (λ xs (decode-pagetree xs))]
[(eq? parser-mode world:mode-markup) root] ; if `root` undefined, it becomes a default tag function
[(eq? parser-mode world:mode-markdown)
(λ xs (apply root (apply (compose1 parse-markdown string-append)
(map to-string xs))))]
[else ; for preprocessor output, just make a string
(λ xs (apply string-append (map to-string xs)))])]
[doc-elements (if (list? doc-raw) ; discard all newlines at front of multi-line file
(dropf doc-raw (λ(ln) (equal? ln "\n")))
doc-raw)]) ; single line
(apply proc doc-elements)))
;; hide the exports that were only for internal use.
(provide DOC METAS (except-out (all-from-out INNER) doc-raw #%top))))]))))
(provide DOC (except-out (all-from-out INNER) doc-raw #%top))))])))) ; hide internal exports

@ -1,122 +0,0 @@
#lang racket/base
(require racket/list pollen/top txexpr pollen/world) ; pollen/top needed for metaroot
(provide split-metas-to-hash)
(require sugar)
(module+ test
(require rackunit))
(define (possible-meta-element? x)
(and (txexpr? x) (equal? (world:current-meta-tag-name) (get-tag x))))
(define (trivial-meta-element? x)
(and (possible-meta-element? x) (not (nontrivial-meta-element? x))))
(define (has-meta-attrs x)
(let ([attrs (get-attrs x)])
(and (not (empty? attrs)) (andmap valid-meta-attr? attrs))))
(define (has-meta-elements x)
(not (empty? (filter txexpr? (get-elements x)))))
(define (nontrivial-meta-element? x)
(and (possible-meta-element? x)
(or (has-meta-attrs x) (has-meta-elements x))))
(define (meta-element? x)
(or (trivial-meta-element? x) (nontrivial-meta-element? x)))
(module+ test
(check-true (nontrivial-meta-element? '(meta ((foo "bar")))))
(check-true (nontrivial-meta-element? '(meta (foo "bar"))))
(check-true (trivial-meta-element? '(meta)))
(check-true (trivial-meta-element? '(meta "bar"))))
;; strictly speaking, this predicate isn't necessary (implied by txexpr-ness)
;; but it produces a helpful error
(define (valid-meta-attr? x)
(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)
`(,(world:current-meta-tag-name) (,key ,@values)))
(define (explode-meta-element me)
;; convert a meta with multiple key/value pairs into multiple metas with a single txexpr element
;; only gets nontrivial metas to start.
(let loop ([me (make-txexpr (get-tag me) (get-attrs me) (filter txexpr? (get-elements me)))][acc empty])
(cond
[(not (trivial-meta-element? me)) ; meta might become trivial during loop
(cond
[(has-meta-attrs me) ; might have txexpr elements, so preserve them
(define attrs (get-attrs me))
(loop (make-txexpr (world:current-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 (world:current-meta-tag-name) null (cdr txexpr-elements)) (cons (apply make-atomic-meta (car txexpr-elements)) acc))])]
[else (reverse acc)])))
(define (splitter x pred)
(define acc null)
(define leftover (let loop ([x x])
(cond
[(list? x) (define-values (pred-elements rest) (partition pred x))
(set! acc (append pred-elements acc))
(map loop rest)]
[else x])))
(values leftover (reverse acc)))
(define (split-meta-elements x) ; pull metas out of doc and put them into meta-elements accumulator
;; watch out: x may not be a txexpr, because we are extracting metas before the pollen parser has finished its work
;; for instance, floating-point numbers will eventually become strings, but here they're still numbers
;; thus instead of split-txexpr, use a custom splitter
(define-values (thing-without-meta-elements meta-elements) (splitter x meta-element?))
;; trivial metas are discarded
(define exploded-meta-elements (append-map explode-meta-element (filter nontrivial-meta-element? meta-elements)))
(values thing-without-meta-elements exploded-meta-elements))
(define (split-metas-to-hash x)
(define-values (doc-without-metas meta-elements) (split-meta-elements x))
;; 'metaroot is the hook for the meta decoder function.
;; If it's not a defined identifier, it just hits #%top and becomes `(metaroot ,@metas ...)
;; because of `explode-meta-element`, meta-elements will be a list of metas with a single key/value pair
;; metaroot can rely on this
(define metas-xexpr (apply metaroot meta-elements))
(define (first-attribute x) (car (get-elements x)))
(define (meta-key x) (car (first-attribute x)))
(define (meta-value x) (let ([rest (cdr (first-attribute x))])
(if (= (length rest) 1)
(car rest)
rest)))
(define (meta-element->assoc me) (cons (meta-key me) (meta-value me)))
(define metas (make-hash (map meta-element->assoc (cdr metas-xexpr))))
(values doc-without-metas metas))
(module+ test
(require rackunit)
;; 1.5 instead of "1.5" is deliberate: input may not yet be a true txexpr
(let ([x '(root (meta ((foo "bar"))) "hello" (p (meta ((foo "zam"))) (meta) "there" 1.5))])
(define-values (doc-without-metas metahash) (split-metas-to-hash x))
(check-equal? doc-without-metas '(root "hello" (p "there" 1.5)))
(check-equal? (hash-ref metahash 'foo) "zam"))
(let ([x '(root (meta (foo "bar")) "hello" (p (meta (foo (zim "zam"))) (meta) "there" 1.5))])
(define-values (doc-without-metas metahash) (split-metas-to-hash x))
(check-equal? doc-without-metas '(root "hello" (p "there" 1.5)))
(check-equal? (hash-ref metahash 'foo) '(zim "zam"))))

@ -1,56 +1,81 @@
#lang racket/base
(require (only-in scribble/reader make-at-reader) pollen/world racket/path pollen/project)
(require racket/syntax syntax/strip-context)
(require (only-in scribble/reader make-at-reader) pollen/world pollen/project racket/list)
(provide define+provide-reader-in-mode (all-from-out pollen/world))
(define (make-custom-read custom-read-syntax-proc)
(λ(p) (syntax->datum (custom-read-syntax-proc (object-name p) p))))
(require sugar/debug)
(define (split-metas tree)
(define (meta-matcher x) (and (pair? x) (eq? (car x) (world:current-define-meta-name))))
(define matches empty)
(define rest
(let loop ([x tree])
(cond
[(meta-matcher x)
(set! matches (cons x matches))
(loop empty)]
[(list? x)
(define-values (new-matches rest) (partition meta-matcher x))
(set! matches (append new-matches matches))
(map loop rest)]
[else x])))
(values matches rest))
(define (make-custom-read-syntax reader-mode)
(λ (path-string p)
(define read-inner (make-at-reader
#:command-char (if (or (equal? reader-mode world:mode-template)
#:command-char (if (or (eq? reader-mode world:mode-template)
(and (string? path-string)
(regexp-match (pregexp (format "\\.~a$" (world:current-template-source-ext))) path-string)))
(world:current-template-command-char)
(world:current-command-char))
#:syntax? #t
#:inside? #t))
(define file-contents (read-inner path-string p))
(syntax-property
(datum->syntax file-contents
`(module runtime-wrapper racket/base
(module pollen-lang-module pollen
(define reader-mode ',reader-mode)
(define reader-here-path ,(cond
(define source-stx (read-inner path-string p))
(define-values (meta-matches meta-free-file-data) (split-metas (syntax->datum source-stx)))
(define reader-here-path (cond
[(symbol? path-string) (symbol->string path-string)]
[(equal? path-string "unsaved editor") path-string]
[else (path->string path-string)]))
(define parser-mode
(if (equal? reader-mode world:mode-auto)
(define parser-mode (if (eq? reader-mode world:mode-auto)
(let* ([file-ext-pattern (pregexp "\\w+$")]
[here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))])
(cond
[(equal? here-ext (world:current-pagetree-source-ext)) world:mode-pagetree]
[(equal? here-ext (world:current-markup-source-ext)) world:mode-markup]
[(equal? here-ext (world:current-markdown-source-ext)) world:mode-markdown]
[else world:mode-preproc]))
[here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))]
[auto-computed-mode (cond
[(eq? here-ext (world:current-pagetree-source-ext)) world:mode-pagetree]
[(eq? here-ext (world:current-markup-source-ext)) world:mode-markup]
[(eq? here-ext (world:current-markdown-source-ext)) world:mode-markdown]
[else world:mode-preproc])])
auto-computed-mode)
reader-mode))
;; change names of exports for local use
;; so they don't conflict if this source is imported into another
(provide (except-out (all-defined-out) reader-here-path reader-mode parser-mode)
(prefix-out inner: reader-here-path)
(prefix-out inner: reader-mode)
(define meta-keys (cons 'here-path (map second meta-matches)))
(define meta-values (cons reader-here-path (map third meta-matches)))
(with-syntax ([(KEY ...) (datum->syntax source-stx meta-keys)]
[(VALUE ...) (datum->syntax source-stx meta-values)])
(syntax-property
(replace-context source-stx
#`(module runtime-wrapper racket/base
(module metas racket/base
(provide (all-defined-out))
(define #,(world:current-meta-export) (apply hash (append (list 'KEY VALUE) ...))))
(module pollen-lang-module pollen
(define parser-mode '#,parser-mode) ; change names of exports for local use, to avoid conflicts
(provide (except-out (all-defined-out) parser-mode)
(prefix-out inner: parser-mode))
,(require+provide-directory-require-files path-string)
,@file-contents)
#,(require+provide-directory-require-files path-string)
(require (submod ".." ".." metas)) ; get metas from adjacent submodule
(provide (all-from-out (submod ".." ".." metas)))
#,@meta-free-file-data)
(require (submod pollen/runtime-config show) 'pollen-lang-module)
(provide (all-from-out 'pollen-lang-module))
(show ,(world:current-main-export) inner:parser-mode))
file-contents)
(show #,(world:current-main-export) inner:parser-mode)))
'module-language
'#(pollen/language-info get-language-info #f))))
'#(pollen/language-info get-language-info #f)))))
(define-syntax-rule (define+provide-reader-in-mode mode)

@ -518,14 +518,14 @@ The value of edge is ◊|edge| pixels}
@margin-note{Pollen occasionally uses metas internally. For instance, the @racket[get-template-for] function will look in the metas of a source file to see if a template is explicitly specified. The @racket[pollen/template] module also contains functions for working with metas, such as @racket[select-from-metas].}
To make a meta, you create a tag with the special @code{meta} name. Then you have two choices: you can either embed the key-value pair as an attribute, or as a tagged X-expression within the meta (using the key as the tag, and the value as the body):
To make a meta, you create a tag with the special @code{define-meta} name. Then you have two choices: you can either embed the key-value pair as an attribute, or as a tagged X-expression within the meta (using the key as the tag, and the value as the body):
@codeblock{
#lang pollen
meta['dog: "Roxy"]
define-meta[dog]{Roxy} ; text-mode syntax
◊some-tag['key: "value"]{Normal tag}
meta{◊cat{Chopper}}
(define-meta cat "Chopper") ; equivalent Racket-mode syntax
◊some-tag['key: "value"]{Another normal tag}
}
@ -552,11 +552,11 @@ Still, you can override this too:
@codeblock{
#lang pollen
meta['dog: "Roxy"]
define-meta[dog]{Roxy}
◊some-tag['key: "value"]{Normal tag}
meta{◊cat{Chopper}}
(define-meta cat "Chopper")
◊some-tag['key: "value"]{Another normal tag}
meta['here-path: "tesseract"]
(define-meta here-path "tesseract")
}
When you run this code, the result will be the same as before, but this time the metas will be different:
@ -571,8 +571,8 @@ It doesn't matter how many metas you put in a source file, nor where you put the
@codeblock{
#lang pollen
meta['dog: "Roxy"]
meta{◊dog{Lex}}
define-meta[dog]{Roxy}
(define-meta dog "Lex")
}
In this case, though there are two metas named @racket[dog] (and they use different forms) only the second one persists:
@ -582,63 +582,15 @@ In this case, though there are two metas named @racket[dog] (and they use differ
'#hash((dog . "Lex") (here-path . "unsaved-editor"))
}
You can put multiple keys and values within a single @code{meta} tag, and you can mix them between attributes and elements. As above, later keys supersede earlier ones.
@bold{Pro tip}: the @racket[metas] hashtable is available when you import a Pollen source file in the usual way, but it's also made available through a submodule called, unsurprisingly, @racket[metas].
@codeblock{
#lang pollen
◊meta['dog: "Roxy" 'lion: "P22"]{◊dog{Lex}}
}
@terminal{
> metas
'#hash((dog . "Lex") (here-path . "unsaved-editor") (lion . "P22"))
}
Should you store your metas as attributes or elements? That's up to you, but elements are more flexible. When your key-value pair is stored as an attribute, your value has to be a string (because that's the only datatype an attribute can hold). Whereas when your key-value pair is stored as an element, you have two extra possiblilites.
First, the value can be any X-expression. For instance, this code uses an @racket[img] tag as the meta value:
@codeblock{
#lang pollen
◊meta['dog: "Roxy"]
◊meta{◊dog{◊img['src: "lex.gif"]}}
#lang racket/base
(require "pollen-source.rkt") ; doc and metas and everything else
(require (submod "pollen-source.rkt" metas)) ; just metas
}
@terminal{
> metas
'#hash((dog . (img ((src "roxy.gif")))) (here-path . "unsaved-editor"))
}
Second, if you use an element, the value can be either a single value or a list or values:
@codeblock{
#lang pollen
◊meta['dog: "Roxy"]
◊meta{◊categories['brindles 'boxers 'working-dogs]}
}
@terminal{
> metas
'#hash((dog . "Roxy") (here-path . "unsaved-editor") (categories . (brindles boxers working-dogs)))
}
Be aware that if you put things inside a @racket[meta] tag that don't qualify as key-value pairs, Pollen will just discard them. So don't be surprised when this:
@codeblock{
#lang pollen
◊meta['dog: "Roxy"]{This text will be ignored}
◊meta[◊cat{Chopper}]{As will this text}
}
Gets treated as if you wrote it this way:
@codeblock{
#lang pollen
◊meta['dog: "Roxy"]
◊meta[◊cat{Chopper}]
}
The @racket[metas] submodule is useful because it gives you access to the @racket[metas] hashtable @italic{without} compiling the rest of the file. So if you need to collect metas from a set of source files — for instance, page titles (for a table of contents) or categories — getting the metas through the submodule is likely to be faster.
@;--------------------------------------------------------------------

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

@ -39,7 +39,7 @@
(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? (dynamic-require test-exports.html.ppover 'docover) "2")
(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")))

@ -62,6 +62,7 @@
(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-settable define-meta-name 'define-meta)
(define-settable newline "\n")
(define-settable linebreak-separator (current-newline))

Loading…
Cancel
Save