tues eve

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))

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

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

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

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))))
+