From b5a5e731a10ea0cb9db0633718b26846d0b20c7d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 16 Aug 2013 18:15:25 -0700 Subject: [PATCH] change pollen language to export a hash called 'metas (rather than storing metas as xexprs within main) --- decode.rkt | 46 ++-------------------------- main.rkt | 38 +++++++++++++++++------- tests/pollen-lang-test.p | 1 + tests/requires/include-me.rkt | 12 +------- tools.rkt | 56 ++++++++++++++++++++++++++++++++++- 5 files changed, 88 insertions(+), 65 deletions(-) diff --git a/decode.rkt b/decode.rkt index 01e3359..08100cf 100644 --- a/decode.rkt +++ b/decode.rkt @@ -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)) diff --git a/main.rkt b/main.rkt index de298f0..2b36535 100644 --- a/main.rkt +++ b/main.rkt @@ -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 + ))) diff --git a/tests/pollen-lang-test.p b/tests/pollen-lang-test.p index f9e535d..f74617b 100644 --- a/tests/pollen-lang-test.p +++ b/tests/pollen-lang-test.p @@ -16,6 +16,7 @@ We Goodnight moon + ◊foo diff --git a/tests/requires/include-me.rkt b/tests/requires/include-me.rkt index df9c9bb..441e4fc 100644 --- a/tests/requires/include-me.rkt +++ b/tests/requires/include-me.rkt @@ -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") \ No newline at end of file diff --git a/tools.rkt b/tools.rkt index 51983ee..2f8cfa8 100644 --- a/tools.rkt +++ b/tools.rkt @@ -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?) @@ -254,7 +258,7 @@ (module+ test (check-equal? (remove-attrs '(p ((foo "bar")) "hi")) '(p "hi")) (check-equal? (remove-attrs '(p ((foo "bar")) "hi" (p ((foo "bar")) "hi"))) '(p "hi" (p "hi")))) - + ;; apply filter proc recursively (define/contract (filter-tree proc tree) @@ -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")))