diff --git a/decode.rkt b/decode.rkt index f755f93..62cbbdd 100644 --- a/decode.rkt +++ b/decode.rkt @@ -5,6 +5,7 @@ (require (only-in racket/format ~a)) (require (only-in racket/bool nor)) (require (only-in xml xexpr/c)) +(require (prefix-in scribble: (only-in scribble/decode whitespace?))) (module+ test (require rackunit)) (require "tools.rkt" "library/html.rkt") @@ -51,7 +52,7 @@ ;; todo: make sure this is what I want. ;; this is, however, more consistent with browser behavior ;; (browsers assume that tags are inline by default) - (as-boolean (in block-tags (named-xexpr-name nx)))) + (->boolean (in block-tags (named-xexpr-name nx)))) (module+ test (check-true (block-xexpr? '(p "foo"))) @@ -59,13 +60,50 @@ (check-false (block-xexpr? '(em "foo"))) (check-false (block-xexpr? '(barfoo "foo")))) -;; start here Tues 6 + +(define (stringify x) ; convert numbers to strings + (map-tree (λ(i) (if (number? i) (->string i) i)) x)) + +(module+ test + (check-equal? (stringify '(p 1 2 "foo" (em 4 "bar"))) '(p "1" "2" "foo" (em "4" "bar")))) + + + +; trim from beginning & end of list +(define (trim items test-proc) + (dropf-right (dropf items test-proc) test-proc)) + +(module+ test + (check-equal? (trim (list "\n" " " 1 2 3 "\n") whitespace?) '(1 2 3)) + (check-equal? (trim (list 1 3 2 4 5 6 8 9 13) odd?) '(2 4 5 6 8))) + +;; recursive whitespace test +;; Scribble's version misses whitespace in a list +(define (whitespace? x) + (cond + [(list? x) (andmap whitespace? x)] + [else (scribble:whitespace? x)])) + +(module+ test + (check-false (scribble:whitespace? (list "\n" " " "\n"))) ; scribble result is too surprising + (check-true (whitespace? " ")) + (check-false (whitespace? "foo")) + (check-false (whitespace? " ")) ; a nonbreaking space + (check-true (whitespace? "\n \n")) + (check-true (whitespace? (list "\n" " " "\n"))) + (check-true (whitespace? (list "\n" " " "\n" (list "\n" "\n"))))) + + ;; default content decoder for pollen (define/contract (decode nx) - ;; use xexpr/c for contact because it gives better error messages + ;; use xexpr/c for contract because it gives better error messages (xexpr/c . -> . named-xexpr?) - nx + ;; weds aug 7: start here + (define (&decode x) + x) + + (&decode nx) ) ;(decode `(p ((key "value")) ,decode)) diff --git a/main-helper.rkt b/main-helper.rkt index a441c4a..52836cd 100644 --- a/main-helper.rkt +++ b/main-helper.rkt @@ -22,7 +22,7 @@ (build-path start_dir EXTRAS_DIR name)) (define files (map make-complete-path (filter (λ(i) (has-ext? i 'rkt)) (directory-list EXTRAS_DIR)))) (define files-in-require-form - (map (λ(file) `(file ,(as-string file))) files)) + (map (λ(file) `(file ,(->string file))) files)) (datum->syntax stx (if provide `(begin @@ -55,7 +55,7 @@ [(equal? 'pollen-lang-module ccr) 'nowhere] [else ccr])]) (match-let-values ([(_ here-name _) (split-path ccr)]) - (as-string (remove-all-ext here-name))))))) + (->string (remove-all-ext here-name))))))) (module+ test (check-equal? (get-here) "main-helper")) diff --git a/readability.rkt b/readability.rkt index 8a510c7..1305172 100644 --- a/readability.rkt +++ b/readability.rkt @@ -10,7 +10,7 @@ (provide (all-defined-out)) ;; general way of coercing to string -(define/contract (as-string x) +(define/contract (->string x) (any/c . -> . string?) (cond [(string? x) x] @@ -22,23 +22,23 @@ [else (error (format "Can't make ~a into string" x))])) (module+ test - (check-equal? (as-string "foo") "foo") - (check-equal? (as-string '()) "") - (check-equal? (as-string 'foo) "foo") - (check-equal? (as-string 123) "123") + (check-equal? (->string "foo") "foo") + (check-equal? (->string '()) "") + (check-equal? (->string 'foo) "foo") + (check-equal? (->string 123) "123") (define file-name-as-text "foo.txt") - (check-equal? (as-string (string->path file-name-as-text)) file-name-as-text) - (check-equal? (as-string #\¶) "¶")) + (check-equal? (->string (string->path file-name-as-text)) file-name-as-text) + (check-equal? (->string #\¶) "¶")) ;; general way of coercing to symbol -(define (as-symbol thing) +(define (->symbol thing) ; todo: on bad input, it will pop a string error rather than symbol error - (string->symbol (as-string thing))) + (string->symbol (->string thing))) ;; general way of coercing to a list -(define (as-list x) +(define (->list x) (any/c . -> . list?) (cond [(list? x) x] @@ -46,24 +46,24 @@ [else (list x)])) (module+ test - (check-equal? (as-list '(1 2 3)) '(1 2 3)) - (check-equal? (as-list (list->vector '(1 2 3))) '(1 2 3)) - (check-equal? (as-list "foo") (list "foo"))) + (check-equal? (->list '(1 2 3)) '(1 2 3)) + (check-equal? (->list (list->vector '(1 2 3))) '(1 2 3)) + (check-equal? (->list "foo") (list "foo"))) ;; general way of coercing to boolean -(define (as-boolean x) +(define (->boolean x) (any/c . -> . boolean?) ;; in Racket, everything but #f is true (if x #t #f)) (module+ test - (check-true (as-boolean #t)) - (check-false (as-boolean #f)) - (check-true (as-boolean "#f")) - (check-true (as-boolean "foo")) - (check-true (as-boolean '())) - (check-true (as-boolean '(1 2 3)))) + (check-true (->boolean #t)) + (check-false (->boolean #f)) + (check-true (->boolean "#f")) + (check-true (->boolean "foo")) + (check-true (->boolean '())) + (check-true (->boolean '(1 2 3)))) @@ -73,7 +73,7 @@ (cond [(list? x) (length x)] [(string? x) (string-length x)] - [(symbol? x) (len (as-string x))] + [(symbol? x) (len (->string x))] [(vector? x) (vector-length x)] [(hash? x) (len (hash-keys x))] [else #f])) @@ -93,39 +93,41 @@ ;; general way of fetching an item from a container -(define/contract (get container item [up-to #f]) +(define/contract (get container start [end #f]) ((any/c any/c) ((λ(i)(or (integer? i) (and (symbol? i) (equal? i 'end))))) . ->* . any/c) (define (sliceable-container? container) (ormap (λ(proc) (proc container)) (list list? string? vector?))) - (when (sliceable-container? container) - (set! up-to - (cond - ;; treat negative lengths as offset from end (Python style) - [(and (integer? up-to) (< up-to 0)) (+ (len container) up-to)] - ;; 'end slices to the end - [(equal? up-to 'end) (len container)] - ;; default to slice length of 1 (i.e, single-item retrieval) - [(equal? up-to #f) (add1 item)] - [else up-to]))) + (set! end + (if (sliceable-container? container) + (cond + ;; treat negative lengths as offset from end (Python style) + [(and (integer? end) (< end 0)) (+ (len container) end)] + ;; 'end slices to the end + [(equal? end 'end) (len container)] + ;; default to slice length of 1 (i.e, single-item retrieval) + [(equal? end #f) (add1 start)] + [else end]) + end)) (define result (cond ;; for sliceable containers, make a slice - [(list? container) (for/list ([i (range item up-to)]) + [(list? container) (for/list ([i (range start end)]) (list-ref container i))] - [(vector? container) (for/vector ([i (range item up-to)]) + [(vector? container) (for/vector ([i (range start end)]) (vector-ref container i))] - [(string? container) (substring container item up-to)] - [(symbol? container) (as-symbol (get (as-string container) item up-to))] + [(string? container) (substring container start end)] + [(symbol? container) (->symbol (get (->string container) start end))] ;; for hash, just get item - [(hash? container) (hash-ref container item)] + [(hash? container) (let ([hash-key start]) + (hash-ref container hash-key))] [else #f])) ;; don't return single-item results inside a list (if (and (sliceable-container? result) (= (len result) 1)) - (car (as-list result)) + (car (->list result)) result)) (module+ test @@ -155,13 +157,13 @@ [(vector? container) (vector-member item container)] ; returns #f or zero-based item index [(hash? container) (and (hash-has-key? container item) (get container item))] ; returns #f or hash value - [(string? container) (let ([result (in (map as-string (string->list container)) (as-string item))]) + [(string? container) (let ([result (in (map ->string (string->list container)) (->string item))]) (if result (string-join result "") #f))] ; returns #f or substring beginning with item - [(symbol? container) (let ([result (in (as-string container) (as-string item))]) + [(symbol? container) (let ([result (in (->string container) (->string item))]) (if result - (as-symbol result) + (->symbol result) result))] ; returns #f or subsymbol (?!) beginning with item [else #f])) diff --git a/tests/requires/include-me.rkt b/tests/requires/include-me.rkt index e13a984..12551e4 100644 --- a/tests/requires/include-me.rkt +++ b/tests/requires/include-me.rkt @@ -8,9 +8,6 @@ (define (root . items) (named-xexpr? . -> . named-xexpr?) - `(root ,@(merge-newlines items))) - -(module+ test - (check-equal? (root "foo" "\n" "\n") '(root "foo" "\n\n"))) + (decode `(root ,@items))) (define foo "bar") \ No newline at end of file diff --git a/tools.rkt b/tools.rkt index df69395..45e4aa1 100644 --- a/tools.rkt +++ b/tools.rkt @@ -23,7 +23,7 @@ (define/contract (has-ext? path ext) (path? symbol? . -> . boolean?) (define ext-of-path (filename-extension path)) - (and ext-of-path (equal? (bytes->string/utf-8 ext-of-path) (as-string ext)))) + (and ext-of-path (equal? (bytes->string/utf-8 ext-of-path) (->string ext)))) (module+ test (check-false (has-ext? foo-path 'txt)) @@ -211,4 +211,14 @@ (check-equal? (filter-not-tree string? '(p "foo" (p "bar"))) '(p (p)))) +(define/contract (map-tree proc tree) + (procedure? list? . -> . list?) + (cond + [(list? tree) (map (λ(i) (map-tree proc i)) tree)] + [else (proc tree)])) + +(module+ test + (check-equal? (map-tree (λ(i) (if (number? i) (* 2 i) i)) '(p 1 2 3 (em 4 5))) '(p 2 4 6 (em 8 10))) + (check-equal? (map-tree (λ(i) (if (symbol? i) 'foo i)) '(p 1 2 3 (em 4 5))) '(foo 1 2 3 (foo 4 5)))) +