add documentation for `pollen/unstable/convert`

pull/131/head
Matthew Butterick 8 years ago
parent 792f1438e4
commit 45300dbef6

@ -1 +1 @@
1474935027 1475977524

@ -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 "<hr />")
(html->pollen "<div class=\"pups\" />")
(html->pollen "<div class=\"pups\">Lex</div>")
(html->pollen "<div class=\"pups\"><p>Roxy</p><p>Sidney</p></div>")
(html->pollen #:white-p? #t "<div class=\"pups\"><p>Roxy</p><p>Sidney</p></div>")
]
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 "<script type=\"javascript\">x < 3</script>")
(html->pollen "<style type=\"css\">div{content: \"<&>\";}</style>")
]
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 "<script type=\"javascript\"><![CDATA[x < 3]]></script>")
(html->pollen "<style type=\"css\"><![CDATA[div{content: \"<&>\";}]]></style>")
]
@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.

@ -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["pygments.scrbl"]
@include-section["typography.scrbl"] @include-section["typography.scrbl"]
@include-section["convert.scrbl"]

@ -1,32 +1,61 @@
#lang racket/base #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) (module+ test
(string-join (flatten (map (λ(pair) (list (format "#:~a" (car pair)) (format "\"~a\"" (cadr pair)))) attrs)) " ")) (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]) (define/contract+provide (xexpr->pollen x #:white-p? [white-p? #f])
((xexpr?) (#:p-breaks boolean?) . ->* . string?) ((xexpr?) (#:white-p? boolean?) . ->* . string?)
(let loop ([x x]) (let loop ([x x])
(cond (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) [(and (txexpr? x)
(or (not (empty? (get-attrs x))) (or (not (empty? (get-attrs x)))
(not (empty? (get-elements x))))) (not (empty? (get-elements x)))))
(apply string-append (string-append* (map ->string `(,(setup:command-char)
(map ->string `(,(setup:command-char) ,(get-tag x) ,(get-tag x)
,@(if (not (null? (get-attrs x))) `("[" ,(attrs->pollen (get-attrs x)) "]") null) ,@(if (pair? (get-attrs x)) `("[" ,(attrs->pollen-attrs (get-attrs x)) "]") null)
,@(if (not (null? (get-elements x))) `("{" ,@(map loop (get-elements x)) "}" ) null))))] ,@(if (pair? (get-elements x)) `("{" ,@(map loop (get-elements x)) "}" ) null))))]
[(txexpr? x) [(txexpr? x) ; no attrs or tag, so needs parens
;; no attrs or tag, so needs parens
(format "~a(~a)" (setup:command-char) (get-tag x))] (format "~a(~a)" (setup:command-char) (get-tag x))]
[(symbol? x) (loop (entity->integer x))] [(symbol? x) (loop (entity->integer x))]
[(number? x) (format "~a" (integer->char x))] [(number? x) (format "~a" (integer->char x))]
[else 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?) (string? . -> . xexpr?)
(use-html-spec #f) (use-html-spec #f)
(define xexpr-results (define xexpr-results
@ -40,24 +69,24 @@
[else (format "unknown item: ~a" elem)]))) [else (format "unknown item: ~a" elem)])))
; xexpr-results will be a list with whitespace elements, so strip those out ; 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]) (define/contract+provide (html->pollen html-string #:white-p? [white-p? #f])
((string?) (#:p-breaks boolean?) . ->* . string?) ((string?) (#:white-p? boolean?) . ->* . string?)
(xexpr->pollen #:p-breaks p-breaks (html->xexpr html-string))) (xexpr->pollen #:white-p? white-p? (html->xexpr html-string)))
(define/contract+provide (url->pollen url-or-string #:p-breaks [p-breaks #f]) (define/contract+provide (url->pollen url-or-string #:white-p? [white-p? #f])
(((or/c string? url?)) (#:p-breaks boolean?) . ->* . string?) (((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 (if (string? url-or-string) (string->url url-or-string) url-or-string))
(define url-result (port->string (get-pure-port url))) (define url-result (port->string (get-pure-port url)))
(html->pollen url-result #:p-breaks p-breaks)) (html->pollen url-result #:white-p? white-p?))
(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"))))
)

Loading…
Cancel
Save