hmm

decode.rkt

@@ -71,7 +71,7 @@
 ;; tags are inline unless they're registered as block tags.
 (define/contract (block-xexpr? x)
   (any/c . -> . boolean?)
-  ((tagged-xexpr? x) . and . (->boolean ((tagged-xexpr-tag x) . in . block-tags))))
+  ((tagged-xexpr? x) . and . (->boolean ((tagged-xexpr-tag x) . in? . block-tags))))
 
 (module+ test
   (check-true (block-xexpr? '(p "foo")))
@@ -180,7 +180,7 @@
   (define (&decode x)
     (cond
       [(tagged-xexpr? x) (let-values([(tag attr elements) (break-tagged-xexpr x)]) 
-                           (if (tag . in . (->list excluded-xexpr-tags))    
+                           (if (tag . in? . (->list excluded-xexpr-tags))    
                                x
                                (let ([decoded-xexpr 
                                       (apply make-tagged-xexpr (map &decode (list tag attr elements)))])

main.rkt

@@ -1,8 +1,6 @@
 #lang racket/base
 (require racket/match)
-(require (planet mb/pollen/tools)
-         (planet mb/pollen/main-helper))
-
+(require (planet mb/pollen/tools) (planet mb/pollen/main-helper))
 (provide (except-out (all-from-out racket/base) #%module-begin)
          (rename-out [module-begin #%module-begin]))
 
@@ -25,8 +23,7 @@
    (module pollen-inner (planet mb/pollen/doclang2_raw)
      ; use same requires as top of main.rkt 
      ; (can't import them from surrounding module due to submodule rules)
-     (require (planet mb/pollen/tools)
-              (planet mb/pollen/main-helper))
+     (require (planet mb/pollen/tools) (planet mb/pollen/main-helper))
      (require-extras #:provide #t) ; brings in the project require files
      
      ; #%top binding catches ids that aren't defined
@@ -65,6 +62,6 @@
             (rename-out (inner-here here))) ; change identifier back (now safe from macrofication)
    
    (module+ main
-     (print main)
+     main
      (displayln "")
      (displayln (format "tagged-xexpr? ~a" (tagged-xexpr? main)))))) 

map.rkt

@@ -1,18 +1,22 @@
 #lang racket/base
-(require xml xml/path racket/list racket/string racket/contract racket/match)
-;; todo: why is this require here?
-(require (except-in web-server/templates in))
-(require "tools.rkt" "world.rkt")
+(require xml xml/path racket/list racket/string racket/contract racket/match racket/set)
+(require "tools.rkt" "world.rkt" "decode.rkt")
+
+(require "tests/test.pmap")
+;(require "tests/pollen-lang-test.p")
 
 (module+ test (require rackunit))
 
 (module+ test
-  (define tt (main->tree (dynamic-require "tests/test.pmap" POLLEN_ROOT))))
+  main
+;  (define tt (main->tree (dynamic-require "tests/test.pmap" POLLEN_ROOT))))
+ ) 
 
 ; get the values out of the file, or make them up
 (define map-file (build-path START_DIR DEFAULT_MAP))
 (define map-main empty)
 
+
 ;; todo: this ain't a function
 (if (file-exists? map-file)
     ; load it, or ...
@@ -26,7 +30,9 @@
 ;; all names must be unique
 (define/contract (map-tree? x)
   (any/c . -> . boolean?)
-  (tagged-xexpr? x))
+  (and (tagged-xexpr? x) 
+       (let ([locations (map ->string (flatten (filter-not-tree whitespace? (remove-attrs x))))])
+         (= (len (apply set locations)) (len locations)))))
 
 ;; recursively processes tree, converting map locations & their parents into xexprs of this shape:
 ;; '(location ((parent "parent")))
@@ -51,13 +57,9 @@
 
 ;; remove parents from tree (i.e., just remove attrs)
 ;; is not the inverse of add-parents, i.e., you do not get back your original input.
-(define/contract (remove-parents x) 
-  (map-tree? . -> . tagged-xexpr?)
-  (match x
-    [(? tagged-xexpr?) (let-values ([(tag attr elements) (break-tagged-xexpr x)])
-                         (make-tagged-xexpr tag empty (remove-parents elements)))]
-    [(? list?) (map remove-parents x)]
-    [else x]))
+(define/contract (remove-parents mt) 
+  (map-tree? . -> . map-tree?)
+  (remove-attrs mt))
 
 (module+ test
   (check-equal? (remove-parents 
@@ -243,5 +245,4 @@
   (check-equal? (next-page 'one test-tree) "two")
   (check-false (next-page 'three test-tree)))
 
-;; todo: why is this re-exporting web-server/templates?
-(provide (all-defined-out) (all-from-out web-server/templates))
+(provide (all-defined-out))

readability.rkt

@@ -4,6 +4,7 @@
 (require (only-in racket/format ~a))
 (require (only-in racket/string string-join))
 (require (only-in racket/vector vector-member))
+(require (only-in racket/set set set->list set?))
 (module+ test (require rackunit))
 (require "debug.rkt")
 
@@ -38,21 +39,23 @@
 
 
 ;; general way of coercing to a list
-(define (->list x)
+(define/contract (->list x)
   (any/c . -> . list?)
   (cond 
     [(list? x) x]
     [(vector? x) (vector->list x)]
+    [(set? x) (set->list x)]
     [else (list x)])) 
 
 (module+ test
   (check-equal? (->list '(1 2 3)) '(1 2 3))
   (check-equal? (->list (list->vector '(1 2 3))) '(1 2 3))
+  (check-equal? (->list (set 1 2 3)) '(1 2 3))
   (check-equal? (->list "foo") (list "foo")))
 
 
 ;; general way of coercing to boolean
-(define (->boolean x)
+(define/contract (->boolean x)
   (any/c . -> . boolean?)
   ;; in Racket, everything but #f is true
   (if x #t #f))
@@ -66,16 +69,20 @@
   (check-true (->boolean '(1 2 3))))
 
 
+(define/contract (has-length? x)
+  (any/c . -> . boolean?)
+  (ormap (λ(proc) (proc x)) (list list? string? symbol? vector? hash? set?)))
 
 ;; general way of asking for length
-(define (len x)
-  (any/c . -> . integer?)
+(define/contract (len x)
+  (has-length? . -> . integer?)
   (cond
     [(list? x) (length x)]
     [(string? x) (string-length x)]
     [(symbol? x) (len (->string x))]
-    [(vector? x) (vector-length x)]
+    [(vector? x) (len (->list x))]
     [(hash? x) (len (hash-keys x))]
+    [(set? x) (len (->list x))]
     [else #f]))
 
 (module+ test
@@ -87,19 +94,27 @@
   (check-not-equal? (len 'fo) 3) ; len 2
   (check-equal? (len (list->vector '(1 2 3))) 3)
   (check-not-equal? (len (list->vector '(1 2))) 3) ; len 2
+  (check-equal? (len (set 1 2 3)) 3)
+  (check-not-equal? (len (set 1 2)) 3) ; len 2
   (check-equal? (len (make-hash '((a . 1) (b . 2) (c . 3)))) 3)
   (check-not-equal? (len (make-hash '((a . 1) (b . 2)))) 3)) ; len 2
 
 
 
+(define/contract (sliceable-container? x)
+  (any/c . -> . boolean?)
+  (ormap (λ(proc) (proc x)) (list list? string? symbol? vector?)))
+
+(define/contract (container? x)
+  (any/c . -> . boolean?)
+  (ormap (λ(proc) (proc x)) (list sliceable-container? hash?))) 
+
+
 ;; general way of fetching an item from a container
 (define/contract (get container start [end #f])
-  ((any/c any/c) ((λ(i)(or (integer? i) (and (symbol? i) (equal? i 'end))))) 
+  ((container? 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?)))
-  
   (set! end
         (if (sliceable-container? container)
             (cond 
@@ -121,8 +136,7 @@
                    [(string? container) (substring container start end)]
                    [(symbol? container) (->symbol (get (->string container) start end))] 
                    ;; for hash, just get item
-                   [(hash? container) (let ([hash-key start])
-                                        (hash-ref container hash-key))]
+                   [(hash? container) (hash-ref container start)]
                    [else #f]))
   
   ;; don't return single-item results inside a list
@@ -152,32 +166,26 @@
 ;; general way of testing for membership (à la Python 'in')
 ;; put item as first arg so function can use infix notation
 ;; (item . in . container)
-(define/contract (in item container)
-  (any/c any/c . -> . any/c)
-  (cond
+(define/contract (in? item container)
+  (any/c any/c . -> . boolean?)
+  (->boolean (cond
                [(list? container) (member item container)] ; returns #f or sublist beginning with item
                [(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 ((->string item) . in . (map ->string (string->list container)))])
-                           (if result
-                               (string-join result "")
-                               #f))] ; returns #f or substring beginning with item
-    [(symbol? container) (let ([result ((->string item) . in . (->string container))])
-                           (if result
-                               (->symbol result)
-                               result))] ; returns #f or subsymbol (?!) beginning with item
-    [else #f]))
+               [(string? container) ((->string item) . in? . (map ->string (string->list container)))] ; returns #f or substring beginning with item
+               [(symbol? container) ((->string item) . in? . (->string container))] ; returns #f or subsymbol (?!) beginning with item
+               [else #f])))
 
 (module+ test
-  (check-equal? (2 . in . '(1 2 3)) '(2 3))
-  (check-false (4 . in . '(1 2 3)))
-  (check-equal? (2 . in . (list->vector '(1 2 3))) 1)
-  (check-false (4 . in . (list->vector '(1 2 3))))
-  (check-equal? ('a . in . (make-hash '((a . 1) (b . 2) (c  . 3)))) 1)
-  (check-false ('x . in . (make-hash '((a . 1) (b . 2) (c  . 3)))))
-  (check-equal? ("o" . in . "foobar") "oobar")
-  (check-false ("z" . in . "foobar"))
-  (check-equal? ('o . in . 'foobar) 'oobar)
-  (check-false ('z . in . 'foobar))
-  (check-false ("F" . in . #\F)))
+  (check-true (2 . in? . '(1 2 3)))
+  (check-false (4 . in? . '(1 2 3)))
+  (check-true (2 . in? . (list->vector '(1 2 3))))
+  (check-false (4 . in? . (list->vector '(1 2 3))))
+  (check-true ('a . in? . (make-hash '((a . 1) (b . 2) (c  . 3)))))
+  (check-false ('x . in? . (make-hash '((a . 1) (b . 2) (c  . 3)))))
+  (check-true ("o" . in? . "foobar"))
+  (check-false ("z" . in? . "foobar"))
+  (check-true ('o . in? . 'foobar))
+  (check-false ('z . in? . 'foobar))
+  (check-false ("F" . in? . #\F)))

tests/requires/include-me.rkt

@@ -12,6 +12,7 @@
 (register-block-tag 'fooble)
 
 
+
 ;; handle meta tags
 (define/contract (meta-proc meta)
   (meta-xexpr? . -> . tagged-xexpr?)
@@ -104,7 +105,7 @@
   (define tags-to-pay-attention-to '(p aside)) ; only apply to paragraphs
   
   (define (replace-last-space str)
-    (if (#\space . in . str)
+    (if (#\space . in? . str)
         (let ([reversed-str-list (reverse (string->list str))]
               [reversed-nbsp (reverse (string->list nbsp))])
           (define-values (last-word-chars other-chars) 
@@ -128,7 +129,7 @@
              x))]
       [else x]))
   
-  (if ((car x) . in . tags-to-pay-attention-to)
+  (if ((car x) . in? . tags-to-pay-attention-to)
       (find-last-word-space x)
       x))
 
@@ -157,11 +158,11 @@
        (define str-first (get tcs 0))
        (define str-rest (get tcs 1 'end))
        (cond
-         [(str-first . in . '("\"" "“"))
+         [(str-first . in? . '("\"" "“"))
           ;; can wrap with any inline tag
           ;; so that linebreak detection etc still works
           `(,@double-pp ,(->string #\“) ,str-rest)]
-         [(str-first . in . '("\'" "‘")) 
+         [(str-first . in? . '("\'" "‘")) 
           `(,@single-pp ,(->string #\‘) ,str-rest)]
          [else tcs])]
       [(? tagged-xexpr? nx) (wrap-hanging-quotes nx)]
@@ -224,8 +225,8 @@
   (typogrify str))
 
 
-(define (root . items)
-  (tagged-xexpr? . -> . tagged-xexpr?)
+(define/contract (root . items)
+  (() #:rest (listof xexpr-element?) . ->* . tagged-xexpr?)
   (decode (cons 'root items)
           ;          #:exclude-xexpr-tags 'em
           ;          #:xexpr-tag-proc [xexpr-tag-proc (λ(x)x)]

tests/test-foo.p

@@ -0,0 +1,7 @@
+#lang racket/base
+
+;(require "test.pmap")
+(require "test-pmap.p")
+;(require "pollen-lang-test.p")
+
+main

tests/test-pmap.p

@@ -0,0 +1,26 @@
+#lang planet mb/pollen
+
+◊map-topic{index
+    typography-in-ten-minutes
+    summary-of-key-rules
+    foreword
+    introduction
+    how-to-use
+    how-to-pay-for-this-book
+    ◊map-topic{why-typography-matters
+          what-is-typography
+          where-do-the-rules-come-from}
+    ◊map-topic{type-composition
+          straight-and-curly-quotes
+          one-space-between-sentences
+          trademark-and-copyright-symbols
+          ligatures}
+    ◊map-topic{appendix
+        printers-and-paper
+        how-to-make-a-pdf
+        typewriter-habits
+        common-accented-characters
+        identifying-fonts
+        bibliography
+        charter
+        mb-lectures-and-articles}}

tools.rkt

@@ -30,7 +30,7 @@
 
 ; make these independent of local includes
 (define (map-topic topic . subtopics)
-  `(,(string->symbol topic) ,@(filter-not whitespace? subtopics)))
+  (make-tagged-xexpr (->symbol topic) empty (filter-not whitespace? subtopics)))
 
 
 ;; does path have a certain extension
@@ -95,12 +95,17 @@
 
 
 ;; is it xexpr content?
+(define/contract (xexpr-element? x)
+  (any/c . -> . boolean?)
+  (or (string? x) (tagged-xexpr? x)))
+
+
 (define/contract (xexpr-elements? x)
   (any/c . -> . boolean?)
   (match x
     ;; this is more strict than xexpr definition in xml module
     ;; don't allow symbols or numbers to be part of content
-    [(list elem ...) (andmap (λ(i) (or (string? i) (tagged-xexpr? i))) elem)]
+    [(list elem ...) (andmap xexpr-element? elem)]
     [else #f]))
 
 (module+ test  
@@ -158,16 +163,17 @@
   ;; use flatten to splice xexpr-attrs into list
   ;; use hash to ensure keys are unique (later values will overwrite earlier)
   (define attr-hash (apply hash (make-attr-list (flatten items))))
-  `(,@(map (λ(k v) (list k v)) (hash-keys attr-hash) (hash-values attr-hash))))
+  `(,@(map (λ(k) (list k (get attr-hash k))) 
+           ;; sort needed for predictable results for unit tests
+           (sort (hash-keys attr-hash) (λ(a b) (string<? (->string a) (->string b)))))))
 
 (module+ test
   (check-equal? (make-xexpr-attr 'foo "bar") '((foo "bar")))
   (check-equal? (make-xexpr-attr "foo" 'bar) '((foo "bar")))
   (check-equal? (make-xexpr-attr "foo" "bar" "goo" "gar") '((foo "bar")(goo "gar")))
-  (check-equal? (make-xexpr-attr '((foo "bar")(goo "gar")) "hee" "haw") 
+  (check-equal? (make-xexpr-attr (make-xexpr-attr "foo" "bar" "goo" "gar") "hee" "haw") 
                 '((foo "bar")(goo "gar")(hee "haw")))
-  (check-equal? (make-xexpr-attr '((foo "bar")(goo "gar")) "foo" "haw") '((foo "haw")(goo "gar")))
-)
+  (check-equal? (make-xexpr-attr '((foo "bar")(goo "gar")) "foo" "haw") '((foo "haw")(goo "gar"))))
 
 
 ;; create tagged-xexpr from parts (opposite of break-tagged-xexpr)
@@ -228,6 +234,20 @@
                 '("foo" "bar" (em "square"))))
 
 
+;; remove all attr blocks (helper function)
+(define/contract (remove-attrs x)
+  (tagged-xexpr? . -> . tagged-xexpr?)
+  (match x
+    [(? tagged-xexpr?) (let-values ([(tag attr elements) (break-tagged-xexpr x)])
+                         (make-tagged-xexpr tag empty (remove-attrs elements)))]
+    [(? list?) (map remove-attrs x)]
+    [else x]))
+
+(module+ test
+  (check-equal? (remove-attrs '(p ((foo "bar")) "hi")) '(p "hi"))
+  (check-equal? (remove-attrs '(p ((foo "bar")) "hi" (p ((foo "bar")) "hi"))) '(p "hi" (p "hi"))))
+  
+
 ;; apply filter proc recursively
 (define/contract (filter-tree proc tree)
   (procedure? list? . -> . list?)