starting to refactor template.rkt

decode.rkt

@@ -3,7 +3,6 @@
 (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")
@@ -92,12 +91,7 @@
 
 
 
-;; 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

server.rkt

@@ -3,12 +3,9 @@
 (require web-server/servlet-env)
 (require web-server/dispatch web-server/dispatchers/dispatch)
 (require racket/rerequire)
-(require (planet mb/pollen/tools))
-(require (planet mb/pollen/world))
-(require (planet mb/pollen/regenerate))
-(require (planet mb/pollen/template))
 (require xml)
 (require xml/path)
+(require "tools.rkt" "world.rkt" "regenerate.rkt" "template.rkt")
 
 (displayln "Pollen server starting...")
 

template.rkt

@@ -1,109 +1,143 @@
 #lang racket/base
-(require (planet mb/pollen/tools) (planet mb/pollen/world))
-(require xml xml/path racket/list racket/string)
-(require web-server/templates)
+(require xml xml/path racket/list racket/string racket/contract)
+(require (except-in web-server/templates in))
+(require "tools.rkt" "world.rkt")
+
+(module+ test (require rackunit)
+  (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 ...
     (set! map-main (dynamic-require map-file POLLEN_ROOT)) 
     ; ... synthesize it
     (let ([files (directory-list START_DIR)])
-      (set! files (map remove-ext (filter (ƒ(x) (has-ext? x POLLEN_SOURCE_EXT)) files)))
+      (set! files (map remove-ext (filter (λ(x) (has-ext? x POLLEN_SOURCE_EXT)) files)))
       (set! map-main `(map-main ,@(map path->string files)))))
 
+;; todo: restrict this test
+(define/contract (pmap-tree? x)
+  (any/c . -> . boolean?)
+  (tagged-xexpr? x))
 
-
-(define (add-parents x [parent null] [previous null])
+;; insert parents into pmap tree as attrs
+(define/contract (add-parents x [parent null] [previous null])
+  ((pmap-tree?) (xexpr-tag? xexpr-tag?) . ->* . pmap-tree?)
   ; disallow main as parent tag
   (when (equal? parent 'map-main) (set! parent empty)) 
   (cond
     [(list? x) 
      (let ([new-parent (car x)])
        ; xexpr with topic as name, parent as attr, children as elements
-       `(,@(add-parents new-parent parent) ,@(map (ƒ(i) (add-parents i new-parent)) (cdr x))))]
-    [else `(,(as-symbol x) ((parent ,(as-string parent))))]))
+       `(,@(add-parents new-parent parent) ,@(map (λ(i) (add-parents i new-parent)) (cdr x))))]
+    [else `(,(->symbol x) ((parent ,(->string parent))))]))
+
+(module+ test
+  (define stt `(map-main "foo" ,(map-topic "one" "two")))
+  (check-equal? (add-parents stt) '(map-main
+                                    ((parent ""))
+                                    (foo ((parent "")))
+                                    (one ((parent "")) (two ((parent "one")))))))
+  
+  (define (remove-parents x)  
+    (cond
+      [(list? x) `(,(car x) ,@(map remove-parents (cddr x)))]
+      [else x]))
+  
+  
+  (define (main->tree main)
+    (add-parents main))
+  
   
-(define (remove-parents x)  
-  (cond
-    [(list? x) `(,(car x) ,@(map remove-parents (cddr x)))]
-    [else x]))
   
-(define (main->tree main)
-  (add-parents main))
   
-(define tree (main->tree map-main))
+  (define tree (main->tree map-main))
   
-(define (get-parent x [xexpr tree])
-  (empty/else x (ƒ(x) 
-                  (let ([result (se-path* `(,(as-symbol x) #:parent) xexpr)])
-                    (if (not result) ; se-path* returns #f if nothing found
-                        empty ; but don't pass #f up through the chain.
-                        (as-string result))))))
+  (define (get-parent x [xexpr tree])
+    (if (empty? x)
+        empty
+        (let ([result (se-path* `(,(->symbol x) #:parent) xexpr)])
+          (if (not result) ; se-path* returns #f if nothing found
+              empty ; but don't pass #f up through the chain.
+              (->string result)))))
   
-; algorithm to find children
-(define (get-children x [xexpr tree])
-  (empty/else x (ƒ(x) 
-                  ; find contents of node. 
-                  (let ([node-contents (se-path*/list `(,(as-symbol x)) xexpr)])
-                    ; If there are sublists, just take first element
-                    (map (ƒ(i) (as-string (if (list? i) (car i) i))) node-contents)))))
+  ; algorithm to find children
+  (define (get-children x [xexpr tree])
+    (if (empty? x)
+        empty
+        ; find contents of node. 
+        (let ([node-contents (se-path*/list `(,(->symbol x)) xexpr)])
+          ; If there are sublists, just take first element
+          (map (λ(i) (->string (if (list? i) (car i) i))) node-contents))))
   
-; find all siblings on current level: go up to parent and ask for children
-(define (get-all-siblings x [xexpr tree])
-  (get-children (get-parent x xexpr) xexpr))
+  ; find all siblings on current level: go up to parent and ask for children
+  (define (get-all-siblings x [xexpr tree])
+    (get-children (get-parent x xexpr) xexpr))
   
-(define (get-adjacent-siblings x [xexpr tree])
-  (define-values (left right)
-    (splitf-at (get-all-siblings x xexpr) (ƒ(y) (not (equal? (as-string x) (as-string y))))))
-  ; use cdr because right piece includes x itself at front
-  (values left (empty/else right cdr)))
+  (define (get-adjacent-siblings x [xexpr tree])
+    (define-values (left right)
+      (splitf-at (get-all-siblings x xexpr) (λ(y) (not (equal? (->string x) (->string y))))))
+    ; use cdr because right piece includes x itself at front
+    (values left (if (empty? right)
+                     empty
+                     (cdr right))))
   
-(define (get-left-siblings x [xexpr tree])
-  (define-values (left right) (get-adjacent-siblings x xexpr))
-  left)
+  (define (get-left-siblings x [xexpr tree])
+    (define-values (left right) (get-adjacent-siblings x xexpr))
+    left)
   
-(define (get-right-siblings x [xexpr tree])
-  (define-values (left right) (get-adjacent-siblings x xexpr))
-  right)
+  (define (get-right-siblings x [xexpr tree])
+    (define-values (left right) (get-adjacent-siblings x xexpr))
+    right)
   
-(define (get-left x [xexpr tree])
-  (empty/else (get-left-siblings x xexpr) last))
+  (define (get-left x [xexpr tree])
+    (if (empty? (get-left-siblings x xexpr))
+        empty
+        (last (get-left-siblings x xexpr))))
   
-(define (get-right x [xexpr tree])
-  (empty/else (get-right-siblings x xexpr) first))
+  (define (get-right x [xexpr tree])
+    (if (empty? (get-right-siblings x xexpr))
+        empty
+        (first (get-right-siblings x xexpr))))
   
   
-(define (make-page-sequence [xexpr tree])
-  ; use cdr to get rid of body tag at front
-  ; todo: calculate exclusions?
-  (map as-string (cdr (flatten (remove-parents xexpr))))) 
+  (define (make-page-sequence [xexpr tree])
+    ; use cdr to get rid of body tag at front
+    ; todo: calculate exclusions?
+    (map ->string (cdr (flatten (remove-parents xexpr))))) 
   
-(define (get-adjacent-pages x [xexpr tree])
-  (define-values (left right)
-    (splitf-at (make-page-sequence xexpr) (ƒ(y) (not (=str (as-string x) (as-string y))))))
-  ; use cdr because right piece includes x itself at front
-  (values left (empty/else right cdr)))
+  (define (get-adjacent-pages x [xexpr tree])
+    (define-values (left right)
+      (splitf-at (make-page-sequence xexpr) (λ(y) (not (equal? (->string x) (->string y))))))
+    ; use cdr because right piece includes x itself at front
+    (values left (if (empty? right)
+                     empty
+                     (cdr right))))
   
-(define (get-previous-pages x [xexpr tree])
-  (define-values (left right) (get-adjacent-pages x xexpr))
-  left)
+  (define (get-previous-pages x [xexpr tree])
+    (define-values (left right) (get-adjacent-pages x xexpr))
+    left)
   
-(define (get-next-pages x [xexpr tree])
-  (define-values (left right) (get-adjacent-pages x xexpr))
-  right)
+  (define (get-next-pages x [xexpr tree])
+    (define-values (left right) (get-adjacent-pages x xexpr))
+    right)
   
-(define (get-previous x [xexpr tree])
-  (empty/else (get-previous-pages x xexpr) last))
+  (define (get-previous x [xexpr tree])
+    (if (empty? (get-previous-pages x xexpr))
+        empty
+        (last (get-previous-pages x xexpr))))
   
-(define (get-next x [xexpr tree])
-  (empty/else (get-next-pages x xexpr) first))
+  (define (get-next x [xexpr tree])
+    (if (empty? (get-next-pages x xexpr))
+        empty
+        (first (get-next-pages x xexpr))))
   
   
   
   
   
-(provide (all-defined-out) (all-from-out web-server/templates))
+  (provide (all-defined-out) (all-from-out web-server/templates))

tests/bibliography.p

@@ -0,0 +1,68 @@
+#lang planet mb/pollen
+
+◊topic['((class "small"))]{Bibliography}
+
+◊lc{T}his is not, by any measure, a comprehensive bibliography. Rather, it’s a selection of favorites from my own bookshelf that I consult most frequently in my work as a writer and a typographer.
+
+◊(define (book-description . stuff)
+`(indented ((style "position:relative;top:-0.4em")) ,@stuff))
+
+◊subhead{writing}
+
+Bryan A. Garner, ◊book{Garner’s Modern American Usage}, 3rd ed. (New York: Oxford University Press, 2009).
+
+◊book-description{Long before he agreed to write the foreword for my book ◊book{Typography for Lawyers}, Bryan Garner was a hero of mine. Garner thinks and writes about American English in a way that’s rigorous, convincing, and accessible. He is stern but not shrill; authoritative but not authoritarian. He is a vigorous advocate for clear, simple writing. His work should be mandatory reading for all writers.}
+
+◊subhead{Typography}
+
+Matthew Butterick, ◊book{Typography for Lawyers} (Houston: Jones McClure Publishing, 2010).
+
+◊book-description{The precursor to ◊book{Butterick's Practical Typography}. Lawyer or not, consider buying a copy, because it's a virtuous act. See ◊xref{how to pay for this book.}}
+
+Jan Middendorp, ◊book{Shaping Text} (Amsterdam: BIS Publishers, 2012).
+
+◊book-description{If you get a second book on typography, get this one. Middendorp’s beautifully written and illustrated book is full of careful details and lucid explanations.}
+
+
+Carolina de Bartolo, ◊book{Explorations in Typography} (◊slink["explorationsintypography.com" "http://explorationsintypography.com"], 2011).
+
+◊book-description{Using a Spiekermann essay from ◊book{Stop Stealing Sheep} (see below), de Bartolo shows how different typesetting choices change the effect of the text.}
+
+Cyrus Highsmith, ◊book{Inside Paragraphs} (Boston: Font Bureau, 2012).
+
+◊book-description{Highsmith's charmingly hand-illustrated book focuses on the paragraph as a unit of typographic interest.}
+
+
+
+Robert Bringhurst, ◊book{The Elements of Typographic Style}, 3rd ed. (Vancouver: Hartley and Marks Publishers, 2004).
+
+◊book-description{Bringhurst’s book has become something of a standard reference guide among professional typographers, bringing together the history, theory, and practice of typography.}
+
+Ellen Lupton, ◊book{Thinking With Type}, 2nd ed. (New York: Princeton Architectural Press, 2010).
+
+◊book-description{Intended as an introduction to typography for design students, Lupton’s book is more accessible than Bringhurst’s. It includes full-color illustrations from every era of typography.}
+
+
+◊subhead{Fonts}
+
+Erik Spiekermann and E. M. Ginger, ◊book{Stop Stealing Sheep & Find Out How Type Works}, 2nd ed. (Berkeley, California: Adobe Press, 2002).
+
+◊book-description{Ginger & Spiekermann, a self-described typomaniac (and author of the ◊xref{foreword}) explain how fonts work, and how they differ in appearance and in function. My font ◊xref{Hermes} is among those featured.}
+
+Stephen Coles, ◊book{The Anatomy of Type} (London: Quid Publishing Ltd., 2012).
+
+◊book-description{Explores the major categories of fonts and their characteristic qualities by examining 100 fonts in detail.}
+
+
+
+◊subhead{Design principles}
+
+Edward Tufte, ◊book{Envisioning Information}, 4th printing ed. (Cheshire, Connecticut: Graphics Press, 1990).
+
+Edward Tufte, ◊book{The Visual Display of Quantitative Information}, 2nd ed. (Cheshire, Connecticut: Graphics Press, 2001).
+
+◊book-description{These are two of my favorite books of all time. Tufte makes an eloquent and compelling case for why design matters. Both books are fantastically interesting and beautifully illustrated with examples of information design from many historical periods.}
+
+William Lidwell, Kritina Holden, and Jill Butler, ◊book{Universal Principles of Design}, 2nd ed. (Beverly, Massachusetts: Rockport Publishers, 2010).
+
+◊book-description{An excellent and accessible introduction to design principles that apply not only to printed documents, but to all objects that we interact with.}

tests/polcom

@@ -0,0 +1,3 @@
+#! /usr/bin/racket
+#lang racket/base
+(require (planet mb/pollen/command))

tests/pollen-lang-test.p

@@ -2,11 +2,13 @@
 
 ◊meta["metakey" "metavalue"]
 
-◊;todo: make this recognized as a block.
-◊bloq{In a block}
 
 "Hello" world, aren't you --- yes, you — about 1--2 inches tall?
 
+
+◊;todo: make this recognized as a block.
+◊bloq{In a block}
+   
 We 
 
 ◊fooble{'Love'}

tests/test.pmap

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

@@ -5,6 +5,8 @@
 (require (only-in racket/list empty empty? second filter-not splitf-at takef dropf dropf-right))
 (require (only-in racket/string string-join))
 (require (only-in xml xexpr? xexpr/c))
+(require (prefix-in scribble: (only-in scribble/decode whitespace?)))
+
 
 (require "readability.rkt" "debug.rkt")
 (provide (all-defined-out) (all-from-out "readability.rkt" "debug.rkt"))
@@ -19,6 +21,18 @@
   (for-each check-equal? (map path->string foo-paths) foo-path-strings))
 
 
+;; recursive whitespace test
+;; Scribble's version misses whitespace in a list
+(define (whitespace? x)
+  (cond
+    [(list? x) (andmap whitespace? x)]
+    [else (scribble:whitespace? x)]))
+
+; make these independent of local includes
+(define (map-topic topic . subtopics)
+  `(,(string->symbol topic) ,@(filter-not whitespace? subtopics)))
+
+
 ;; does path have a certain extension
 (define/contract (has-ext? path ext)
   (path? symbol? . -> . boolean?)