refactor splice, pollen/template; add pollen/core

pull/110/head
Matthew Butterick 8 years ago
parent 35568a4ba5
commit 370832cdde

@ -0,0 +1,124 @@
#lang racket/base
(require (for-syntax racket/base "world.rkt"))
(require txexpr xml/path sugar/define sugar/coerce sugar/test racket/string)
(require "private/file-utils.rkt"
"world.rkt"
"cache.rkt"
"pagetree.rkt"
"private/to-string.rkt")
(define is-meta-value? hash?)
(define is-doc-value? txexpr?)
(define identity (λ(x) x))
(define not-false? identity)
(define+provide define-meta identity) ;; stub so it will be picked up for docs
(define+provide/contract (select* key value-source)
(coerce/symbol? (or/c is-meta-value? is-doc-value? pagenode? pathish?) . -> . (or/c #f txexpr-elements?))
(define metas-result (and (not (is-doc-value? value-source)) (select-from-metas key value-source)))
(define doc-result (and (not (is-meta-value? value-source)) (select-from-doc key value-source)))
(define result (filter not-false? (apply append (map ->list (list metas-result doc-result)))))
(and (pair? result) result))
(define+provide/contract (select key value-source)
(coerce/symbol? (or/c is-meta-value? is-doc-value? pagenode? pathish?) . -> . (or/c #f txexpr-element?))
(define result (select* key value-source))
(and (pair? result) (car result)))
(module-test-external
(check-equal? (select* 'key '#hash((key . "value"))) '("value"))
(check-equal? (select 'key '#hash((key . "value"))) "value")
(check-false (select* 'absent-key '#hash((key . "value"))))
(check-false (select 'absent-key '#hash((key . "value"))))
(check-equal? (select* 'key '(root (key "value"))) '("value"))
(check-equal? (select 'key '(root (key "value"))) "value")
(check-false (select* 'absent-key '(root (key "value"))))
(check-false (select 'absent-key '(root (key "value"))))
(let ([metas '#hash((key . "value"))])
(check-equal? (select* 'key metas) '("value"))
(check-equal? (select 'key metas) "value")
(check-false (select* 'absent-key metas))
(check-false (select 'absent-key metas)))
(let ([doc '(root (key "value"))])
(check-equal? (select* 'key doc) '("value"))
(check-equal? (select 'key doc) "value")
(check-false (select* 'absent-key doc))
(check-false (select 'absent-key doc))))
(define+provide/contract (select-from-metas key metas-source)
;; output contract is a single txexpr-element
;; because metas is a hash, and a hash has only one value for a key.
(coerce/symbol? (or/c is-meta-value? pagenode? pathish?) . -> . (or/c #f txexpr-element?))
(define metas (if (is-meta-value? metas-source)
metas-source
(get-metas metas-source)))
(and (hash-has-key? metas key) (hash-ref metas key)))
(module-test-external
(let ([metas '#hash((key . "value"))])
(check-equal? (select-from-metas 'key metas) "value")
(check-false (select-from-metas 'absent-key metas))))
(define+provide/contract (select-from-doc key doc-source)
;; output contract is a list of elements
;; because doc is a txexpr, and a txexpr can have multiple values for a key
(coerce/symbol? (or/c is-doc-value? pagenode? pathish?) . -> . (or/c #f txexpr-elements?))
(define doc (if (is-doc-value? doc-source)
doc-source
(get-doc doc-source)))
(define result (se-path*/list (list key) doc))
(and (pair? result) result))
(module-test-external
(check-equal? (select-from-doc 'key '(root (key "value"))) '("value"))
(check-false (select-from-doc 'absent-key '(root (key "value"))))
(let ([doc '(root (key "value"))])
(check-equal? (select-from-doc 'key doc) '("value"))
(check-false (select-from-doc 'absent-key doc))))
(define (convert+validate-path pagenode-or-path caller)
(let ([path (get-source (if (pagenode? pagenode-or-path)
(build-path (world:current-project-root) (symbol->string pagenode-or-path))
pagenode-or-path))])
(unless path
(error (format "~a no source found for '~a' in directory ~a" caller path (current-directory))))
path))
(define+provide/contract (get-metas pagenode-or-path)
((or/c pagenode? pathish?) . -> . is-meta-value?)
(cached-metas (convert+validate-path pagenode-or-path 'get-metas)))
(define+provide/contract (get-doc pagenode-or-path)
((or/c pagenode? pathish?) . -> . (or/c is-doc-value? string?))
(cached-doc (convert+validate-path pagenode-or-path 'get-doc)))
(provide when/splice)
(define-syntax (when/splice stx)
(syntax-case stx ()
[(_ COND BODY ...)
(with-syntax ([SPLICING-TAG (datum->syntax stx (world:current-splicing-tag))])
#'(if COND
(with-handlers ([exn:fail? (λ(exn) (error (format "within when/block, ~a" (exn-message exn))))])
(list 'SPLICING-TAG BODY ...))
""))]))
(provide when/block) ; bw compat
(define-syntax (when/block stx)
(syntax-case stx ()
[(_ condition body ...)
#'(if condition (string-append*
(with-handlers ([exn:fail? (λ(exn) (error (format "within when/block, ~a" (exn-message exn))))])
(map to-string (list body ...))))
"")]))

@ -154,6 +154,7 @@
;; Find adjacent newline characters in a list and merge them into one item
;; Scribble, by default, makes each newline a separate list item.
;; Ignore empty strings.
(define+provide/contract (merge-newlines x)
(txexpr-elements? . -> . txexpr-elements?)
(define newline-pat (regexp (format "^~a+$" (world:current-newline))))
@ -161,16 +162,18 @@
(define (merge-if-newlines xs)
(if (newlines? (car xs))
(list (apply string-append xs))
xs))
xs))
(define not-empty-string? (λ(x) (not (and (string? x) (= (string-length x) 0)))))
(let loop ([x x])
(if (pair? x)
(let ([xs (map loop x)])
(let ([xs (map loop (filter not-empty-string? x))])
(append-map merge-if-newlines (slicef xs newlines?)))
x)))
(module-test-external
(require racket/list)
(check-equal? (merge-newlines empty) empty)
(check-equal? (merge-newlines '(p "\n" "" "\n")) '(p "\n\n"))
(check-equal? (merge-newlines '(p "\n" "\n" "foo" "\n" "\n\n" "bar" (em "\n" "\n" "\n")))
'(p "\n\n" "foo" "\n\n\n" "bar" (em "\n\n\n"))))

@ -31,9 +31,9 @@
(module inner pollen/private/doclang-raw
DOC-RAW ; positional arg for doclang-raw that sets name of export.
(require pollen/top pollen/world)
(require pollen/top pollen/world pollen/core)
(require (submod ".." META-MOD))
(provide (all-defined-out) #%top (all-from-out (submod ".." META-MOD)))
(provide (all-defined-out) #%top (all-from-out (submod ".." META-MOD) pollen/core))
EXPR-WITHOUT-METAS (... ...))
(require 'inner)

@ -2,19 +2,21 @@
(provide (all-defined-out))
(define (splice x [splicing-tag '@])
; (listof txexpr-elements?) . -> . (listof txexpr-elements?))
(define spliceable? (λ(x) (and (pair? x) (eq? (car x) splicing-tag))))
(define not-null-string? (λ(x) (not (and (string? x) (= (string-length x) 0)))))
(let loop ([x x])
(if (list? x)
(apply append
(map (λ(xi) (let ([proc (if (and (pair? xi) (eq? (car xi) splicing-tag))
cdr ; expose elements
list)]) ; wrap in list
(proc (loop xi)))) x))
x)))
(if (list? x)
(apply append (map (λ(x) ((if (spliceable? x)
cdr
list) (loop x))) (filter not-null-string? x)))
x)))
(module+ test
(require rackunit)
(check-equal? (splice '(@ 1 (@ 2 (@ 3 (div 4 (@ 5))) 6) 7))
'(@ 1 2 3 (div 4 5) 6 7))
(check-equal? (splice '((@ "foo" "bar"))) '("foo" "bar"))
(check-equal? (splice '(@ "foo" "bar")) '(@ "foo" "bar")) ; this is correct, for composable behavior
(check-equal? (splice '((div 1 (@ 2 "" (@ 3 (div 4 (@ 5))) 6) "" 7)))
'((div 1 2 3 (div 4 5) 6 7)))
(check-equal? (splice '((@ 1 (@ 2 "" (@ 3 (div 4 (@ 5))) 6) "" 7)))
'(1 2 3 (div 4 5) 6 7))
(check-equal? (splice '((@ "foo" "" "bar"))) '("foo" "bar"))
(check-equal? (splice null) null))

@ -8,6 +8,7 @@
"private/cache-utils.rkt"
"pagetree.rkt"
"template.rkt"
"core.rkt"
"private/rerequire.rkt"
"world.rkt")
@ -180,7 +181,7 @@
(parameterize ([current-pagetree (make-project-pagetree ,(world:current-project-root))])
(let ([,(world:current-main-export) (cached-doc ,(path->string source-path))]
[,(world:current-meta-export) (cached-metas ,(path->string source-path))])
(local-require pollen/template pollen/top)
(local-require pollen/template pollen/top pollen/core)
(define here (path->pagenode
(or (select-from-metas ',(world:current-here-path-key) ,(world:current-meta-export)) 'unknown)))
(cond

File diff suppressed because one or more lines are too long

@ -1,7 +1,7 @@
#lang scribble/manual
@(require scribble/bnf scribble/eval "utils.rkt" "mb-tools.rkt"
(for-syntax racket/base)
(for-label rackunit pollen/world pollen/render pollen/template (only-in scribble/reader
(for-label rackunit pollen/core pollen/world pollen/render pollen/template (only-in scribble/reader
use-at-readtable)))
@(define read-eval (make-base-eval))
@ -522,7 +522,7 @@ 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{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):
To make a meta, you create a tag with the special @racket[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

@ -0,0 +1,137 @@
#lang scribble/manual
@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/render txexpr xml pollen/pagetree sugar/coerce pollen/core pollen/world))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/core xml))
@title{Core}
@defmodule[pollen/core]
These functions are automatically imported into every Pollen source file (meaning, as if they had been included in your @filepath{pollen.rkt}).
@section{Syntactic forms}
@defform[(define-meta name value)]
Add @racket[_value] to the metas of the current document, using @racket[_name] as the key.
You can retrieve a meta value — even in the same document where you define it — with @racket[(select-from-metas _name metas)].
For an introduction to metas, see @secref["Inserting_metas"].
@defform[(when/splice condition pollen-args)]
If @racket[_condition] is true, put the @racket[_pollen-args] into the document. Within a template file, usually invoked like so:
@verbatim{◊when/splice[@racketvarfont{condition}]{The text to insert.}}
The inserted text can contain its own nested Pollen commands.
@racket[when/splice] can be more convenient than @racket[when], because @racket[when] will only use the last argument between the curly braces. @racket[when/splice], by contrast, treats everything between the curly braces as a block.
@section{Data helpers}
Functions for retrieving data out of Pollen source files. These are not the only options  you can, of course, use any of the usual Racket functions.
@defproc[
(get-doc
[doc-source (or/c pagenode? pathish?)])
(or/c txexpr? string?)]
Retrieve the @racket[doc] export from @racket[_doc-source], which can be either a path, path string, or pagenode that can be resolved into a source path. If @racket[_doc-source] cannot be resolved, raise an error.
If @racket[_doc-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
If @racket[world:current-main-export] has been overridden with a project-specific value, then that is retrieved instead.
@defproc[
(get-metas
[meta-source (or/c pagenode? pathish?)])
hash?]
Retrieve the @racket[metas] export from @racket[_meta-source], which can be either a path, path string, or pagenode that can be resolved into a source path. If @racket[_meta-source] cannot be resolved, raise an error.
If @racket[_meta-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
If @racket[world:current-meta-export] has been overridden with a project-specific value, then that is retrieved instead.
@deftogether[(
@defproc[
(select
[key symbolish?]
[value-source (or/c hash? txexpr? pagenode? pathish?)])
(or/c #f xexpr?)]
@defproc[
(select*
[key symbolish?]
[value-source (or/c hash? txexpr? pagenode? pathish?)])
(or/c #f (listof xexpr?))]
)]
Find matches for @racket[_key] in @racket[_value-source]. The @racket[_value-source] can be 1) a hashtable of @racket[metas], 2) a tagged X-expression representing a @racket[doc], or 3) a pagenode or path that identifies a source file that provides @racket[metas] and @racket[doc]. In that case, first look for @racket[_key] in @code{metas} (using @racket[select-from-metas]) and then in @code{doc} (using @racket[select-from-doc]).
With @racket[select], you get the first result; with @racket[select*], you get them all.
In both cases, you get @racket[#f] if there are no matches.
Note that if @racket[_value-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
@examples[#:eval my-eval
(module nut-butters pollen/markup
'(div (question "Flavor?")
(answer "Cashew") (answer "Almond")))
(code:comment @#,t{Import doc from 'nut-butters submodule})
(require 'nut-butters)
(select 'question doc)
(select 'answer doc)
(select* 'answer doc)
(select 'nonexistent-key doc)
(select* 'nonexistent-key doc)
]
@defproc[
(select-from-doc
[key symbolish?]
[doc-source (or/c txexpr? pagenodeish? pathish?)])
(or/c #f (listof xexpr?))]
Look up the value of @racket[_key] in @racket[_doc-source]. The @racket[_doc-source] argument can be either 1) a tagged X-expression representing a @racket[doc] or 2) a pagenode or source path that identifies a source file that provides @racket[doc]. If no value exists for @racket[_key], you get @racket[#f].
Note that if @racket[_doc-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
@examples[#:eval my-eval
(module gelato pollen/markup
'(div (question "Flavor?")
(answer "Nocciola") (answer "Pistachio")))
(code:comment @#,t{Import doc from 'gelato submodule})
(require 'gelato)
(select-from-doc 'question doc)
('answer . select-from-doc . doc)
(select-from-doc 'nonexistent-key doc)
]
@defproc[
(select-from-metas
[key symbolish?]
[meta-source (or/c hash? pagenodeish? pathish?)])
(or/c #f xexpr?)]
Look up the value of @racket[_key] in @racket[_meta-source]. The @racket[_meta-source] argument can be either 1) a hashtable representing @racket[metas] or 2) a pagenode or source path that identifies a source file that provides @racket[metas]. If no value exists for @racket[_key], you get @racket[#f].
Note that if @racket[_meta-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
@examples[#:eval my-eval
(define metas (hash 'template "sub.xml.pp" 'target "print"))
(select-from-metas 'template metas)
('target . select-from-metas . metas)
(select-from-metas 'nonexistent-key metas)
]

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

@ -5,6 +5,7 @@
@local-table-of-contents[]
@include-section["cache.scrbl"]
@include-section["core.scrbl"]
@include-section["decode.scrbl"]
@include-section["file.scrbl"]
@include-section["pagetree.scrbl"]

@ -1,6 +1,6 @@
#lang scribble/manual
@(require scribble/eval pollen/render pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world web-server/templates pollen/file sugar pollen/render))
@(require scribble/eval pollen/render pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/core web-server/templates pollen/file sugar pollen/render))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen))

File diff suppressed because one or more lines are too long

@ -11,117 +11,6 @@
Convenience functions for templates. These are automatically imported into the @racket[eval] environment when rendering with a template (see @racket[render]).
This module also re-exports everything from @racketmodname[pollen/template/html].
@defproc[
(get-doc
[doc-source (or/c pagenode? pathish?)])
(or/c txexpr? string?)]
Retrieve the @racket[doc] export from @racket[_doc-source], which can be either a path, path string, or pagenode that can be resolved into a source path. If @racket[_doc-source] cannot be resolved, raise an error.
If @racket[_doc-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
If @racket[world:current-main-export] has been overridden with a project-specific value, then that is retrieved instead.
@defproc[
(get-metas
[meta-source (or/c pagenode? pathish?)])
hash?]
Retrieve the @racket[metas] export from @racket[_meta-source], which can be either a path, path string, or pagenode that can be resolved into a source path. If @racket[_meta-source] cannot be resolved, raise an error.
If @racket[_meta-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
If @racket[world:current-meta-export] has been overridden with a project-specific value, then that is retrieved instead.
@deftogether[(
@defproc[
(select
[key symbolish?]
[value-source (or/c hash? txexpr? pagenode? pathish?)])
(or/c #f xexpr?)]
@defproc[
(select*
[key symbolish?]
[value-source (or/c hash? txexpr? pagenode? pathish?)])
(or/c #f (listof xexpr?))]
)]
Find matches for @racket[_key] in @racket[_value-source]. The @racket[_value-source] can be 1) a hashtable of @racket[metas], 2) a tagged X-expression representing a @racket[doc], or 3) a pagenode or path that identifies a source file that provides @racket[metas] and @racket[doc]. In that case, first look for @racket[_key] in @code{metas} (using @racket[select-from-metas]) and then in @code{doc} (using @racket[select-from-doc]).
With @racket[select], you get the first result; with @racket[select*], you get them all.
In both cases, you get @racket[#f] if there are no matches.
Note that if @racket[_value-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
@examples[#:eval my-eval
(module nut-butters pollen/markup
'(div (question "Flavor?")
(answer "Cashew") (answer "Almond")))
(code:comment @#,t{Import doc from 'nut-butters submodule})
(require 'nut-butters)
(select 'question doc)
(select 'answer doc)
(select* 'answer doc)
(select 'nonexistent-key doc)
(select* 'nonexistent-key doc)
]
@defproc[
(select-from-doc
[key symbolish?]
[doc-source (or/c txexpr? pagenodeish? pathish?)])
(or/c #f (listof xexpr?))]
Look up the value of @racket[_key] in @racket[_doc-source]. The @racket[_doc-source] argument can be either 1) a tagged X-expression representing a @racket[doc] or 2) a pagenode or source path that identifies a source file that provides @racket[doc]. If no value exists for @racket[_key], you get @racket[#f].
Note that if @racket[_doc-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
@examples[#:eval my-eval
(module gelato pollen/markup
'(div (question "Flavor?")
(answer "Nocciola") (answer "Pistachio")))
(code:comment @#,t{Import doc from 'gelato submodule})
(require 'gelato)
(select-from-doc 'question doc)
('answer . select-from-doc . doc)
(select-from-doc 'nonexistent-key doc)
]
@defproc[
(select-from-metas
[key symbolish?]
[meta-source (or/c hash? pagenodeish? pathish?)])
(or/c #f xexpr?)]
Look up the value of @racket[_key] in @racket[_meta-source]. The @racket[_meta-source] argument can be either 1) a hashtable representing @racket[metas] or 2) a pagenode or source path that identifies a source file that provides @racket[metas]. If no value exists for @racket[_key], you get @racket[#f].
Note that if @racket[_meta-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
@examples[#:eval my-eval
(define metas (hash 'template "sub.xml.pp" 'target "print"))
(select-from-metas 'template metas)
('target . select-from-metas . metas)
(select-from-metas 'nonexistent-key metas)
]
@defform[(when/splice condition pollen-args)]
If @racket[_condition] is true, put the @racket[_pollen-args] into the document. Within a template file, usually invoked like so:
@verbatim{◊when/splice[@racketvarfont{condition}]{The text to insert.}}
The inserted text can contain its own nested Pollen commands.
@racket[when/splice] can be more convenient than @racket[when], because @racket[when] will only use the last argument between the curly braces. @racket[when/splice], by contrast, treats everything between the curly braces as a block.
@section{HTML}

@ -1,15 +0,0 @@
<html>
<head>
<meta charset="UTF-8">
<title>◊select['h1 doc] by T. S. Eliot</title>
<link rel="stylesheet" type="text/css" media="all" href="styles.css" />
</head>
<body>◊->html[doc]
◊(define prev-page (previous here))
◊when/splice[prev-page]{
<div id="prev"><a href="◊|prev-page|">◊(select 'h1 prev-page)</a></div>}
◊(define next-page (next here))
◊when/splice[next-page]{
<div id="next"><a href="◊|next-page|">◊(select 'h1 next-page)</a></div>}
</body>
</html>

@ -1,6 +1,6 @@
#lang scribble/manual
@(require scribble/eval racket/date (for-label racket/file racket/system pollen/decode plot pollen/world pollen/tag racket/base pollen/template txexpr racket/list racket/string pollen/render))
@(require scribble/eval racket/date (for-label pollen/core racket/file racket/system pollen/decode plot pollen/world pollen/tag racket/base pollen/template txexpr racket/list racket/string pollen/render))
@(require "mb-tools.rkt")
@(define my-eval (make-base-eval))

@ -3,11 +3,4 @@
"template/base.rkt"
"template/html.rkt")
(provide (all-from-out "template/base.rkt"
"template/html.rkt"))
(module-test-external
(check-equal? (select* 'key '#hash((key . "value"))) '("value"))
(check-equal? (select 'key '#hash((key . "value"))) "value")
(define tx '(root (p "hello")))
(check-equal? (->html tx) "<root><p>hello</p></root>"))
"template/html.rkt"))

@ -1,115 +1,2 @@
#lang racket/base
(require (for-syntax racket/base "../world.rkt"))
(require racket/string xml xml/path sugar/define sugar/container sugar/coerce sugar/test racket/list)
(require "../file.rkt" txexpr "../world.rkt" "../cache.rkt" "../pagetree.rkt" "../private/debug.rkt")
(define is-meta-value? hash?)
(define is-doc-value? txexpr?)
(define not-false? (λ(x) x))
(define+provide/contract (select* key value-source)
(coerce/symbol? (or/c is-meta-value? is-doc-value? pagenode? pathish?) . -> . (or/c #f txexpr-elements?))
(define metas-result (and (not (is-doc-value? value-source)) (select-from-metas key value-source)))
(define doc-result (and (not (is-meta-value? value-source)) (select-from-doc key value-source)))
(define result (filter not-false? (apply append (map ->list (list metas-result doc-result)))))
(and (pair? result) result))
(define+provide/contract (select key value-source)
(coerce/symbol? (or/c is-meta-value? is-doc-value? pagenode? pathish?) . -> . (or/c #f txexpr-element?))
(define result (select* key value-source))
(and (pair? result) (car result)))
(module-test-external
(check-equal? (select* 'key '#hash((key . "value"))) '("value"))
(check-equal? (select 'key '#hash((key . "value"))) "value")
(check-false (select* 'absent-key '#hash((key . "value"))))
(check-false (select 'absent-key '#hash((key . "value"))))
(check-equal? (select* 'key '(root (key "value"))) '("value"))
(check-equal? (select 'key '(root (key "value"))) "value")
(check-false (select* 'absent-key '(root (key "value"))))
(check-false (select 'absent-key '(root (key "value"))))
(let ([metas '#hash((key . "value"))])
(check-equal? (select* 'key metas) '("value"))
(check-equal? (select 'key metas) "value")
(check-false (select* 'absent-key metas))
(check-false (select 'absent-key metas)))
(let ([doc '(root (key "value"))])
(check-equal? (select* 'key doc) '("value"))
(check-equal? (select 'key doc) "value")
(check-false (select* 'absent-key doc))
(check-false (select 'absent-key doc))))
(define+provide/contract (select-from-metas key metas-source)
;; output contract is a single txexpr-element
;; because metas is a hash, and a hash has only one value for a key.
(coerce/symbol? (or/c is-meta-value? pagenode? pathish?) . -> . (or/c #f txexpr-element?))
(define metas (if (is-meta-value? metas-source)
metas-source
(get-metas metas-source)))
(and (hash-has-key? metas key) (hash-ref metas key)))
(module-test-external
(let ([metas '#hash((key . "value"))])
(check-equal? (select-from-metas 'key metas) "value")
(check-false (select-from-metas 'absent-key metas))))
(define+provide/contract (select-from-doc key doc-source)
;; output contract is a list of elements
;; because doc is a txexpr, and a txexpr can have multiple values for a key
(coerce/symbol? (or/c is-doc-value? pagenode? pathish?) . -> . (or/c #f txexpr-elements?))
(define doc (if (is-doc-value? doc-source)
doc-source
(get-doc doc-source)))
(define result (se-path*/list (list key) doc))
(and (pair? result) result))
(module-test-external
(check-equal? (select-from-doc 'key '(root (key "value"))) '("value"))
(check-false (select-from-doc 'absent-key '(root (key "value"))))
(let ([doc '(root (key "value"))])
(check-equal? (select-from-doc 'key doc) '("value"))
(check-false (select-from-doc 'absent-key doc))))
(define (convert+validate-path pagenode-or-path caller)
(let ([path (get-source (if (pagenode? pagenode-or-path)
(build-path (world:current-project-root) (symbol->string pagenode-or-path))
pagenode-or-path))])
(unless path
(error (format "~a no source found for '~a' in directory ~a" caller path (current-directory))))
path))
(define+provide/contract (get-metas pagenode-or-path)
((or/c pagenode? pathish?) . -> . is-meta-value?)
(cached-metas (convert+validate-path pagenode-or-path 'get-metas)))
(define+provide/contract (get-doc pagenode-or-path)
((or/c pagenode? pathish?) . -> . (or/c is-doc-value? string?))
(cached-doc (convert+validate-path pagenode-or-path 'get-doc)))
(provide when/splice)
(define-syntax (when/splice stx)
(syntax-case stx ()
[(_ COND BODY ...)
(with-syntax ([SPLICING-TAG (datum->syntax stx (world:current-splicing-tag))])
#'(if COND
(with-handlers ([exn:fail? (λ(exn) (error (format "within when/block, ~a" (exn-message exn))))])
(list 'SPLICING-TAG BODY ...))
""))]))
(provide when/block) ; bw compat
(define-syntax (when/block stx)
(syntax-case stx ()
[(_ condition body ...)
#'(if condition (string-append*
(with-handlers ([exn:fail? (λ(exn) (error (format "within when/block, ~a" (exn-message exn))))])
(map ->string (list body ...))))
"")]))
;; empty for now

@ -0,0 +1,22 @@
#lang racket/base
(require rackunit)
;; check that automatic imports of pollen/core are present.
(module markup pollen/markup
(define-meta zing "bam")
(select 'zing metas))
(require (prefix-in markup: 'markup))
(check-equal? markup:doc '(root "bam"))
(module pre pollen/pre
(define-meta zing "bam")
(select 'zing metas))
(require (prefix-in pre: 'pre))
(check-equal? pre:doc "bam")
(module markdown pollen/markdown
(define-meta zing "bam")
(select 'zing metas))
(require (prefix-in markdown: 'markdown))
(check-equal? markdown:doc '(root (p () "bam")))

@ -2,19 +2,16 @@
(require rackunit)
(module markup pollen/markup
(require pollen/template)
"Hello" (when #t (@ "Splice")) (when/splice #t "Splice") "World")
"Hello" (when #t (@ "Splice")) "" (when/splice #t "Splice") "World")
(require (prefix-in markup: 'markup))
(check-equal? markup:doc '(root "Hello" "Splice" "Splice" "World"))
(module pre pollen/pre
(require pollen/template)
"Hello" (when #t (@ "Splice")) (when/splice #t "Splice") "World")
"Hello" (when #t (@ "Splice")) "" (when/splice #t "Splice") "World")
(require (prefix-in pre: 'pre))
(check-equal? pre:doc "HelloSpliceSpliceWorld")
(module markdown pollen/markdown
(require pollen/template)
"Hello" (when #t (@ "Splice")) (when/splice #t "Splice") "World")
"Hello" (when #t (@ "Splice")) "" (when/splice #t "Splice") "World")
(require (prefix-in markdown: 'markdown))
(check-equal? markdown:doc '(root (p () "HelloSpliceSpliceWorld")))

Loading…
Cancel
Save