diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd index 80744ab..0bb44fa 100644 --- a/pollen/private/ts.rktd +++ b/pollen/private/ts.rktd @@ -1 +1 @@ -1474935027 +1475977524 diff --git a/pollen/scribblings/convert.scrbl b/pollen/scribblings/convert.scrbl new file mode 100644 index 0000000..b32845a --- /dev/null +++ b/pollen/scribblings/convert.scrbl @@ -0,0 +1,68 @@ +#lang scribble/manual + +@(require scribble/eval pollen/decode pollen/setup txexpr (for-label pollen/unstable/convert pollen/setup txexpr racket (except-in pollen #%module-begin))) + +@(define my-eval (make-base-eval)) +@(my-eval `(require pollen pollen/unstable/convert)) +@(require "mb-tools.rkt") + + +@title{Convert} + +@defmodule[pollen/unstable/convert] + +Helper functions for converting well-made X-expressions or HTML into Pollen markup. + +@defproc[ +(xexpr->pollen +[x xexpr?] +[#:white-p? white-p? boolean? #f] +) +string?] +Convert @racket[_x] to Pollen markup, using @racket[setup:command-char] as the leading character. If @racket[_white-p?] is @racket[#t], convert @racket[p] tags by taking the content out of the tag, and inserting @racket[setup:paragraph-separator] in front. + +@examples[#:eval my-eval +(xexpr->pollen '(div)) +(xexpr->pollen '(div ((class "pups")))) +(xexpr->pollen '(div ((class "pups")) "Lex")) +(xexpr->pollen '(div ((class "pups")) (p "Roxy") (p "Sidney"))) +(xexpr->pollen #:white-p? #t '(div ((class "pups")) (p "Roxy") (p "Sidney"))) +] + +@defproc[ +(html->pollen +[html string?] +[#:white-p? white-p? boolean? #f] +) +string?] +Convert @racket[_html] to Pollen markup, using @racket[setup:command-char] as the leading character. If @racket[_white-p?] is @racket[#t], convert @racket[p] tags by taking the content out of the tag, and inserting @racket[setup:paragraph-separator] in front. + +@examples[#:eval my-eval +(html->pollen "
") +(html->pollen "
") +(html->pollen "
Lex
") +(html->pollen "

Roxy

Sidney

") +(html->pollen #:white-p? #t "

Roxy

Sidney

") +] + +This function treats @racket[_html] as an XML-ish data structure. Meaning, @racket[_html] is expected to be syntactically well-formed (in terms of attributes and tags). But it doesn't need to comply with a certain HTML specification. This casual approach suffices in most cases. Be aware, however, that this function won't handle HTML @racket[style] or @racket[script] blocks correctly, if they contain reserved XML characters. + +@examples[#:eval my-eval +(html->pollen "") +(html->pollen "") +] + +But if the interiors of the @racket[style] or @racket[script] blocks are wrapped with @racket[CDATA] designations, they will convert correctly: + +@examples[#:eval my-eval +(html->pollen "") +(html->pollen "") +] + +@defproc[ +(url->pollen +[url (or/c string? url?)] +[#:white-p? white-p? boolean? #f] +) +string?] +Like @racket[html->pollen], but takes a @racket[_url] as input and fetches its HTML. diff --git a/pollen/scribblings/unstable-module-reference.scrbl b/pollen/scribblings/unstable-module-reference.scrbl index 576a3f7..2fe2dd3 100644 --- a/pollen/scribblings/unstable-module-reference.scrbl +++ b/pollen/scribblings/unstable-module-reference.scrbl @@ -8,3 +8,4 @@ An ``unstable'' module is safe to use. But it's not part of the settled public i @include-section["pygments.scrbl"] @include-section["typography.scrbl"] +@include-section["convert.scrbl"] diff --git a/pollen/unstable/convert.rkt b/pollen/unstable/convert.rkt index 9228920..5a0c625 100644 --- a/pollen/unstable/convert.rkt +++ b/pollen/unstable/convert.rkt @@ -1,32 +1,61 @@ #lang racket/base -(require sugar txexpr/base racket/list racket/string pollen/setup xml html racket/file racket/match "html.rkt" net/url racket/port) +(require sugar + txexpr/base + racket/list + racket/string + pollen/setup + xml + html + racket/match + "html.rkt" + pollen/unstable/typography + net/url + racket/port) -(define (attrs->pollen attrs) - (string-join (flatten (map (λ(pair) (list (format "#:~a" (car pair)) (format "\"~a\"" (cadr pair)))) attrs)) " ")) +(module+ test + (require rackunit)) +(define (attrs->pollen-attrs attrs) + (string-join (for*/list ([attr (in-list attrs)] + [k (in-value (car attr))] + [v (in-value (cadr attr))]) + (format "#:~a ~v" k v)) " ")) -(define/contract+provide (xexpr->pollen x #:p-breaks [p-breaks #f]) - ((xexpr?) (#:p-breaks boolean?) . ->* . string?) - +(define/contract+provide (xexpr->pollen x #:white-p? [white-p? #f]) + ((xexpr?) (#:white-p? boolean?) . ->* . string?) (let loop ([x x]) (cond - [(and p-breaks (txexpr? x) (equal? (car x) 'p) (empty? (get-attrs x)) (apply string-append `("\n" ,@(map ->string (map loop (get-elements x))) "\n")))] + [(and white-p? (txexpr? x) (eq? (car x) 'p) (empty? (get-attrs x)) + (string-append* (list* (setup:paragraph-separator) (map ->string (map loop (get-elements x))))))] [(and (txexpr? x) (or (not (empty? (get-attrs x))) (not (empty? (get-elements x))))) - (apply string-append - (map ->string `(,(setup:command-char) ,(get-tag x) - ,@(if (not (null? (get-attrs x))) `("[" ,(attrs->pollen (get-attrs x)) "]") null) - ,@(if (not (null? (get-elements x))) `("{" ,@(map loop (get-elements x)) "}" ) null))))] - [(txexpr? x) - ;; no attrs or tag, so needs parens + (string-append* (map ->string `(,(setup:command-char) + ,(get-tag x) + ,@(if (pair? (get-attrs x)) `("[" ,(attrs->pollen-attrs (get-attrs x)) "]") null) + ,@(if (pair? (get-elements x)) `("{" ,@(map loop (get-elements x)) "}" ) null))))] + [(txexpr? x) ; no attrs or tag, so needs parens (format "~a(~a)" (setup:command-char) (get-tag x))] [(symbol? x) (loop (entity->integer x))] [(number? x) (format "~a" (integer->char x))] [else x]))) +(module+ test + (check-equal? (xexpr->pollen '(p "You are puppy")) "◊p{You are puppy}") + (check-equal? (xexpr->pollen '(div (p "You are puppy") (p "You are kitty"))) "◊div{◊p{You are puppy}◊p{You are kitty}}") + (check-equal? (xexpr->pollen #:white-p? #t '(div (p "You are puppy") (p "You are kitty"))) "◊div{ -(define/contract+provide (html->xexpr html-string) +You are puppy + +You are kitty}") + (check-equal? (xexpr->pollen '(p ((class "foo")) "You are puppy")) "◊p[#:class \"foo\"]{You are puppy}") + (check-equal? (xexpr->pollen '(p)) "◊(p)") + (check-equal? (xexpr->pollen '(p ((class "foo")) "You are " (em "so") " puppy")) "◊p[#:class \"foo\"]{You are ◊em{so} puppy}")) + +(define (conjoin . fs) + (λ(x) (andmap (λ(f) (f x)) fs))) + +(define/contract (html->xexpr html-string) (string? . -> . xexpr?) (use-html-spec #f) (define xexpr-results @@ -40,24 +69,24 @@ [else (format "unknown item: ~a" elem)]))) ; xexpr-results will be a list with whitespace elements, so strip those out - (car (filter-not (λ(x) (and (string? x) (regexp-match #px"\\s+" x))) xexpr-results))) + (car (filter-not (conjoin string? whitespace?) xexpr-results))) + +(module+ test + (define (hx-identity xexpr) + (equal? (html->xexpr (xexpr->html xexpr)) xexpr)) + (check-true (hx-identity '(p "You are puppy"))) + (check-true (hx-identity '(p ((class "foo")) "You are puppy"))) + (check-true (hx-identity '(p))) + (check-true (hx-identity '(p ((class "foo")) "You are " (em "so") " puppy")))) -(define/contract+provide (html->pollen html-string #:p-breaks [p-breaks #f]) - ((string?) (#:p-breaks boolean?) . ->* . string?) - (xexpr->pollen #:p-breaks p-breaks (html->xexpr html-string))) +(define/contract+provide (html->pollen html-string #:white-p? [white-p? #f]) + ((string?) (#:white-p? boolean?) . ->* . string?) + (xexpr->pollen #:white-p? white-p? (html->xexpr html-string))) -(define/contract+provide (url->pollen url-or-string #:p-breaks [p-breaks #f]) - (((or/c string? url?)) (#:p-breaks boolean?) . ->* . string?) +(define/contract+provide (url->pollen url-or-string #:white-p? [white-p? #f]) + (((or/c string? url?)) (#:white-p? boolean?) . ->* . string?) (define url (if (string? url-or-string) (string->url url-or-string) url-or-string)) (define url-result (port->string (get-pure-port url))) - (html->pollen url-result #:p-breaks p-breaks)) - -(module+ main - ; (xexpr->pollen '(p "You are puppy")) - ; (xexpr->pollen '(p ((class "foo")) "You are puppy")) - ; (xexpr->pollen '(p ((class "foo")) "You are" "\n\n" "puppy")) - ; (xexpr->pollen '(p ((class "foo")) "You are " (em "so") " puppy")) - ; (display (html->pollen #:p-breaks #t (file->string "index.html")))) -) \ No newline at end of file + (html->pollen url-result #:white-p? white-p?))