change pollen language to export a hash called 'metas (rather than storing metas as xexprs within main)

pull/9/head
Matthew Butterick 11 years ago
parent 40d71e4f67
commit b5a5e731a1

@ -114,44 +114,8 @@
;; test for well-formed meta
(define/contract (meta-xexpr? x)
(any/c . -> . boolean?)
(match x
[`(meta ,(? string? key) ,(? string? value)) #t]
[else #f]))
(module+ test
(check-true (meta-xexpr? '(meta "key" "value")))
(check-false (meta-xexpr? '(meta "key" "value" "foo")))
(check-false (meta-xexpr? '(meta))))
;; function to strip metas (or any tag)
(define/contract (extract-tag-from-xexpr tag nx)
(xexpr-tag? tagged-xexpr? . -> . (values tagged-xexpr? xexpr-elements?))
(define matches '())
(define (extract-tag x)
(cond
[(and (tagged-xexpr? x) (equal? tag (car x)))
; stash matched tag but return empty value
(begin
(set! matches (cons x matches))
empty)]
[(tagged-xexpr? x) (let-values([(tag attr body) (break-tagged-xexpr x)])
(make-tagged-xexpr tag attr (extract-tag body)))]
[(xexpr-elements? x) (filter-not empty? (map extract-tag x))]
[else x]))
(values (extract-tag nx) (reverse matches)))
(module+ test
(define x '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2")
(em "goodnight" "moon" (meta "foo3" "bar3"))))
(check-equal? (values->list (extract-tag-from-xexpr 'meta x))
(list '(root "hello" "world" (em "goodnight" "moon"))
'((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3")))))
;; decoder wireframe
(define/contract (decode nx
#:exclude-xexpr-tags [excluded-xexpr-tags '()]
@ -160,8 +124,7 @@
#:xexpr-elements-proc [xexpr-elements-proc (λ(x)x)]
#:block-xexpr-proc [block-xexpr-proc (λ(x)x)]
#:inline-xexpr-proc [inline-xexpr-proc (λ(x)x)]
#:string-proc [string-proc (λ(x)x)]
#:meta-proc [meta-proc (λ(x)x)])
#:string-proc [string-proc (λ(x)x)])
;; use xexpr/c for contract because it gives better error messages
((xexpr/c) (#:exclude-xexpr-tags (λ(i) (or (symbol? i) (list? i)))
#:xexpr-tag-proc procedure?
@ -169,8 +132,7 @@
#:xexpr-elements-proc procedure?
#:block-xexpr-proc procedure?
#:inline-xexpr-proc procedure?
#:string-proc procedure?
#:meta-proc procedure?)
#:string-proc procedure?)
. ->* . tagged-xexpr?)
(when (not (tagged-xexpr? nx))
(error (format "decode: ~v not a full tagged-xexpr" nx)))
@ -193,6 +155,4 @@
[else x]))
(let-values ([(nx metas) (extract-tag-from-xexpr 'meta nx)])
(append (&decode nx) (map meta-proc metas))))
(&decode nx))

@ -1,5 +1,5 @@
#lang racket/base
(require racket/match)
(require racket/list)
(require (planet mb/pollen/tools) (planet mb/pollen/main-helper))
(provide (except-out (all-from-out racket/base) #%module-begin)
(rename-out [module-begin #%module-begin]))
@ -43,25 +43,43 @@
(require 'pollen-inner) ; provides doc & #%top, among other things
;; prepare the elements, and append inner-here as meta.
(define all-elements (append
(cond
;; doc is probably a list, but might be a single string
[(string? doc) (list doc)]
[(tagged-xexpr? doc) (list doc)] ; if it's a single nx, just leave it
[(list? doc) doc]) ; if it's nx content, splice it in
(list `(meta "here" ,inner-here)))) ; append inner-here as meta
;; split out the metas now (in raw form)
(define-values (main-raw metas-raw)
(extract-tag-from-xexpr 'meta (make-tagged-xexpr 'irrelevant-tag empty all-elements)))
;; Policy: here in the core lang, do as little to main as possible.
;; The point is just to set it up for further processing.
;; One of the annoyances of Scribble is its insistence on decoding.
;; Better just to pass through the minimally processed data.
;; Root is treated as a function.
;; If it's not defined elsewhere, it just hits #%top and becomes a tagged-xexpr.
(define main (apply root
(append
(cond
[(string? doc) (list doc)] ; doc is probably a list, but might be a single string
[(tagged-xexpr? doc) (list doc)] ; if it's a single nx, just leave it
[(list? doc) doc]) ; if it's nx content, splice it in
(list `(meta "here" ,inner-here))))) ; append inner-here as meta
(define main (apply root (tagged-xexpr-elements main-raw)))
(provide main
(define metas (make-meta-hash metas-raw))
(provide main metas
(except-out (all-from-out 'pollen-inner) inner-here) ; everything from user
(rename-out (inner-here here))) ; change identifier back (now safe from macrofication)
(module+ main
(displayln ";-------------------------")
(displayln "; pollen decoded 'main")
(displayln ";-------------------------")
main
(displayln "")
(displayln (format "tagged-xexpr? ~a" (tagged-xexpr? main))))))
(displayln (format "(tagged-xexpr? main) ~a" (tagged-xexpr? main)))
(displayln "")
(displayln ";-------------------------")
(displayln "; pollen 'metas")
(displayln ";-------------------------")
metas
)))

@ -16,6 +16,7 @@ We
Goodnight
moon
foo

@ -13,14 +13,6 @@
;; handle meta tags
(define/contract (meta-proc meta)
(meta-xexpr? . -> . tagged-xexpr?)
`(meta ((name ,(second meta))(content ,(third meta)))))
(module+ test
(check-equal? (meta-proc '(meta "key" "value")) '(meta ((name "key")(content "value")))))
;; is x a paragraph break?
(define/contract (paragraph-break? x #:pattern [paragraph-pattern #px"^\n\n+$"])
((any/c) (#:pattern pregexp?) . ->* . boolean?)
@ -234,9 +226,7 @@
#:xexpr-elements-proc xexpr-elements-proc
#:block-xexpr-proc block-xexpr-proc
; #:inline-xexpr-proc [inline-xexpr-proc (λ(x)x)]
#:string-proc string-proc
#:meta-proc meta-proc
))
#:string-proc string-proc))
(define foo "bar")

@ -94,6 +94,7 @@
[else #f]))
(module+ test
(check-true (xexpr-attr? empty))
(check-true (xexpr-attr? '((key "value"))))
(check-true (xexpr-attr? '((key "value") (foo "bar"))))
(check-false (xexpr-attr? '((key "value") "foo" "bar"))) ; content, not attr
@ -184,6 +185,9 @@
(check-equal? (make-xexpr-attr '((foo "bar")(goo "gar")) "foo" "haw") '((foo "haw")(goo "gar"))))
;; create tagged-xexpr from parts (opposite of break-tagged-xexpr)
(define/contract (make-tagged-xexpr name [attr empty] [content empty])
((symbol?) (xexpr-attr? xexpr-elements?) . ->* . tagged-xexpr?)
@ -301,3 +305,53 @@
(module+ test
(check-equal? (map-tree (λ(i) (if (number? i) (* 2 i) i)) '(p 1 2 3 (em 4 5))) '(p 2 4 6 (em 8 10)))
(check-equal? (map-tree (λ(i) (if (symbol? i) 'foo i)) '(p 1 2 3 (em 4 5))) '(foo 1 2 3 (foo 4 5))))
;; function to strip metas (or any tag)
(define/contract (extract-tag-from-xexpr tag nx)
(xexpr-tag? tagged-xexpr? . -> . (values tagged-xexpr? xexpr-elements?))
(define matches '())
(define (extract-tag x)
(cond
[(and (tagged-xexpr? x) (equal? tag (car x)))
; stash matched tag but return empty value
(begin
(set! matches (cons x matches))
empty)]
[(tagged-xexpr? x) (let-values([(tag attr body) (break-tagged-xexpr x)])
(make-tagged-xexpr tag attr (extract-tag body)))]
[(xexpr-elements? x) (filter-not empty? (map extract-tag x))]
[else x]))
(values (extract-tag nx) (reverse matches)))
(module+ test
(define x '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2")
(em "goodnight" "moon" (meta "foo3" "bar3"))))
(check-equal? (values->list (extract-tag-from-xexpr 'meta x))
(list '(root "hello" "world" (em "goodnight" "moon"))
'((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3")))))
;; test for well-formed meta
(define/contract (meta-xexpr? x)
(any/c . -> . boolean?)
(match x
[`(meta ,(? string? key) ,(? string? value)) #t]
[else #f]))
(module+ test
(check-true (meta-xexpr? '(meta "key" "value")))
(check-false (meta-xexpr? '(meta "key" "value" "foo")))
(check-false (meta-xexpr? '(meta))))
;; convert list of meta tags to a hash for export from pollen document.
;; every meta is form (meta "key" "value") (enforced by contract)
(define/contract (make-meta-hash mxs)
((listof meta-xexpr?) . -> . hash?)
(apply hash (append-map tagged-xexpr-elements mxs)))
(module+ test
(check-equal? (make-meta-hash '((meta "foo" "bar")(meta "hee" "haw")))
(hash "foo" "bar" "hee" "haw")))

Loading…
Cancel
Save