From 40f0a7096596fac27159e1a287034cc7d20d9a41 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 19 Feb 2014 13:52:44 -0800 Subject: [PATCH] update to work with revised txexpr module --- decode.rkt | 46 +++++++++++++++++++++++----------------------- info.rkt | 3 ++- main-imports.rkt | 4 ++-- main.rkt | 12 ++++++------ predicates.rkt | 8 ++++---- ptree.rkt | 6 +++--- server-routes.rkt | 8 ++++---- template.rkt | 29 +++++++++++++++-------------- tools.rkt | 16 ++++++++-------- top.rkt | 2 +- 10 files changed, 68 insertions(+), 66 deletions(-) diff --git a/decode.rkt b/decode.rkt index bc88992..3a349f4 100644 --- a/decode.rkt +++ b/decode.rkt @@ -1,7 +1,7 @@ #lang racket/base (require racket/contract racket/list racket/string racket/match) (require (only-in xml xexpr/c)) -(require "tools.rkt" "predicates.rkt" sugar tagged-xexpr) +(require "tools.rkt" "predicates.rkt" sugar txexpr) (module+ test (require rackunit)) @@ -39,25 +39,25 @@ #:block-xexpr-proc procedure? #:inline-xexpr-proc procedure? #:string-proc procedure?) - . ->* . tagged-xexpr?) - (when (not (tagged-xexpr? nx)) - (error (format "decode: ~v not a full tagged-xexpr" nx))) + . ->* . txexpr?) + (when (not (txexpr? nx)) + (error (format "decode: ~v not a full txexpr" nx))) (define (&decode x) (cond - [(tagged-xexpr? x) (let-values([(tag attr elements) (tagged-xexpr->values x)]) + [(txexpr? x) (let-values([(tag attr elements) (txexpr->values x)]) (if (tag . in? . excluded-xexpr-tags) x ; let x pass through untouched - (let ([decoded-xexpr (apply make-tagged-xexpr + (let ([decoded-xexpr (apply make-txexpr (map &decode (list tag attr elements)))]) ((if (block-xexpr? decoded-xexpr) block-xexpr-proc inline-xexpr-proc) decoded-xexpr))))] - [(tagged-xexpr-tag? x) (xexpr-tag-proc x)] - [(tagged-xexpr-attrs? x) (xexpr-attrs-proc x)] + [(txexpr-tag? x) (xexpr-tag-proc x)] + [(txexpr-attrs? x) (xexpr-attrs-proc x)] ;; need this for operations that may depend on context in list - [(tagged-xexpr-elements? x) (map &decode (xexpr-elements-proc x))] + [(txexpr-elements? x) (map &decode (xexpr-elements-proc x))] [(string? x) (string-proc x)] ;; if something has made it through undecoded, that's a problem [else (error "Can't decode" x)])) @@ -118,7 +118,7 @@ (define/contract (nonbreaking-last-space x #:nbsp [nbsp (->string #\u00A0)] #:minimum-word-length [minimum-word-length 6]) - ((tagged-xexpr?) (#:nbsp string? #:minimum-word-length integer?) . ->* . tagged-xexpr?) + ((txexpr?) (#:nbsp string? #:minimum-word-length integer?) . ->* . txexpr?) ;; todo: parameterize this, as it will be different for each project (define tags-to-pay-attention-to '(p aside)) ; only apply to paragraphs @@ -139,11 +139,11 @@ (define (find-last-word-space x) ; recursively traverse xexpr (cond [(string? x) (replace-last-space x)] - [(tagged-xexpr? x) - (let-values([(tag attr elements) (tagged-xexpr->values x)]) + [(txexpr? x) + (let-values([(tag attr elements) (txexpr->values x)]) (if (> (length elements) 0) ; elements is list of xexprs (let-values ([(all-but-last last) (split-at elements (sub1 (length elements)))]) - (make-tagged-xexpr tag attr `(,@all-but-last ,(find-last-word-space (car last))))) + (make-txexpr tag attr `(,@all-but-last ,(find-last-word-space (car last))))) x))] [else x])) @@ -167,10 +167,10 @@ (define/contract (wrap-hanging-quotes nx #:single-prepend [single-pp '(squo)] #:double-prepend [double-pp '(dquo)]) - ((tagged-xexpr?) (#:single-prepend list? #:double-prepend list?) . ->* . tagged-xexpr?) + ((txexpr?) (#:single-prepend list? #:double-prepend list?) . ->* . txexpr?) (define two-or-more-char-string? (λ(i) (and (string? i) (>= (len i) 2)))) - (define-values (tag attr elements) (tagged-xexpr->values nx)) - (make-tagged-xexpr tag attr + (define-values (tag attr elements) (txexpr->values nx)) + (make-txexpr tag attr (if (and (list? elements) (not (empty? elements))) (let ([new-car-elements (match (car elements) [(? two-or-more-char-string? tcs) @@ -184,7 +184,7 @@ [(str-first . in? . '("\'" "‘")) `(,@single-pp ,(->string #\‘) ,str-rest)] [else tcs])] - [(? tagged-xexpr? nx) (wrap-hanging-quotes nx)] + [(? txexpr? nx) (wrap-hanging-quotes nx)] [else (car elements)])]) (cons new-car-elements (cdr elements))) elements))) @@ -196,7 +196,7 @@ (check-equal? (wrap-hanging-quotes '(p "'Hi' there")) '(p (squo "‘" "Hi' there"))) (check-equal? (wrap-hanging-quotes '(p "'Hi' there") #:single-prepend '(foo ((bar "ino")))) '(p (foo ((bar "ino")) "‘" "Hi' there"))) - ;; make sure tagged-xexpr without elements passes through unscathed + ;; make sure txexpr without elements passes through unscathed (check-equal? (wrap-hanging-quotes '(div ((style "height:2em")))) '(div ((style "height:2em"))))) @@ -209,7 +209,7 @@ ;; turn the right items into
tags (define/contract (convert-linebreaks xc #:newline [newline "\n"]) - ((tagged-xexpr-elements?) (#:newline string?) . ->* . tagged-xexpr-elements?) + ((txexpr-elements?) (#:newline string?) . ->* . txexpr-elements?) ;; todo: should this test be not block + not whitespace? (define not-block? (λ(i) (not (block-xexpr? i)))) (filter-not empty? @@ -292,7 +292,7 @@ ;; prepare elements for paragraph testing (define/contract (prep-paragraph-flow xc) - (tagged-xexpr-elements? . -> . tagged-xexpr-elements?) + (txexpr-elements? . -> . txexpr-elements?) (convert-linebreaks (merge-newlines (trim xc whitespace?)))) (module+ test @@ -301,10 +301,10 @@ ;; apply paragraph tag (define/contract (wrap-paragraph xc #:tag [tag 'p]) - ((tagged-xexpr-elements?) (#:tag symbol?) . ->* . block-xexpr?) + ((txexpr-elements?) (#:tag symbol?) . ->* . block-xexpr?) (match xc [(list (? block-xexpr? bx)) bx] ; leave a single block xexpr alone - [else (make-tagged-xexpr tag empty xc)])) ; otherwise wrap in p tag + [else (make-txexpr tag empty xc)])) ; otherwise wrap in p tag (module+ test (check-equal? (wrap-paragraph '("foo" "bar")) '(p "foo" "bar")) @@ -317,7 +317,7 @@ ;; detect paragraphs ;; todo: unit tests (define/contract (detect-paragraphs elements) - (tagged-xexpr-elements? . -> . tagged-xexpr-elements?) + (txexpr-elements? . -> . txexpr-elements?) (let ([elements (prep-paragraph-flow elements)]) (if (ormap paragraph-break? elements) ; need this condition to prevent infinite recursion (map wrap-paragraph (splitf-at* elements paragraph-break?)) ; split into ¶¶ diff --git a/info.rkt b/info.rkt index 5da2b5f..66a7791 100644 --- a/info.rkt +++ b/info.rkt @@ -1,3 +1,4 @@ #lang info (define collection "pollen") -(define scribblings '(("scribblings/pollen.scrbl" ()))) \ No newline at end of file +(define scribblings '(("scribblings/pollen.scrbl" ()))) +(define deps '("txexpr" "sugar")) \ No newline at end of file diff --git a/main-imports.rkt b/main-imports.rkt index d364e61..a7d4f6e 100644 --- a/main-imports.rkt +++ b/main-imports.rkt @@ -8,7 +8,7 @@ pollen/tools pollen/main-helper pollen/top - tagged-xexpr + txexpr sugar (only-in pollen/ptree ptree-source-decode path->pnode ptree?)) @@ -16,6 +16,6 @@ pollen/tools pollen/main-helper pollen/top - tagged-xexpr + txexpr sugar pollen/ptree)) \ No newline at end of file diff --git a/main.rkt b/main.rkt index 3aff03d..754af55 100644 --- a/main.rkt +++ b/main.rkt @@ -26,7 +26,7 @@ ;; and why doesn't this work: ;; (require pollen/main-imports) ;; (provide (all-from-out pollen/main-imports)) - (require pollen/tools pollen/main-helper pollen/top pollen/ptree sugar tagged-xexpr) + (require pollen/tools pollen/main-helper pollen/top pollen/ptree sugar txexpr) (require-and-provide-extras) ; brings in the project require files expr ... ; body of module @@ -50,14 +50,14 @@ ;; doc is probably a list, but might be a single string [(string? doc) (list doc)] ;; if it's a single nx, just leave it - [(tagged-xexpr? doc) (list doc)] + [(txexpr? doc) (list doc)] ;; if it's nx content, splice it in [(list? doc) doc])))) ;; split out the metas now (in raw form) (define-values (metas-raw main-raw) - ((bound/c split-tag-from-xexpr) 'meta (make-tagged-xexpr 'irrelevant-tag empty all-elements))) + ((bound/c split-tag-from-xexpr) 'meta (make-txexpr 'irrelevant-tag empty all-elements))) (define metas (make-meta-hash metas-raw)) @@ -80,8 +80,8 @@ ;; ... but other files, including pollen, will go this way. ;; Root is treated as a function. ;; If it's not defined elsewhere, - ;; it just hits #%top and becomes a tagged-xexpr. - root) ((bound/c tagged-xexpr-elements) main-raw))) + ;; it just hits #%top and becomes a txexpr. + root) ((bound/c get-elements) main-raw))) (provide main metas here @@ -97,7 +97,7 @@ (if here-is-ptree? (displayln (format "(ptree? main) ~a" (ptree? main))) - (displayln (format "(tagged-xexpr? main) ~a" (tagged-xexpr? main)))) + (displayln (format "(txexpr? main) ~a" (txexpr? main)))) (displayln "") (displayln ";-------------------------") (displayln "; pollen 'metas") diff --git a/predicates.rkt b/predicates.rkt index ce62d4e..6b0e81b 100644 --- a/predicates.rkt +++ b/predicates.rkt @@ -1,6 +1,6 @@ #lang racket/base (require racket/contract racket/match racket/set) -(require css-tools/html sugar tagged-xexpr) +(require css-tools/html sugar txexpr) (require "world.rkt" "file-tools.rkt" "debug.rkt") (provide (all-from-out "file-tools.rkt")) @@ -16,15 +16,15 @@ (define project-block-tags block-tags) (define+provide/contract (append-block-tag tag) - (tagged-xexpr-tag? . -> . void?) + (txexpr-tag? . -> . void?) (set! project-block-tags (cons tag project-block-tags))) -;; is the tagged-xexpr a block element (as opposed to inline) +;; is the txexpr a block element (as opposed to inline) ;; tags are inline unless they're registered as block tags. (define+provide/contract (block-xexpr? x) (any/c . -> . boolean?) ;; (car x) = shorthand for tag of xexpr - ((tagged-xexpr? x) . and . ((car x) . in? . project-block-tags))) + ((txexpr? x) . and . ((car x) . in? . project-block-tags))) ;; recursive whitespace test diff --git a/ptree.rkt b/ptree.rkt index 2cd4021..3187dde 100644 --- a/ptree.rkt +++ b/ptree.rkt @@ -1,6 +1,6 @@ #lang racket/base (require racket/contract racket/match racket/path xml/path racket/bool racket/rerequire) -(require "tools.rkt" "world.rkt" "debug.rkt" "decode.rkt" sugar tagged-xexpr) +(require "tools.rkt" "world.rkt" "debug.rkt" "decode.rkt" sugar txexpr) (module+ test (require rackunit)) @@ -28,7 +28,7 @@ (define/contract (ptree? x) (any/c . -> . boolean?) - (and (tagged-xexpr? x) (andmap (λ(i) (or (pnode? i) (ptree? i))) x))) + (and (txexpr? x) (andmap (λ(i) (or (pnode? i) (ptree? i))) x))) (module+ test (check-true (ptree? '(foo))) @@ -207,7 +207,7 @@ ;; this sets default input for following functions (define/contract (ptree-root->ptree tx) ;; (not/c ptree) prevents ptrees from being accepted as input - ((and/c tagged-xexpr?) . -> . ptree?) + ((and/c txexpr?) . -> . ptree?) tx) diff --git a/server-routes.rkt b/server-routes.rkt index f962749..fb13cc7 100644 --- a/server-routes.rkt +++ b/server-routes.rkt @@ -5,7 +5,7 @@ (require web-server/http/request-structs) (require web-server/http/response-structs) (require 2htdp/image) -(require "world.rkt" "render.rkt" sugar tagged-xexpr "predicates.rkt" "debug.rkt" "ptree.rkt") +(require "world.rkt" "render.rkt" sugar txexpr "predicates.rkt" "debug.rkt" "ptree.rkt") (module+ test (require rackunit)) @@ -54,7 +54,7 @@ ;; extract main xexpr from a path (define/contract (file->xexpr path #:render [wants-render #t]) - ((complete-path?) (#:render boolean?) . ->* . tagged-xexpr?) + ((complete-path?) (#:render boolean?) . ->* . txexpr?) (when wants-render (render path)) (dynamic-rerequire path) ; stores module mod date; reloads if it's changed (dynamic-require path 'main)) @@ -74,11 +74,11 @@ (check-equal? (slurp (build-path (current-directory) "tests/server-routes/bar.html") #:render #f) "

bar

")) -;; add a wrapper to tagged-xexpr that displays it as monospaced text +;; add a wrapper to txexpr that displays it as monospaced text ;; for "view source"ish functions ;; takes either a string or an xexpr (define/contract (format-as-code x) - (xexpr? . -> . tagged-xexpr?) + (xexpr? . -> . txexpr?) (body-wrapper `(tt ,x))) diff --git a/template.rkt b/template.rkt index 304a718..5c20bc7 100644 --- a/template.rkt +++ b/template.rkt @@ -1,11 +1,12 @@ #lang racket/base (require racket/contract racket/string xml xml/path) -(require "tools.rkt" "ptree.rkt" sugar/scribble sugar/coerce sugar tagged-xexpr) +(require "tools.rkt" "ptree.rkt" sugar txexpr) ;; setup for test cases (module+ test (require rackunit racket/path)) (provide (all-defined-out)) +(require sugar/scribble sugar/coerce) (provide (all-from-out sugar/scribble sugar/coerce)) ;; todo: better fallback template @@ -16,7 +17,7 @@ (define/contract (puttable-item? x) (any/c . -> . boolean?) - (or (tagged-xexpr? x) + (or (txexpr? x) (has-decoder-source? x) (and (pnode? x) (pnode->url x) (has-decoder-source? (pnode->url x))))) @@ -29,10 +30,10 @@ (or (string? x) (symbol? x))) (define/contract (put x) - (puttable-item? . -> . tagged-xexpr?) + (puttable-item? . -> . txexpr?) (cond - ;; Using put has no effect on tagged-xexprs. It's here to make the idiom smooth. - [(tagged-xexpr? x) x] + ;; Using put has no effect on txexprs. It's here to make the idiom smooth. + [(txexpr? x) x] [(has-decoder-source? x) (dynamic-require (->decoder-source-path x) 'main)] [(has-decoder-source? (pnode->url x)) (dynamic-require (->decoder-source-path (pnode->url x)) 'main)])) @@ -44,7 +45,7 @@ (define/contract (find query px) - (query-key? (or/c #f puttable-item?) . -> . (or/c #f tagged-xexpr-element?)) + (query-key? (or/c #f puttable-item?) . -> . (or/c #f txexpr-element?)) (define result (and px (or (find-in-metas px query) (find-in-main px query)))) (and result (car result))) ;; return false or first element @@ -58,7 +59,7 @@ |# (define/contract (find-in-metas px key) - (puttable-item? query-key? . -> . (or/c #f tagged-xexpr-elements?)) + (puttable-item? query-key? . -> . (or/c #f txexpr-elements?)) (and (has-decoder-source? px) (let ([metas (dynamic-require (->decoder-source-path px) 'metas)] [key (->string key)]) @@ -74,7 +75,7 @@ (define/contract (find-in-main px query) (puttable-item? (or/c query-key? (listof query-key?)) - . -> . (or/c #f tagged-xexpr-elements?)) + . -> . (or/c #f txexpr-elements?)) (let* ([px (put px)] ;; make sure query is a list of symbols (required by se-path*/list) [query (map ->symbol (->list query))] @@ -90,15 +91,15 @@ |# ;; turns input into xexpr-elements so they can be spliced into template -;; (as opposed to dropped in as a full tagged-xexpr) +;; (as opposed to dropped in as a full txexpr) ;; by returning a list, pollen rules will automatically merge into main flow ;; todo: explain why ;; todo: do I need this? (define/contract (splice x) - ((or/c tagged-xexpr? tagged-xexpr-elements? string?) . -> . tagged-xexpr-elements?) + ((or/c txexpr? txexpr-elements? string?) . -> . txexpr-elements?) (cond - [(tagged-xexpr? x) (tagged-xexpr-elements x)] - [(tagged-xexpr-elements? x) x] + [(txexpr? x) (get-elements x)] + [(txexpr-elements? x) x] [(string? x) (->list x)])) (module+ test @@ -108,9 +109,9 @@ (define/contract (make-html x) - ((or/c tagged-xexpr? tagged-xexpr-elements? tagged-xexpr-element?) . -> . string?) + ((or/c txexpr? txexpr-elements? txexpr-element?) . -> . string?) (cond - [(tagged-xexpr? x) (xexpr->string x)] + [(txexpr? x) (xexpr->string x)] [else (let ([x (->list x)]) (string-join (map xexpr->string x) ""))])) diff --git a/tools.rkt b/tools.rkt index 6d5bac5..885ccb4 100644 --- a/tools.rkt +++ b/tools.rkt @@ -1,6 +1,6 @@ #lang racket/base (require racket/contract racket/list) -(require tagged-xexpr sugar "debug.rkt" "predicates.rkt" "world.rkt") +(require txexpr sugar "debug.rkt" "predicates.rkt" "world.rkt") (provide (all-from-out "debug.rkt" "predicates.rkt" racket/list)) ;; setup for test cases @@ -21,7 +21,7 @@ ;; later metas with the same name will override earlier ones. (define+provide/contract (make-meta-hash mxs) ((listof meta-xexpr?) . -> . hash?) - (apply hash (append-map tagged-xexpr-elements mxs))) + (apply hash (append-map get-elements mxs))) (module+ test (check-equal? (make-meta-hash '((meta "foo" "bar")(meta "hee" "haw"))) @@ -31,20 +31,20 @@ -;; function to split tag out of tagged-xexpr +;; function to split tag out of txexpr (define+provide/contract (split-tag-from-xexpr tag tx) - (xexpr-tag? tagged-xexpr? . -> . (values (listof xexpr-element?) tagged-xexpr? )) + (txexpr-tag? txexpr? . -> . (values (listof txexpr-element?) txexpr? )) (define matches '()) (define (extract-tag x) (cond - [(and (tagged-xexpr? x) (equal? tag (car x))) + [(and (txexpr? 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) (tagged-xexpr->values x)]) - (make-tagged-xexpr tag attr (extract-tag body)))] - [(xexpr-elements? x) (filter-not empty? (map extract-tag x))] + [(txexpr? x) (let-values([(tag attr body) (txexpr->values x)]) + (make-txexpr tag attr (extract-tag body)))] + [(txexpr-elements? x) (filter-not empty? (map extract-tag x))] [else x])) (define tx-extracted (extract-tag tx)) ;; do this first to fill matches (values (reverse matches) tx-extracted)) diff --git a/top.rkt b/top.rkt index a893fdd..3c31a15 100644 --- a/top.rkt +++ b/top.rkt @@ -2,7 +2,7 @@ ;; Changes the default behavior of #%top. ;; Unbound identifiers are allowed, and treated as the -;; tag in a tagged-xexpr (with the rest of the expression treated as the body) +;; tag in a txexpr (with the rest of the expression treated as the body) ;; To suppress this behavior, use bound/c to wrap any name. ;; If that name isn't already defined, you'll get the usual syntax error.