add url->pollen function

pull/9/head
Matthew Butterick 11 years ago
parent 372c4775f7
commit 8743a1b8c5

@ -1,5 +1,5 @@
#lang racket/base #lang racket/base
(require sugar txexpr racket/list racket/string pollen/world xml html racket/file racket/match pollen/html) (require sugar txexpr racket/list racket/string pollen/world xml html racket/file racket/match pollen/html net/url racket/port)
(define (attrs->pollen attrs) (define (attrs->pollen attrs)
(string-join (flatten (map (λ(pair) (list (format "'~a:" (car pair)) (format "\"~a\"" (cadr pair)))) attrs)) " ")) (string-join (flatten (map (λ(pair) (list (format "'~a:" (car pair)) (format "\"~a\"" (cadr pair)))) attrs)) " "))
@ -13,8 +13,8 @@
[(and p-breaks (txexpr? x) (equal? (car x) 'p) (apply string-append `("\n" ,@(map ->string (map loop (get-elements x))) "\n")))] [(and p-breaks (txexpr? x) (equal? (car x) 'p) (apply string-append `("\n" ,@(map ->string (map loop (get-elements x))) "\n")))]
[(txexpr? x) (apply string-append [(txexpr? x) (apply string-append
(map ->string `(,world:command-marker ,(get-tag x) (map ->string `(,world:command-marker ,(get-tag x)
,@(if (not (null? (get-attrs x))) `("[" ,(attrs->pollen (get-attrs x)) "]") null) ,@(if (not (null? (get-attrs x))) `("[" ,(attrs->pollen (get-attrs x)) "]") null)
,@(if (not (null? (get-elements x))) `("{" ,@(map loop (get-elements x)) "}" ) null))))] ,@(if (not (null? (get-elements x))) `("{" ,@(map loop (get-elements x)) "}" ) null))))]
[(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])))
@ -37,10 +37,17 @@
; 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
(xexpr->pollen #:p-breaks p-breaks (car (filter-not (λ(x) (and (string? x) (regexp-match #px"\\s+" x))) xexpr-results)))) (xexpr->pollen #:p-breaks p-breaks (car (filter-not (λ(x) (and (string? x) (regexp-match #px"\\s+" x))) xexpr-results))))
(define/contract+provide (url->pollen url-or-string #:p-breaks [p-breaks #f])
(((or/c string? url?)) (#:p-breaks 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 (module+ main
; (xexpr->pollen '(p "You are puppy")) ; (xexpr->pollen '(p "You are puppy"))
; (xexpr->pollen '(p ((class "foo")) "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" "\n\n" "puppy"))
; (xexpr->pollen '(p ((class "foo")) "You are " (em "so") " puppy")) ; (xexpr->pollen '(p ((class "foo")) "You are " (em "so") " puppy"))
; (display (html->pollen #:p-breaks #t (file->string "index.html")))) ; (display (html->pollen #:p-breaks #t (file->string "index.html"))))
) )
Loading…
Cancel
Save