diff --git a/pollen/core.rkt b/pollen/core.rkt index 94e5776..beed70f 100644 --- a/pollen/core.rkt +++ b/pollen/core.rkt @@ -1,12 +1,18 @@ #lang racket/base -(require (for-syntax racket/base "setup.rkt" "private/splice.rkt")) -(require txexpr/base xml/path sugar/define sugar/coerce sugar/test racket/string) -(require "private/file-utils.rkt" +(require (for-syntax + racket/base + "setup.rkt") + racket/match + txexpr/base + xml/path + sugar/define + sugar/coerce + sugar/test + "private/file-utils.rkt" "setup.rkt" "cache.rkt" "pagetree.rkt" - "tag.rkt" - "private/splice.rkt") + "tag.rkt") (define is-meta-value? hash?) (define is-doc-value? txexpr?) @@ -22,15 +28,15 @@ ((coerce/symbol? (or/c is-meta-value? is-doc-value? pagenode? pathish?)) (symbol?) . ->* . (or/c #f txexpr-elements?)) (define metas-result (and (not (is-doc-value? value-source)) (select-from-metas key value-source caller))) (define doc-result (and (not (is-meta-value? value-source)) (select-from-doc key value-source caller))) - (define result (filter values (apply append (map ->list (list metas-result doc-result))))) - (and (pair? result) result)) - + (match (filter values (apply append (map ->list (list metas-result doc-result)))) + [(? pair? res) res] + [_ #false])) (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 'select)) - (and (pair? result) (car result))) - + (match (select* key value-source 'select) + [(cons res _) res] + [_ #false])) (module-test-external (check-equal? (select* 'key '#hash((key . "value"))) '("value")) @@ -52,31 +58,28 @@ (check-false (select* 'absent-key doc)) (check-false (select 'absent-key doc)))) - (define+provide/contract (select-from-metas key metas-source [caller 'select-from-metas]) ;; 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?)) (symbol?) . ->* . (or/c #f txexpr-element?)) - (define metas (if (is-meta-value? metas-source) - metas-source - (get-metas metas-source caller))) - (and (hash-has-key? metas key) (hash-ref metas key))) + (hash-ref (match metas-source + [(? is-meta-value? ms) ms] + [_ (get-metas metas-source caller)]) key #false)) (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 [caller 'select-from-doc]) ;; 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?)) (symbol?) . ->* . (or/c #f txexpr-elements?)) - (define doc (if (is-doc-value? doc-source) - doc-source - (get-doc doc-source caller))) - (define result (se-path*/list (list key) doc)) - (and (pair? result) result)) + (match (se-path*/list (list key) (match doc-source + [(? is-doc-value?) doc-source] + [_ (get-doc doc-source caller)])) + [(? pair? result) result] + [_ #false])) (module-test-external (check-equal? (select-from-doc 'key '(root (key "value"))) '("value")) @@ -85,27 +88,23 @@ (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 (if (pagenode? pagenode-or-path) + (define path (if (pagenode? pagenode-or-path) (build-path (current-project-root) (symbol->string pagenode-or-path)) - pagenode-or-path)] - [path (or (get-source path) path)]) - (unless (file-exists? path) - (raise-argument-error caller "existing Pollen source, or name of its output path" path)) - path)) - + pagenode-or-path)) + (define src-path (or (get-source path) path)) + (unless (file-exists? src-path) + (raise-argument-error caller "existing Pollen source, or name of its output path" src-path)) + src-path) (define+provide/contract (get-metas pagenode-or-path [caller 'get-metas]) (((or/c pagenode? pathish?)) (symbol?) . ->* . is-meta-value?) (cached-metas (convert+validate-path pagenode-or-path caller))) - (define+provide/contract (get-doc pagenode-or-path [caller 'get-doc]) (((or/c pagenode? pathish?)) (symbol?) . ->* . (or/c is-doc-value? string?)) (cached-doc (convert+validate-path pagenode-or-path caller))) - ;; This `@` definition is here to provide a hook for the docs. ;; But this is just default tag behavior, and thus would work without the definition. ;; Which is why the splicing tag can be renamed: @@ -125,7 +124,6 @@ (SPLICING-TAG . BODY) (SPLICING-TAG)))])) - (provide for/splice for*/splice) (define-syntax (for/splice/base stx) @@ -141,6 +139,5 @@ (syntax-case stx () [(_ . BODY) (syntax-property #'(for/splice/base . BODY) 'form #'for*/list)])) - (provide when/block) ; bw compat (define-syntax when/block (make-rename-transformer #'when/splice)) \ No newline at end of file diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd index 469b7e5..935c68b 100644 --- a/pollen/private/ts.rktd +++ b/pollen/private/ts.rktd @@ -1 +1 @@ -1540858426 +1540858428