Sat afternoon

12 years ago · 6ce38652b7
parent 196d9f00f3
commit 6ce38652b7
4 changed files with 112 additions and 792 deletions
--- a/main-helper.rkt
+++ b/main-helper.rkt
@ -5,9 +5,8 @@
         (planet mb/pollen/world))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Look for a pp-requires directory local to the source file.
+;; Look for a EXTRAS_DIR directory local to the source file.
 ;; If it exists, get list of rkt files 
 ;; and require + provide them.
 ;; This will be resolved in the context of current-directory.
@ -28,7 +27,7 @@
      (letrec 
          ([files (map make-complete-path (filter is-rkt-file? (directory-list EXTRAS_DIR)))]
           [files-in-require-form 
-            (map (ƒ(x) `(file ,(path->string x))) files)]) 
+            (map (λ(x) `(file ,(path->string x))) files)]) 
        (datum->syntax stx 
                       `(begin
                          (require ,@files-in-require-form)
@ -43,7 +42,7 @@
      (letrec 
          ([files (map make-complete-path (filter is-rkt-file? (directory-list EXTRAS_DIR)))]
           [files-in-require-form 
-            (map (ƒ(x) `(file ,(path->string x))) files)]) 
+            (map (λ(x) `(file ,(path->string x))) files)]) 
        (datum->syntax stx 
                       `(begin
                          (require ,@files-in-require-form))))
@ -63,14 +62,14 @@
        (set! ccr (car ccr)))  ; in which case, just grab the path from the front
      (if (equal? 'pollen-lang-module ccr) ; what happens if the file isn't yet saved in drracket
          'nowhere ; thus you are nowhere
-          (let-values ([(here-dir here-name ignored) (split-path ccr)])
+          (match-let-values ([(_ here-name _) (split-path ccr)])
-            (path->string (remove-ext here-name)))))))
+                            (path->string (remove-all-ext here-name)))))))
 ; then, apply a separate syntax transform to the identifier itself
 ; can't do this in one step, because if the macro goes from identifier to function definition,
 ; macro processor will evaluate the body at compile-time, not runtime.
 (define-syntax here
-  (ƒ(stx) (datum->syntax stx '(get-here))))
+  (λ(stx) (datum->syntax stx '(get-here))))
 ; function to strip metas out of body and consolidate them separately
@ -90,3 +89,7 @@
  (values (remove-empty (&split-metas body)) (reverse meta-list))) 
 (provide (all-defined-out))
 (module+ test
  (require rackunit)
  (check-equal? (get-here) "test-main-helper"))
--- a/main.rkt
+++ b/main.rkt
@ -25,7 +25,7 @@
     ; 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)) ; for split-metas and get-here
+              (planet mb/pollen/main-helper))
     (require-and-provide-extras) ; brings in the project require files
     ; #%top binding catches ids that aren't defined
--- a/readability.rkt
+++ b/readability.rkt
@ -1,200 +1,28 @@
 #lang racket/base
-(require (only-in racket/list empty? range))
+(require racket/contract)
-(require (only-in racket/format ~a ~v))
+(require (only-in racket/list empty?))
-(require (only-in racket/string string-join)) 
+(require (only-in racket/format ~a))
 (require (prefix-in williams: (planet williams/describe/describe)))
 (require racket/date)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Utility functions for readability
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (provide (all-defined-out))
-; lambda alias
+;; general way of coercing to string
-; won't work as simple define because λ is specially handled in reader
+(define/contract (as-string x)
-(define-syntax-rule (ƒ x ...) (λ x ...))
+  (any/c . -> . string?)
 (define (describe x)
  (williams:describe x)
  x)
 ; report the current value of the variable, then return it
 (define-syntax-rule (report var)
  (begin 
    (message 'var "=" var) 
    var))
 ; debug utilities
 (define (message . x)
  (define (zfill s n)
    (set! s (as-string s))
    (if (> (string-length s) n)
        s
        (string-append (make-string (- n (string-length s)) #\0) s)))
  (define (make-date-string)
    (define d (current-date))
    (define df (map (ƒ(x) (zfill x 2)) (list (date-month d)(date-day d)(date-year d)(modulo (date-hour d) 12)(date-minute d)(date-second d)(if (< (date-hour d) 12) "am" "pm"))))
    (apply format "[~a.~a.~a ~a:~a:~a~a]" df))
  (displayln (string-join `(,(make-date-string) ,@(map (ƒ(x)(if (string? x) x (~v x))) x))) (current-error-port)))
 (define (exists? x)
  ; neither empty nor false
  (and (not (empty? x)) x))
 #|(define (=str . xs)
  (let ([tester (car xs)])
    (all (ƒ(x) (equal? tester x)) (map as-string (cdr xs)))))|#
 (define (=str . xs)
  (let* ([xs (map as-string xs)]
         [tester (car xs)])
    (all (ƒ(x) (equal? tester x)) (cdr xs))))
 (define (int x)
  (cond
    [(integer? x) x]
    [(boolean? x) (if x 1 0)]
    [(real? x) (floor x)]
    [(string? x) (if (= (len x) 1)
                     (int (car (string->list x))) ; treat as char
                     (int (string->number x)))]
    [(symbol? x) (int (as-string x))]
    [(char? x) (char->integer x)]
    [(empty? x) 0]
    [(or (list? x) (hash? x) (vector? x)) (len x)]
    [else (error "Can't convert to integer:" x)]))
 (define (str . x)
  (string-join (map as-string x) ""))
 (define (len x)
  (cond 
    [(list? x) (length x)]
    [(string? x) (string-length x)]
    [(symbol? x) (len (as-string x))]
    [(vector? x) (vector-length x)]
    [(hash? x) (len (hash-keys x))]
    [else #f]))
 (define (change x i value)
  ; general-purpose mutable data object setter
  (cond
    [(vector? x) (vector-set! x i value)] 
    [(hash? x) (hash-set! x i value)]
    [else (error "Can't set this datatype using !")]))
 (define (get x i [j #f])
  (when (and (or (list? x) (string? x) (vector? x)) j)
    (cond 
      [(and (real? j) (< j 0)) (set! j (+ (len x) j))]
      [(equal? j 'end) (set! j (len x))]))
  (cond
    [(list? x) (if j
                   (for/list ([index (range i j)])
                     (get x index))
                   (list-ref x i))]
    [(vector? x) (if j
                     (for/vector ([index (range i j)])
                       (get x index))
                     (vector-ref x i))]
    [(string? x) (if j
                     (substring x i j)
                     (get x i (add1 i)))]
    [(symbol? x) (as-symbol (get (as-string x) i j))]
    [(hash? x) (if j
                   (error "get: third arg not supported for hash")
                   (hash-ref x i))]
    [else #f]))
 (define (in? container element)
  (cond
    [(list? container) (member element container)]
    [(hash? container) (hash-has-key? container element)]
    ; todo: should this handle arbitrary-length substrings?
    ; leaning toward no, because it breaks the string-as-array-of-characters abstraction
    [(string? container) (let ([result (in? (map as-string (string->list container)) (as-string element))])
                   (if result
                       (string-join result "")
                       #f))]
    [(symbol? container) (let ([result (in? (as-string container) element)])
                   (if result
                       (as-symbol result)
                       result))]
    [else #f]))
 (define (to-lc x)
  (string-downcase x))
 (define (to-uc x)
  (string-upcase x))
 ; python-style string testers
 (define (starts-with? string starter)
  (if (<= (len starter) (len string))
      (equal? (get string 0 (len starter)) starter)
      #f))
 (define (ends-with? string ender)
  (if (<= (len ender) (len string) )
      (equal? (get string (- (len string) (len ender)) 'end) ender)
      #f))
 ; coercions
 (define (as-path thing)
  (set! thing 
        (if (string? thing) 
            (string->path thing)
            thing))
  (when (not (path? thing)) (error (format "Can't make ~a into path" thing)))
  thing)
 (define (as-list thing)
  (set! thing 
        (if (not (list? thing)) 
            (list thing)
            thing))
  (when (not (list? thing)) (error (format "Can't make ~a into list" thing)))
  thing) 
 ; nice way of converting to string
 (define (as-string x)
  (set! x (cond 
    [(empty? x) ""]
    [(symbol? x) (symbol->string x)]
    [(number? x) (number->string x)]
    [(path? x) (path->string x)]
    [(char? x) (~a x)]
-            [else x]))
+    [else (error (format "Can't make ~a into string" x))]))
-  (when (not (string? x)) (error (format "Can't make ~a into string" x)))
+
-  x)
+
-
+(module+ test
-; nice way of converting to symbol
+  (require rackunit)
-; todo: on bad input, it will pop a string error rather than symbol error
+  (check-equal? (as-string '()) "")
-(define (as-symbol thing)
+  (check-equal? (as-string 'foo) "foo")
-  (string->symbol (as-string thing))) 
+  (check-equal? (as-string 123) "123")
-
+  (define file-name-as-text "foo.txt")
-; nice way of converting to path
+  (check-equal? (as-string (string->path file-name-as-text)) file-name-as-text)
-(define (as-complete-path thing)
+  (check-equal? (as-string #\¶) "¶")
-  (path->complete-path (as-path thing)))
+  )
 ; any & all & none
 (define (any tests things)
  (ormap (ƒ(test) (ormap test (as-list things))) (as-list tests)))
 (define (all tests things)
  (andmap (ƒ(test) (andmap test (as-list things))) (as-list tests)))
 (define (none test things) (not (any test things)))
 ; Other possibilities
 ; trim
 ; split
--- a/tools.rkt
+++ b/tools.rkt
@ -1,598 +1,87 @@
 #lang racket/base
-(require racket/list)
+(require "readability.rkt")
-(require xml)
+(require racket/contract racket/match)
 (require (only-in racket/function thunk))
 (require racket/string)
 (require racket/file)
 (require xml/path)
 (require (only-in racket/format ~a ~s ~v))
 (require (prefix-in scribble: (only-in scribble/decode whitespace?)))
 (require (only-in racket/path filename-extension))
-(require (only-in (planet mb/pollen/library/html) inline-tags))
+(require (only-in racket/format ~a))
-(require (planet mb/pollen/world))
+(require (only-in xml xexpr?))
-(require (planet mb/pollen/readability))
+(provide (all-defined-out))
-;(require (planet mb/pollen/hyphenate))
+
-
+;; setup for test cases
-
+(module+ test
-(define nbsp " ") ; use this for readability in code
+  (require rackunit)
-(define lozenge "◊") ; use this instead of escape syntax
+  (define foo-path-strings '("foo" "foo.txt" "foo.bar" "foo.bar.txt"))
-
+  (define-values (foo-path foo.txt-path foo.bar-path foo.bar.txt-path) (apply values (map string->path foo-path-strings)))
-(provide (all-defined-out) 
+  ;; test the sample paths before using them for other tests
-         describe whitespace? xexpr->string xexpr? filter-not flatten
+  (define foo-paths (list foo-path foo.txt-path foo.bar-path foo.bar.txt-path))
-         (all-from-out (planet mb/pollen/readability)))
+  (for-each check-equal? (map path->string foo-paths) foo-path-strings))
-
+
-(define (hash-ref-or hash key [default #f])
+
-  (if (in? hash key)
+;; does path have a certain extension
-      (get hash key)
+(define/contract (has-ext? path ext)
-      default))
+  (path? symbol? . -> . boolean?)
-
+  (define ext-of-path (filename-extension path))
-(define (make-meta-hash x)
+  (and ext-of-path (equal? (bytes->string/utf-8 ext-of-path) (as-string ext))))
-  (define keys (se-path*/list '(meta #:name) x))
+
-  (define values (se-path*/list '(meta #:content) x))
+(module+ test
-  (define meta-hash (make-hash))
+  (check-equal? (has-ext? foo-path 'txt) #f)
-  ;todo: convert this to for/list because map does not guarantee ordering
+  (check-equal? (has-ext? foo.txt-path 'txt) #t)
-  ; probably want to keep it in sequence
+  (check-equal? (has-ext? foo.bar.txt-path 'txt) #t))
-  (map (ƒ(key value) (change meta-hash (as-symbol key) (as-string value))) keys values)
+
-  meta-hash)
+
-
+;; take one extension off path
-
+(define/contract (remove-ext path)
-(define (magic-directory? path)
+  (path? . -> . path?)
  (and (directory-exists? path) 
       (or (ends-with? (path->string path) "requires")
           (ends-with? (path->string path) "compiled")
           )))
 (define (filename-of path)
  (let-values ([(dir filename ignored) (split-path path)])
    filename))
 (define (pollen-script? path)
  (let ([path-string (path->string (filename-of path))])
    (or (starts-with? path-string "pollen_") (starts-with? path-string "pollen-"))))
 (define (racket-file? path)
  (has-ext? path 'rkt))
 (define (pmap-source? path)
  (has-ext? path POLLEN_MAP_EXT))
 (define (template-source? path)
  (starts-with? (path->string (filename-of path)) (~a TEMPLATE_FILE_PREFIX)))
 (define (preproc-source? path)
  (has-ext? path POLLEN_PREPROC_EXT))
 (define (make-preproc-in-path path)
  (add-ext path POLLEN_PREPROC_EXT))
 (define (make-preproc-out-path path)
  (remove-ext path))
 (define (has-preproc-source? path)
  (file-exists? (make-preproc-in-path path)))
 (define (pollen-source? path)
  (has-ext? path POLLEN_SOURCE_EXT))
 (define (make-pollen-source-path thing)
  (add-ext (remove-ext (as-path thing)) POLLEN_SOURCE_EXT))
 (define (has-pollen-source? path)
  (file-exists? (make-pollen-source-path path)))  
 (define (insert-subdir path [subdir-in OUTPUT_SUBDIR])
  (let-values ([(dir filename ignored) (split-path path)])
    (when (equal? dir 'relative)
      (set! dir (string->path ".")))
    (letrec ([subdir-name (string->path (~a subdir-in))]
             [subdir (build-path dir subdir-name)])
      (when (not (directory-exists? subdir))
        (make-directory subdir))
      (build-path subdir filename))))
 ;;;;;;;;;;;;;;
 ; Moved from template.rkt
 ;;;;;;;;;;;;;;
 ; All from* functions should return a named-xexpr
 (define (from x query)
  ; cache x
  (let ([x (put x)])
    ; try finding it in metas, if not, find it in main, if not then return false
    (or (from-metas x query) (from-main x query))))
 (define (from-main x query) ; this used to be plain from
  ; check results first
  (let* ([x (put x)]
         [results (se-path*/list (list query) x)])
    ; if results exist, send back xexpr as output
    (if (not (empty? results))
        `(,query ,@results) ; todo: why use query as tag?
        #f)))
 (define (from-metas x key)
  (let* ([x (put x)]
         [meta-hash (make-meta-hash x)]
         [key (as-symbol key)])
    (if (in? meta-hash key)
        `(value ,(get meta-hash key)) ;todo: why use value as tag?
        #f)))
 (define (put x)
  ; handles either xexpr or pollen file as input
  (cond
    ; pass through xexpr as is
    ; put is optional for xexprs.
    ; it's only here to make the idiom smooth.
    [(named-xexpr? x) x] 
    ; todo: how to externalize pollen main tag into world name?
    [(file-exists? (as-path x)) (dynamic-require x 'main)]
    ; also try adding pollen file extension
    ; this makes put compatible with map references
    [(let ([x (make-pollen-source-path x)])
       (when (file-exists? x)
         (put x)))]
    [else (error "put: need named xexpr or pollen file, but got" x)]))
 (define (merge x)
  (cond
    [(named-xexpr? x)
     ; return content of xexpr.
     ; pollen language rules will splice these into the main flow.
     (if (empty? x)
         ""
         (let-values([(name attr content) (xexplode x)])
           content))]
    [(string? x) (list x)]))
 #|(define (merge-strings x)
  (when (empty? x) (error "merge-strings got empty x"))
  ;todo: filter metas?
  ; leaning toward no. Simplest behavior.
  ; function is not intended to be used with whole pollen body anyhow.
  (let ([x (merge x)])
    (string-join (filter string? (flatten x)) " ")))|#
 (define (merge-strings x)
  (string-join (filter string? (flatten x)) " "))
 (define (make-html x)
  (if (named-xexpr? x)
      (xexpr->string x)
      (let ([x (as-list x)])
        (when (all xexpr? x)
          (string-join (map xexpr->string x) "")))))
 ; generate *-as-html versions of functions
 (define-values (put-as-html merge-as-html merge-strings-as-html)
  (apply values (map (ƒ(proc) (ƒ(x) (make-html (proc x)))) (list put merge merge-strings))))
 (define (as-literal x)
  (set! x (flatten (list x))) ; coerce text or list to new list
  (merge `(literal-thing ,@x)))
 (define (make-url x)
  (if (exists? x)
      (str x ".html")
      "#")) ; funny null url that means "stay here"
 ;;;;;;;;;;;;;;;;;;;;;;;;;
 ; make these independent of local includes
 (define (map-topic topic . subtopics)
  `(,(string->symbol topic) ,@(filter-not whitespace? subtopics)))
 (define (meta key value) 
  `(meta ((name ,(as-string key))(content ,(as-string value)))))
 ; scribble's whitespace function misses trailing spaces wrapped in a list
 (define (whitespace? x)
  (cond
    [(list? x) (all scribble:whitespace? x)]
    [else (scribble:whitespace? x)]))
 ; remove empty elements
 (define (remove-empty x)
  (cond
    [(list? x) (map remove-empty (filter-not empty? x))]
    [else x]))
 (define (remove-void x)
  (cond
    [(list? x) (map remove-void (filter-not void? x))]
    [else x]))
 ; common idiom with lists:
 ; if list is empty, return empty
 ; otherwise do procedure
 (define (empty/else thing proc)
  (if (empty? thing)
      empty
      (proc thing)))
 ; common idiom with files:
 ; if the file exists, do procedure with it
 (define (file-exists?/do path proc)
  (if (file-exists? path)
      (proc path)
      #f))
 ; simple timer
 (define-syntax-rule (time expr)
  (begin 
    (define start-time (current-inexact-milliseconds))
    (define result expr)
    (define stop-time (current-inexact-milliseconds))
    (message "Time for" 'expr "=" (- stop-time start-time)) 
    result))
 ; utilities for working with file extensions
 (define (.+ x) (format ".~a" x))
 (define (get-ext path)
  (bytes->string/utf-8 (filename-extension path)))
 (define (has-ext? path ext)
  (let ([path-ext (filename-extension path)])
    ; returns true if f-ext exists, and equals ext, otherwise false
    (and path-ext (equal? (bytes->string/utf-8 path-ext) (~a ext)))))
 (define (remove-ext path)
  (path-replace-suffix path ""))
-(define (add-ext path ext)
+(module+ test  
-  (string->path (string-append (path->string path) (.+ ext))))
+  (check-equal? (remove-ext foo-path) foo-path)
-
+  (check-equal? (remove-ext foo.txt-path) foo-path)
-; find all xexpr names within another xexpr
+  (check-equal? (remove-ext foo.bar.txt-path) foo.bar-path))
 (define (gather-xexpr-names x)
  (cond
    [(named-xexpr? x) 
     (let-values([(name attr content) (xexplode x)])
       (flatten (cons name (map gather-xexpr-names content))))] 
    [else empty]))
 ; shorthand for define + dynamic require
 (define-syntax-rule (define-from module symbol)
  (define symbol (dynamic-require module 'symbol)))
 ; dynamic require or return false if not found
 ; allows constructs like:
 ; (or (require-now module symbol) "default value")
 (define (require-now module symbol)
  (dynamic-require module symbol (thunk #f)))
 ; define & provide in one easy step
 (define-syntax-rule (define/provide name expr ...)
  (begin (define name expr ...)(provide name)))
 ; xexpr->html
 (define (xexpr->html x)
  ;  (string-join (map xexpr->string x)))
  (xexpr->string x))
 (define (html->xexpr . stuff)
  (string->xexpr (string-join stuff "")))
 ; do a set of actions on same item
 (define ((tee . procs) thing)
  (apply values (map (ƒ(proc)(proc thing)) procs)))
 ; python-style try/except syntax
 (define-syntax-rule (try body (except tests ...))
  (with-handlers (tests ...) body))
 ; xexpr shortcut; map tag across items
 (define (map-tag tag-name xs)
  (map (ƒ(x) (list tag-name x)) xs))
-; trim from beginning & end of list
+;; take all extensions off path
-(define (trim things test)
+(define/contract (remove-all-ext path)
-  (dropf-right (dropf things test) test))
+  (path? . -> . path?)
  (define path-with-removed-ext (remove-ext path))
  (if (equal? path path-with-removed-ext)
      path
      (remove-all-ext path-with-removed-ext)))
-; trim whitespace from beginning & end of list
+(module+ test  
-(define (trim-whitespace things)
+  (check-equal? (remove-all-ext foo-path) foo-path)
-  (trim things whitespace?))
+  (check-equal? (remove-all-ext foo.txt-path) foo-path)
  (check-equal? (remove-all-ext foo.bar.txt-path) foo-path))
-; ----------------------------
+;; is it an xexpr attributes?
-; DECODER
+(define/contract (xexpr-attrs? x)
-; ----------------------------
+  (any/c . -> . boolean?)
 (define (splice-xexpr-content x [acc '()])
  ; takes a list and splices top-level sublists into main list
  ; used by merge function
  (cond
    [(empty? x) acc]
    [(and (xexpr-content? (car x)) (not (named-xexpr? (car x)))) (splice-xexpr-content (cdr x) `(,@acc ,@(car x)))]
    [else (splice-xexpr-content (cdr x) `(,@acc ,(car x)))]))
 (define (named-xexpr? x)
  ; meets basic xexpr contract, and is also a list starting with a symbol
  ; todo: rewrite this using match?
  ; todo: rewrite this recurively so errors can be pinpointed (for debugging)
  (and (xexpr? x) (list? x) (symbol? (car x))))
 (define (xexpr-attr-list? x)
  (define (attr-pair? x)
    ; list with two elements: first element is a symbol, second is a string
-    (and (list? x) (= (length x) 2) (symbol? (car x)) (string? (second x))))   
+    (and (list? x) (= (length x) 2) (symbol? (car x)) (string? (cadr x))))   
  ; a list where elements are attr pairs
-  (and (list? x) (all attr-pair? x)))
+  (and (list? x) (andmap attr-pair? x)))
-
+
-(define (xexpr-content? x) 
+;; is it xexpr content?
-  ; it's a list whose elements meet xexpr contract
+(define/contract (xexpr-content? x)
-  (and (list? x) (all xexpr? x)))
+  (any/c . -> . boolean?)
-
+  (and (list? x) (andmap xexpr? x)))
-(define (xexpr-has-attrs? x)
+
-  (and (named-xexpr? x) (> (length x) 1) (xexpr-attr-list? (second x)))) 
+;; is it a named x-expression?
-
+;; todo: rewrite this recurively so errors can be pinpointed (for debugging)
-(define (make-xexpr name (attr empty) (content empty)) 
+(define/contract (named-xexpr? x)
-  (when (not (symbol? name)) (error "make-xexpr: need a name, dude"))
+  (any/c . -> . boolean?)
-  (when (not (xexpr-attr-list? attr)) 
+  (and (xexpr? x) ; meets basic xexpr contract
-    (error "make-xexpr: attr must be list of attr pairs"))
+       (match x
-  ; todo: fix xexpr-content? test so I can use it here
+         [(list (? symbol? name) rest ...) ; is a list starting with a symbol
-  ; (when (not (xexpr-content? content)) content)
+          (or (xexpr-content? rest) ; the rest is content or ...
-  (when (not (list? content)) (error "make-xexpr: content must be a list"))
+              (and (xexpr-attrs? (car rest)) (xexpr-content? (cdr rest))))] ; attributes followed by content
-  
+         [else #f])))
-  (define xexpr `(,name))
+
-  (when (exists? attr) (set! xexpr `(,@xexpr ,attr)))
+(module+ test  
-  (when (exists? content) (set! xexpr `(,@xexpr ,@content)))
+  (check-equal? (named-xexpr? "foo") #f)
-  xexpr)
+  (check-equal? (named-xexpr? '(p "foo" "bar")) #t)
-
+  (check-equal? (named-xexpr? '(p ((key "value")) "foo" "bar")) #t)
-(define (xexplode x)
+  (check-equal? (named-xexpr? '(p "foo" "bar" ((key "value")))) #f)
-  (when (not (named-xexpr? x)) (error (format "xexplode: ~v not a named-xexpr" x)))
+  (check-equal? (named-xexpr? '("p" "foo" "bar")) #f)
-  (define-values (name attr content) (values (car x) empty empty))  
+  (check-equal? (named-xexpr? '(p 123)) #t)) ; why is this so?
  (if (xexpr-has-attrs? x)
      (set!-values (attr content) (values (second x) (cddr x))) ; attr comes back as a list of lists
      (set! content (cdr x))) ; content always comes back as a list
  (values name attr content)) 
 ; block is a named expression that's not on the inline list
 ; todo: bear in mind that browsers take the opposite view:
 ; that only elements on the block list are blocks
 ; and otherwise are treated as inline 
 (define (block-xexpr? x)
  (and (named-xexpr? x) (not (in? inline-tags (car x)))))
 (define (wrap-paragraph x) ; x is a list containing paragraph pieces
  ; if paragraph is just one block-level xexpr
  (if (and (= (length x) 1) (block-xexpr? (car x))) 
      (car x) ; leave it
      `(p ,@x))) ; otherwise wrap in p tag
 ; wrap initial quotes for hanging punctuation
 ; todo: improve this
 ; does not handle <p>“<em>thing</em> properly
 (define (wrap-hanging-quotes x) ; x is one paragraph
  (define-values (name attr content) (xexplode x))
  (cond 
    [(and (not (empty? content)) 
          (string? (car content)) 
          (> (string-length (car content)) 1))
     (let ([new-car 
            (letrec ([x (car content)] 
                     [first (get x 0)] 
                     [rest (get x 1 'end)])
              (cond
                [(member first '("\"" "“"))
                 ; this has to be span so that it's explicitly 
                 ; an inline element. If not,
                 ; things like linebreak detection won't work.
                 `(span ((class "dquo")) ,(~a #\“) ,rest)]
                [(member first '("\'" "‘")) 
                 `(span ((class "squo")) ,(~a #\‘) ,rest)]
                [else x]))])
       (make-xexpr name attr (cons new-car (cdr content))))]
    [(and (exists? content) (named-xexpr? (car content)))
     (make-xexpr name attr (cons (wrap-hanging-quotes (car content)) (cdr content)))]
    [else x]))
 ; how a list-item break is denoted: three or more newlines
 (define (list-item-break? x)
  (and (string? x) (regexp-match #rx"^\n\n\n+$" x)))
 ; how a paragraph break is denoted: two or more newlines
 (define (paragraph-break? x)
  ;  (equal? x PARAGRAPH_BREAK) ; obsolete: two newlines only
  (and (string? x) (regexp-match #rx"^\n\n+$" x)))
 ; convert single newline to br tag
 ; only if neither adjacent tag is a block
 ; otherwise delete
 (define (convert-linebreaks x)  ; x is list
  (remove-empty
   (for/list ([i (len x)])
     (cond
       [(equal? (get x i) LINE_BREAK)
        (if (none block-xexpr? (list (get x (sub1 i)) (get x (add1 i))))
            '(br)
            '())]
       [else (get x i)]))))
 ; find two or more adjacent newlines and bring them together 
 ; works on any number of newlines
 (define (merge-newlines x)
  (define (newline? x)
    (and (string? x) (equal? "\n" x)))
  (define (not-newline? x)
    (not (newline? x)))
  (define (merge-newlines-inner x [acc '()]) ; x is list
    (if (empty? x)
        acc
        (let-values ([(leading-newlines remainder) (splitf-at x newline?)])
          (if (not (empty? leading-newlines))
              (merge-newlines-inner remainder `(,@acc  ,(string-join leading-newlines "")))
              (merge-newlines-inner (dropf remainder not-newline?) `(,@acc ,@(takef remainder not-newline?)))))))
  (cond
    ((list? x) (merge-newlines-inner (map merge-newlines x)))
    (else x)))
 (define (typogrify string)
  ; make set of functions for replacers
  (define (make-replacers query+subs)
    (map (ƒ(q+s) (ƒ(str) (regexp-replace* (first q+s) str (second q+s)))) query+subs))
  ; just store the query strings + replacement strings
  (define dashes 
    ; fix em dashes first, else they'll be mistaken for en dashes
    ; [\\s ] is whitespace + nonbreaking space
    '((#px"[\\s ]*(---|—)[\\s ]*" "—") ; em dash
      (#px"[\\s ]*(--|–)[\\s ]*" "–"))) ; en dash
  (define smart-quotes
    '((#px"(?<=\\w)'(?=\\w)" "’") ; apostrophe
      (#px"(?<!\\w)'(?=\\w)" "‘") ; single_at_beginning
      (#px"(?<=\\S)'(?!\\w)" "’") ; single_at_end
      (#px"(?<!\\w)\"(?=\\w)" "“") ; double_at_beginning
      (#px"(?<=\\S)\"(?!\\w)" "”"))) ; double_at_end
  ; todo: is this transformation obsolete due to css ligatures?
  ; maybe not, because soft hyphens mess up css ligature function.
  ; \u00AD is a soft hyphen, which might appear in between letters
  (define ligatures
    '((#px"f\u00AD?i" "ﬁ")
      (#px"f\u00AD?f" "ﬀ")
      (#px"f\u00AD?l" "ﬂ")
      (#px"f\u00AD?f\u00AD?i" "ﬃ")
      (#px"f\u00AD?f\u00AD?l" "ﬄ")))
  ; put replacers in desired order here
  (define replacers (make-replacers (append dashes smart-quotes))) 
  ; compose goes from last to first, so reverse order
  ;  ((apply compose1 hyphenate-text-soft (reverse replacers)) string))
  ((apply compose1 (reverse replacers)) string))
 ; find the last word space and replace it with a nonbreaking space
 ; doesn't work on weirdo cases that need backtracking, like:
 ; (define t4 '(p "hello from all the freaks" "at the " (em "factory.")))
 ; but cures enough problems to be worthwhile.
 (define (nonbreaking-last-space x)
  (define nbsp #\ ) ; use an Ø if you want to make the results visible
  (define minimum-word-length (add1 5)) ; add1 to account for final punctuation
  ; todo: parameterize this, as it will be different for each project
  (define tags-to-pay-attention-to '(p aside)) ; only apply to paragraphs
  (define (replace-last-space str)
    (if (in? str #\space)
        (let ([reversed-str-list (reverse (string->list str))])
          (define-values (last-word-chars other-chars) 
            (splitf-at reversed-str-list (λ(i) (not (eq? i #\space)))))
          (list->string (reverse (append last-word-chars 
                                         ; OK for long words to be on their own line.
                                         (if (< (len last-word-chars) minimum-word-length)
                                             ; first char of other-chars will be the space, so use cdr
                                             (cons nbsp (cdr other-chars))
                                             other-chars)))))
        str))
  (define (find-last-word-space x) ; recursively traverse xexpr
    (cond
      [(string? x) (replace-last-space x)] 
      [(named-xexpr? x) 
       (let-values([(name attr content) (xexplode x)])
         (if (> (length content) 0) ; content is list of xexprs
             (let-values ([(all-but-last last) (split-at content (sub1 (length content)))]) 
               (make-xexpr name attr `(,@all-but-last ,(find-last-word-space (car last)))))
             x))]
      [else x]))
  (if (in? tags-to-pay-attention-to (car x))
      (find-last-word-space x)
      x))
 (define (prep-paragraph-flow x)
  (convert-linebreaks (merge-newlines (trim-whitespace x))))
 (define (map-xexpr-content proc x #:only [only-proc (ƒ(x) x)])
  ; why map and not apply? Because map guarantees a list of the same length.
  ; whereas apply does not. So it works as an implied constraint.
  (if (named-xexpr? x)
      (let-values([(name attr content) (xexplode x)]) 
        (make-xexpr name attr (map (ƒ(x) (if (only-proc x) (proc x) x)) content)))
      (error "map-xexpr-content: Input is not a named xexpr and has no content:" x)))
 ; Main decode function
 (define (decode x)
  (define (&decode x)
    (cond
      [(named-xexpr? x)
       (let-values([(name attr content) (xexplode x)]) 
         (define decoded-x (make-xexpr name attr (&decode content)))
         (if (block-xexpr? decoded-x)
             ; add nonbreaking-last-space to the next line when ready
             (wrap-hanging-quotes (nonbreaking-last-space decoded-x)) ; do special processing for block xexprs
             decoded-x))]
      [(xexpr-content? x) ; a list of xexprs
       (let ([x (prep-paragraph-flow x)]) 
         (map &decode (if (any paragraph-break? x) ; need this condition to prevent infinite recursion
                          (map wrap-paragraph (splitf-at* x paragraph-break?)) ; split into ¶¶
                          x)))]     
      [(string? x) (typogrify x)]
      [else x]))
  (define (stringify x) ; convert numbers to strings
    (cond
      [(list? x) (map stringify x)]
      [(number? x) (~a x)]
      [else x]))
  (let* ([x (stringify x)]
         [x (trim-whitespace x)])
    (if (named-xexpr? x)
        (&decode x)
        ;todo: improve this error message, more specific location
        ; now, it just spits out the whole defective content
        (error (format "decode: ~v not a full named-xexpr" x)))))
 (define (splitf-at* pieces test)
  ; split list into list of sublists using test
  (define (splitf-at*-inner pieces [acc '()]) ; use acc for tail recursion
    (if (empty? pieces) 
        acc
        (let-values ([(item rest) 
                      (splitf-at (dropf pieces test) (compose1 not test))])
          (splitf-at*-inner rest `(,@acc ,item)))))
  (splitf-at*-inner (trim pieces test)))
 (define (make-missing-source-files map-xexpr)
  ; use cdr to omit body tag
  (define source-names (map (ƒ(x) (add-ext (string->path (as-string x)) POLLEN_SOURCE_EXT)) (flatten (cdr map-xexpr))))
  (define (make-source-if-missing x)
    (if (not (file-exists? x))
        (begin
          (display-to-file MISSING_FILE_BOILERPLATE x)
          (format "Created file: ~a" x))
        (format "Already exists: ~a" x)))
  (display (string-join (map make-source-if-missing source-names) "\n")))