add documentation for `pollen/unstable/convert`

pollen/private/ts.rktd

@@ -1 +1 @@
-1474935027
+1475977524

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 "<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.

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"]

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)
+(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])
     (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 
+       (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))]
       [(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])
+(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-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"))))
-)