various tidying. all files compile now.

command.rkt

@@ -1,61 +1,57 @@
 #lang racket
 
+(require (for-syntax "readability.rkt"))
+
 (define-syntax (handle-pollen-command stx)
   (datum->syntax stx
-                 (let ([arg (if (= (vector-length (current-command-line-arguments)) 0)
+                 (let* ([args (current-command-line-arguments)]
-                                ""
+                        [arg (if (> (len args) 0) (get args 0) "")])
-                                (vector-ref (current-command-line-arguments) 0))])
                    (case arg
-                     [("serve") 
+                     [("serve") `(require "server.rkt")]
-                      `(require "server.rkt")]
+                     [("regenerate") `(begin
-                     [("regenerate")  
+                                        (displayln "Regenerate all...")
-                      `(begin
+                                        (require "regenerate.rkt")
-                         (displayln "Regenerate all...")
+                                        (regenerate-all-files))]
-                         (require "regenerate.rkt")
+                     [("clone") (let ([target-path 
-                         (regenerate-all-files))]
+                                       (if (> (len args) 1)
-                     [("clone")
+                                           (->path (get args 1))
-                      (let ([target-path (if (> (vector-length (current-command-line-arguments)) 1)
+                                           (build-path (find-system-path 'desk-dir) (->path "clone")))])
-                                             (string->path (vector-ref (current-command-line-arguments) 1))
+                                  `(begin
-                                             (build-path (find-system-path 'desk-dir) (string->path "clone")))])
+                                     (displayln "Clone & prune ...")
-                        
+                                     (require racket/file)
-                        `(begin
+                                     (require "tools.rkt")
-                           (displayln "Clone & bone...")
-                           (require racket/file)
-                           (require "tools.rkt")
                                      
-                           (define (pollen-related-file? file)
+                                     (define (pollen-related-file? file)
-                             (any (list
+                                       (ormap (λ(proc) (proc file)) (list
-                                        pollen-source? 
+                                                                     pollen-source? 
-                                        preproc-source? 
+                                                                     preproc-source? 
-                                        template-source?
+                                                                     template-source?
-                                        pmap-source?
+                                                                     pmap-source?
-                                        pollen-script?
+                                                                     pollen-script?
-                                        magic-directory?
+                                                                     magic-directory?
-                                        racket-file?)
+                                                                     racket-file?)))
-                                  file))
                                      
-                           (define (delete-it path)
+                                     (define (delete-it path)
-                             (when (directory-exists? path)
+                                       (when (directory-exists? path)
-                               (delete-directory/files path))
+                                         (delete-directory/files path))
-                             (when (file-exists? path)
+                                       (when (file-exists? path)
-                               (delete-file path)))
+                                         (delete-file path)))
                                      
-                           (let ([source-dir (current-directory)]
+                                     (let ([source-dir (current-directory)]
-                                 [target-dir ,target-path])
+                                           [target-dir ,target-path])
-                             (when (directory-exists? target-dir)
+                                       (when (directory-exists? target-dir)
-                               (delete-directory/files target-dir))
+                                         (delete-directory/files target-dir))
-                             (copy-directory/files source-dir target-dir)
+                                       (copy-directory/files source-dir target-dir)
-                             (map delete-it (find-files pollen-related-file? target-dir))
+                                       (map delete-it (find-files pollen-related-file? target-dir))
-                             (displayln (format "Completed to ~a" ,target-path))
+                                       (displayln (format "Completed to ~a" ,target-path))
-                             )))]
+                                       )))]
-                     [("")
+                     [("") `(displayln "No command given")]
-                      `(displayln "No command given")]
+                     ;; treat other input as a possible file name for regeneration
-                     [else
+                     [else (let ([possible-file (->path arg)])
-                      (let ([possible-file (string->path arg)])
+                             (if (file-exists? possible-file)
-                        (if (file-exists? possible-file)
+                                 `(begin
-                            `(begin
+                                    (require (planet mb/pollen/regenerate))
-                               (require (planet mb/pollen/regenerate))
+                                    (regenerate ,possible-file))
-                               (regenerate ,possible-file))
+                                 `(displayln (format "No command defined for ~a" ,arg))))]))))
-                            `(displayln (format "No command defined for ~a" ,arg))))]))))
 
 (handle-pollen-command)

decode.rkt

@@ -6,20 +6,27 @@
 (module+ test (require rackunit))
 
 (require "tools.rkt")
-(require (prefix-in html: "library/html.rkt"))
 (provide (all-defined-out))
 
-
 ;; split list into list of sublists using test-proc
-(define/contract (splitf-at* xs test-proc)
+(define/contract (splitf-at* xs split-test)
-  (list? procedure? . -> . (λ(i) (match i [(list (? list?) ...) #t][else #f])))
+  ;; todo: better error message when split-test is not a predicate
-  (define (&splitf-at* pieces [acc '()]) ; use acc for tail recursion
+  (list? predicate/c . -> . (listof list?))
-    (if (empty? pieces) 
+  (define (&splitf-at* xs [acc '()]) ; use acc for tail recursion
-        acc
+    (if (empty? xs) 
+        ;; reverse because accumulation is happening backward 
+        ;; (because I'm using cons to push latest match onto front of list)
+        (reverse acc)
         (let-values ([(item rest) 
-                      (splitf-at (dropf pieces test-proc) (compose1 not test-proc))])
+                      ;; drop matching elements from front
-          (&splitf-at* rest `(,@acc ,item)))))
+                      ;; then split on nonmatching 
-  (&splitf-at* (trim xs test-proc)))
+                      ;; = nonmatching item + other elements (which will start with matching)
+                      (splitf-at (dropf xs split-test) (compose1 not split-test))])
+          ;; recurse, and store new item in accumulator
+          (&splitf-at* rest (cons item acc)))))
+  
+  ;; trim off elements matching split-test
+  (&splitf-at* (trim xs split-test)))
 
 (module+ test
   (check-equal? (splitf-at* '(1 2 3 4 5 6) even?) '((1)(3)(5)))
@@ -60,26 +67,10 @@
                 '(p "\n" "foo" "\n\n" "bar" (em "\n\n\n"))))
 
 
-(define block-tags html:block-tags)
-(define (register-block-tag tag)
-  (set! block-tags (cons tag block-tags)))
 
 ;; todo: add native support for list-xexpr
 ;; decode triple newlines to list items
 
-;; is the tagged-xexpr a block element (as opposed to inline)
-;; 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))))
-
-(module+ test
-  (check-true (block-xexpr? '(p "foo")))
-  (check-true (block-xexpr? '(div "foo")))
-  (check-false (block-xexpr? '(em "foo")))
-  (check-false (block-xexpr? '(barfoo "foo")))
-  (check-true (begin (register-block-tag 'barfoo) (block-xexpr? '(barfoo "foo")))))
-
 
 ;; convert numbers to strings
 ;; maybe this isn't necessary
@@ -90,19 +81,6 @@
   (check-equal? (stringify '(p 1 2 "foo" (em 4 "bar"))) '(p "1" "2" "foo" (em "4" "bar"))))
 
 
-
-
-
-(module+ test
-  (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")))))
-
-
-
 ;; trim from beginning & end of list
 (define (trim items test-proc)
   (list? procedure? . -> . list?)
@@ -113,9 +91,6 @@
   (check-equal? (trim (list 1 3 2 4 5 6 8 9 13) odd?) '(2 4 5 6 8)))
 
 
-
-
-
 ;; decoder wireframe
 (define/contract (decode nx
                          #:exclude-xexpr-tags [excluded-xexpr-tags '()]
@@ -126,7 +101,7 @@
                          #:inline-xexpr-proc [inline-xexpr-proc (λ(x)x)]
                          #:string-proc [string-proc (λ(x)x)])
   ;; use xexpr/c for contract because it gives better error messages
-  ((xexpr/c) (#:exclude-xexpr-tags (λ(i) (or (symbol? i) (list? i)))
+  ((xexpr/c) (#:exclude-xexpr-tags list?
                                    #:xexpr-tag-proc procedure?
                                    #:xexpr-attr-proc procedure?
                                    #:xexpr-elements-proc procedure?
@@ -141,18 +116,20 @@
   (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? . excluded-xexpr-tags)    
-                               x
+                               x ; let x pass through untouched
-                               (let ([decoded-xexpr 
+                               (let ([decoded-xexpr (apply make-tagged-xexpr 
-                                      (apply make-tagged-xexpr (map &decode (list tag attr elements)))])
+                                             (map &decode (list tag attr elements)))])
                                  ((if (block-xexpr? decoded-xexpr)
                                       block-xexpr-proc
                                       inline-xexpr-proc) decoded-xexpr))))]
       [(xexpr-tag? x) (xexpr-tag-proc x)]
       [(xexpr-attr? x) (xexpr-attr-proc x)]
+      ;; need this for operations that may depend on context in list
       [(xexpr-elements? x) (map &decode (xexpr-elements-proc x))]
       [(string? x) (string-proc x)]
-      [else x]))
+      ;; if something has made it through undecoded, that's a problem
+      [else (error "Can't decode" x)]))
   
   
   (&decode nx))

main.rkt

@@ -20,7 +20,7 @@
    
    ; doclang2_raw is a clone of scribble/doclang2 with decode disabled
    ; helpful because it collects & exports content via 'doc
-   (module pollen-inner (planet mb/pollen/doclang2_raw)
+   (module pollen-inner (planet mb/pollen/lang/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))

pollen-file-tools.rkt

@@ -0,0 +1,121 @@
+#lang racket/base
+(require racket/contract)
+(require (only-in racket/path filename-extension))
+(require "world.rkt" "readability.rkt")
+
+(provide (all-defined-out))
+
+(module+ test (require rackunit))
+
+;; does path have a certain extension
+(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) (->string ext))))
+
+(module+ test
+  (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)))
+  ;; test the sample paths before using them for other tests
+  (define foo-paths (list foo-path foo.txt-path foo.bar-path foo.bar.txt-path))
+  (for-each check-equal? (map path->string foo-paths) foo-path-strings))
+
+
+(module+ test
+  (check-false (has-ext? foo-path 'txt)) 
+  (check-true (has-ext? foo.txt-path 'txt))
+  (check-true (has-ext? foo.bar.txt-path 'txt))
+  (check-false (has-ext? foo.bar.txt-path 'doc))) ; wrong extension
+
+
+;; get file extension as a string
+(define/contract (get-ext path)
+  (path? . -> . string?)
+  (bytes->string/utf-8 (filename-extension path)))
+
+(module+ test
+  (check-equal? (get-ext (->path "foo.txt")) "txt")
+  ;; todo: how should get-ext handle input that has no extension?
+  ;(check-equal? (get-ext (->path "foo")) "")
+  )
+
+
+;; put extension on path
+(define/contract (add-ext path ext)
+  (path? (or/c symbol? string?) . -> . path?)
+  (string->path (string-append (->string path) "." (->string ext))))
+
+(module+ test
+  (check-equal? (add-ext (string->path "foo") "txt") (string->path "foo.txt")))
+
+;; take one extension off path
+(define/contract (remove-ext path)
+  (path? . -> . path?)
+  (path-replace-suffix path ""))
+
+(module+ test  
+  (check-equal? (remove-ext foo-path) foo-path)
+  (check-equal? (remove-ext foo.txt-path) foo-path)
+  (check-equal? (remove-ext foo.bar.txt-path) foo.bar-path)
+  (check-not-equal? (remove-ext foo.bar.txt-path) foo-path)) ; does not remove all extensions
+
+
+;; take all extensions off path
+(define/contract (remove-all-ext path)
+  (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)))
+
+(module+ test  
+  (check-equal? (remove-all-ext foo-path) foo-path)
+  (check-equal? (remove-all-ext foo.txt-path) foo-path)
+  (check-not-equal? (remove-all-ext foo.bar.txt-path) foo.bar-path) ; removes more than one ext
+  (check-equal? (remove-all-ext foo.bar.txt-path) foo-path))
+
+(define/contract (preproc-source? x)
+  (any/c . -> . boolean?)
+  (has-ext? (->path x) POLLEN_PREPROC_EXT))
+
+(define/contract (has-preproc-source? x)
+  (any/c . -> . boolean?)
+  (file-exists? (make-preproc-in-path (->path x))))
+
+(define/contract (has-pollen-source? x)
+  (any/c . -> . boolean?)
+  (file-exists? (make-pollen-source-path (->path x))))
+
+(define/contract (needs-preproc? x)
+  (any/c . -> . boolean?)
+  ; it's a preproc source file, or a file that's the result of a preproc source
+  (ormap (λ(proc) (proc (->path x))) (list preproc-source? has-preproc-source?)))
+
+(define/contract (needs-template? x)
+  (any/c . -> . boolean?)
+  ; it's a pollen source file
+  ; or a file (e.g., html) that has a pollen source file
+  (ormap (λ(proc) (proc (->path x))) (list pollen-source? has-pollen-source?)))
+
+(define/contract (pmap-source? x)
+  (any/c . -> . boolean?)
+  (has-ext? (->path x) POLLEN_MAP_EXT))
+
+(define/contract (pollen-source? x)
+  (any/c . -> . boolean?)
+  (has-ext? (->path x) POLLEN_SOURCE_EXT))
+
+
+
+(define/contract (make-preproc-in-path path)
+  (path? . -> . path?)
+  (add-ext path POLLEN_PREPROC_EXT))
+
+(define/contract (make-preproc-out-path path)
+  (path? . -> . path?)
+  (remove-ext path))
+
+(define/contract (make-pollen-source-path thing)
+  (path? . -> . path?)
+  (add-ext (remove-ext (->path thing)) POLLEN_SOURCE_EXT))

predicates.rkt

@@ -0,0 +1,131 @@
+#lang racket/base
+(require racket/contract racket/match racket/list xml)
+(require (prefix-in scribble: (only-in scribble/decode whitespace?)))
+(require (prefix-in html: "library/html.rkt"))
+(require "world.rkt" "readability.rkt" "pollen-file-tools.rkt")
+
+(module+ test (require rackunit))
+
+(provide (all-defined-out)
+         (all-from-out "pollen-file-tools.rkt"))
+
+
+;; add a block tag to the list
+;; this function is among the predicates because it alters a predicate globally.
+(define/contract (register-block-tag tag)
+  (symbol? . -> . void?)
+  (set! block-tags (cons tag block-tags)))
+
+;; initial set of block tags: from html
+(define block-tags html:block-tags)
+
+
+;; is the tagged-xexpr a block element (as opposed to inline)
+;; tags are inline unless they're registered as block tags.
+(define/contract (block-xexpr? x)
+  (any/c . -> . boolean?)
+  ((tagged-xexpr? x) . and . (->boolean ((car x) . in? . block-tags))))
+
+(module+ test
+  (check-true (block-xexpr? '(p "foo")))
+  (check-true (block-xexpr? '(div "foo")))
+  (check-false (block-xexpr? '(em "foo")))
+  (check-false (block-xexpr? '(barfoo "foo")))
+  (check-true (begin (register-block-tag 'barfoo) (block-xexpr? '(barfoo "foo")))))
+
+
+;; is it an xexpr tag?
+(define/contract (xexpr-tag? x)
+  (any/c . -> . boolean?)
+  (symbol? x)) 
+
+;; is it an xexpr attributes?
+(define/contract (xexpr-attr? x)
+  (any/c . -> . boolean?)
+  (match x
+    ; list of symbol + string pairs
+    [(list (list (? symbol? key) (? string? value)) ...) #t]
+    [else #f]))
+
+(module+ test  
+  (check-true (xexpr-attr? empty))
+  (check-true (xexpr-attr? '((key "value"))))
+  (check-true (xexpr-attr? '((key "value") (foo "bar"))))
+  (check-false (xexpr-attr? '((key "value") "foo" "bar"))) ; content, not attr
+  (check-false (xexpr-attr? '(key "value"))) ; not a nested list
+  (check-false (xexpr-attr? '(("key" "value")))) ; two strings
+  (check-false (xexpr-attr? '((key value))))) ; two symbols
+
+
+;; 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 xexpr-element? elem)]
+    [else #f]))
+
+(module+ test  
+  (check-true (xexpr-elements? '("p" "foo" "123")))
+  (check-false (xexpr-elements? "foo")) ; not a list
+  (check-false (xexpr-elements? '("p" "foo" 123))) ; includes number
+  (check-false (xexpr-elements? '(p "foo" "123"))) ; includes symbol
+  (check-false (xexpr-elements? '(((key "value")) "foo" "bar"))) ; includes attr
+  (check-false (xexpr-elements? '("foo" "bar" ((key "value")))))) ; malformed
+
+
+;; is it a named x-expression?
+;; todo: rewrite this recurively so errors can be pinpointed (for debugging)
+(define/contract (tagged-xexpr? x)
+  (any/c . -> . boolean?)
+  (and (xexpr? x) ; meets basic xexpr contract
+       (match x
+         [(list (? symbol? name) rest ...) ; is a list starting with a symbol
+          (or (xexpr-elements? rest) ; the rest is content or ...
+              (and (xexpr-attr? (car rest)) (xexpr-elements? (cdr rest))))] ; attr + content 
+         [else #f])))
+
+(module+ test  
+  (check-true (tagged-xexpr? '(p "foo" "bar")))
+  (check-true (tagged-xexpr? '(p ((key "value")) "foo" "bar")))
+  (check-false (tagged-xexpr? "foo")) ; not a list with symbol
+  (check-false (tagged-xexpr? '(p "foo" "bar" ((key "value"))))) ; malformed
+  (check-false (tagged-xexpr? '("p" "foo" "bar"))) ; no name
+  (check-false (tagged-xexpr? '(p 123)))) ; content is a number
+
+
+;; test for well-formed meta
+(define/contract (meta-xexpr? x)
+  (any/c . -> . boolean?)
+  (match x
+    [`(meta ,(? string? key) ,(? string? value)) #t]
+    [else #f]))
+
+(module+ test
+  (check-true (meta-xexpr? '(meta "key" "value")))
+  (check-false (meta-xexpr? '(meta "key" "value" "foo")))
+  (check-false (meta-xexpr? '(meta))))
+
+
+;; 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-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")))))
+
+

readability.rkt

@@ -121,7 +121,7 @@
 ;; general way of fetching an item from a container
 (define/contract (get container start [end #f])
   ((gettable-container? any/c) ((λ(i)(or (integer? i) (and (symbol? i) (equal? i 'end))))) 
-                      . ->* . any/c)
+                               . ->* . any/c)
   
   (set! end
         (if (sliceable-container? container)
@@ -197,3 +197,4 @@
   (check-true ('o . in? . 'foobar))
   (check-false ('z . in? . 'foobar))
   (check-false ("F" . in? . #\F)))
+

regenerate.rkt

@@ -69,39 +69,6 @@
 
 
 
-(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 (->path thing)) POLLEN_SOURCE_EXT))
-
-(define (has-pollen-source? path)
-  (file-exists? (make-pollen-source-path path)))  
-
-(define (needs-preproc? path)
-  ; it's a preproc source file, or a file that's the result of a preproc source
-  (ormap (λ(proc) (proc path)) (list preproc-source? has-preproc-source?)))
-
-(define (needs-template? path)
-  ; it's a pollen source file
-  ; or a file (e.g., html) that has a pollen source file
-  (ormap (λ(proc) (proc path)) (list pollen-source? has-pollen-source?)))
-
-(define (pmap-source? path)
-  (has-ext? path POLLEN_MAP_EXT))
-
 (define (regenerate path #:force [force #f])
   ; dispatches path-in to the right place
   
@@ -176,8 +143,10 @@
     ;; todo: next
     ;;;;;;;;;;;;;;
     
-    (define meta-hash (make-meta-hash (put source-path)))
+    (define metas (dynamic-require source-path 'metas))
-    (set! template-name (hash-ref-or meta-hash TEMPLATE_META_KEY DEFAULT_TEMPLATE)))
+    (set! template-name (if (TEMPLATE_META_KEY . in? . metas)
+                            (get metas TEMPLATE_META_KEY)
+                            DEFAULT_TEMPLATE)))
   (define template-path (build-path source-dir template-name))
   ; refresh template (it might have its own p file)
   (regenerate template-path #:force force)

server.rkt

@@ -51,8 +51,8 @@
   (define path (build-path pollen-file-root filename))
   (regenerate path)
   (dynamic-rerequire path)
-  (define-from path body)
+  (define main (dynamic-require path 'main))
-  body)
+  main)
 
 
 (define (format-as-code data)
@@ -73,19 +73,19 @@
 (define (route-index req)   
   ; set up filter functions by mapping a function-maker for each file type
   (define-values (pollen-file? preproc-file? pmap-file?)
-    (apply values (map (ƒ(ext)(ƒ(f)(has-ext? f ext))) (list POLLEN_SOURCE_EXT POLLEN_PREPROC_EXT POLLEN_MAP_EXT))))
+    (apply values (map (λ(ext)(λ(f)(has-ext? f ext))) (list POLLEN_SOURCE_EXT POLLEN_PREPROC_EXT POLLEN_MAP_EXT))))
   (define (template-file? x)
     (define-values (dir name ignore) (split-path x))
-    (=str (get (as-string name) 0) TEMPLATE_FILE_PREFIX))
+    (equal? (get (->string name) 0) TEMPLATE_FILE_PREFIX))
   ; get lists of files by mapping a filter function for each file type
   (define-values (pollen-files preproc-files pmap-files template-files)
-    (apply values (map (ƒ(test) (filter test (directory-list pollen-file-root))) (list pollen-file? preproc-file? pmap-file? template-file?))))
+    (apply values (map (λ(test) (filter test (directory-list pollen-file-root))) (list pollen-file? preproc-file? pmap-file? template-file?))))
   ; the actual post-p files may not have been generated yet
-  (define post-preproc-files (map (ƒ(path) (remove-ext path)) preproc-files))
+  (define post-preproc-files (map (λ(path) (remove-ext path)) preproc-files))
   ; make a combined list of p-files and post-p files
   (define all-preproc-files (sort (append preproc-files post-preproc-files) #:key path->string string<?))
   
-  (define post-pollen-files (map (ƒ(path) (add-ext (remove-ext path) 'html)) pollen-files))
+  (define post-pollen-files (map (λ(path) (add-ext (remove-ext path) 'html)) pollen-files))
   (define all-pollen-files (sort (append pollen-files post-pollen-files) #:key path->string string<?))
   
   
@@ -95,9 +95,9 @@
                [preproc-source (add-ext file POLLEN_PREPROC_EXT)]
                [file-string (path->string file)]
                [name (case type 
-                       ['direct (str file-string)]
+                       ['direct (->string file-string)]
                        ['preproc-source "source"]
-                       [else (str type)])]
+                       [else (->string type)])]
                [target (case type
                          ['direct name]
                          [(source xexpr) (format "/~a/~a" type source)]
@@ -107,7 +107,7 @@
         `(td (a ((href ,target)) ,name))))
     `(tr ,(make-link-cell 'direct) ,@(map make-link-cell routes)))
   
-  (if (all empty? (list pmap-files all-pollen-files all-preproc-files template-files))
+  (if (andmap empty? (list pmap-files all-pollen-files all-preproc-files template-files))
       (response/xexpr '(body "No files yet. Get to work!"))
       (response/xexpr 
        `(body 
@@ -115,12 +115,12 @@
                 "td:hover {background: #eee}")
          (table ((style "font-family:Concourse T3;font-size:115%"))
                 ; options for pmap files and template files
-                ,@(map (ƒ(file) (make-file-row file '(raw))) (append pmap-files template-files))
+                ,@(map (λ(file) (make-file-row file '(raw))) (append pmap-files template-files))
                 ; options for pollen files
-                ,@(map (ƒ(file) (make-file-row file '(raw source xexpr force))) post-pollen-files)
+                ,@(map (λ(file) (make-file-row file '(raw source xexpr force))) post-pollen-files)
                 ; options for preproc files
-                ; branching in ƒ is needed so these files can be interleaved on the list
+                ; branching in λ is needed so these files can be interleaved on the list
-                ,@(map (ƒ(file) (make-file-row file '(raw preproc-source))) post-preproc-files))))))
+                ,@(map (λ(file) (make-file-row file '(raw preproc-source))) post-preproc-files))))))
 
 
 (displayln "Ready to rock")

tools.rkt

@@ -1,152 +1,22 @@
 #lang racket/base
 (require racket/contract racket/match)
-(require (only-in racket/path filename-extension))
 (require (only-in racket/format ~a))
 (require racket/list)
 (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")
+(require "readability.rkt" "debug.rkt" "predicates.rkt")
-(provide (all-defined-out) (all-from-out "readability.rkt" "debug.rkt"))
+(provide (all-defined-out) (all-from-out "readability.rkt" "debug.rkt" "predicates.rkt"))
 
 ;; setup for test cases
-(module+ test
+(module+ test (require rackunit))
-  (require rackunit)
-  (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)))
-  ;; test the sample paths before using them for other tests
-  (define foo-paths (list foo-path foo.txt-path foo.bar-path foo.bar.txt-path))
-  (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)
   (make-tagged-xexpr (->symbol topic) empty (filter-not whitespace? subtopics)))
 
 
-;; does path have a certain extension
-(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) (->string ext))))
-
-(module+ test
-  (check-false (has-ext? foo-path 'txt)) 
-  (check-true (has-ext? foo.txt-path 'txt))
-  (check-true (has-ext? foo.bar.txt-path 'txt))
-  (check-false (has-ext? foo.bar.txt-path 'doc))) ; wrong extension
-
-
-;; put extension on path
-(define/contract (add-ext path ext)
-  (path? (or/c symbol? string?) . -> . path?)
-  (string->path (string-append (->string path) "." (->string ext))))
-
-(module+ test
-  (check-equal? (add-ext (string->path "foo") "txt") (string->path "foo.txt")))
-
-;; take one extension off path
-(define/contract (remove-ext path)
-  (path? . -> . path?)
-  (path-replace-suffix path ""))
-
-(module+ test  
-  (check-equal? (remove-ext foo-path) foo-path)
-  (check-equal? (remove-ext foo.txt-path) foo-path)
-  (check-equal? (remove-ext foo.bar.txt-path) foo.bar-path)
-  (check-not-equal? (remove-ext foo.bar.txt-path) foo-path)) ; does not remove all extensions
-
-
-;; take all extensions off path
-(define/contract (remove-all-ext path)
-  (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)))
-
-(module+ test  
-  (check-equal? (remove-all-ext foo-path) foo-path)
-  (check-equal? (remove-all-ext foo.txt-path) foo-path)
-  (check-not-equal? (remove-all-ext foo.bar.txt-path) foo.bar-path) ; removes more than one ext
-  (check-equal? (remove-all-ext foo.bar.txt-path) foo-path))
-
-;; is it an xexpr tag?
-(define/contract (xexpr-tag? x)
-  (any/c . -> . boolean?)
-  (symbol? x)) 
-
-;; is it an xexpr attributes?
-(define/contract (xexpr-attr? x)
-  (any/c . -> . boolean?)
-  (match x
-    ; list of symbol + string pairs
-    [(list (list (? symbol? key) (? string? value)) ...) #t]
-    [else #f]))
-
-(module+ test  
-  (check-true (xexpr-attr? empty))
-  (check-true (xexpr-attr? '((key "value"))))
-  (check-true (xexpr-attr? '((key "value") (foo "bar"))))
-  (check-false (xexpr-attr? '((key "value") "foo" "bar"))) ; content, not attr
-  (check-false (xexpr-attr? '(key "value"))) ; not a nested list
-  (check-false (xexpr-attr? '(("key" "value")))) ; two strings
-  (check-false (xexpr-attr? '((key value))))) ; two symbols
-
-
-;; 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 xexpr-element? elem)]
-    [else #f]))
-
-(module+ test  
-  (check-true (xexpr-elements? '("p" "foo" "123")))
-  (check-false (xexpr-elements? "foo")) ; not a list
-  (check-false (xexpr-elements? '("p" "foo" 123))) ; includes number
-  (check-false (xexpr-elements? '(p "foo" "123"))) ; includes symbol
-  (check-false (xexpr-elements? '(((key "value")) "foo" "bar"))) ; includes attr
-  (check-false (xexpr-elements? '("foo" "bar" ((key "value")))))) ; malformed
-
-
-;; is it a named x-expression?
-;; todo: rewrite this recurively so errors can be pinpointed (for debugging)
-(define/contract (tagged-xexpr? x)
-  (any/c . -> . boolean?)
-  (and (xexpr? x) ; meets basic xexpr contract
-       (match x
-         [(list (? symbol? name) rest ...) ; is a list starting with a symbol
-          (or (xexpr-elements? rest) ; the rest is content or ...
-              (and (xexpr-attr? (car rest)) (xexpr-elements? (cdr rest))))] ; attr + content 
-         [else #f])))
-
-(module+ test  
-  (check-true (tagged-xexpr? '(p "foo" "bar")))
-  (check-true (tagged-xexpr? '(p ((key "value")) "foo" "bar")))
-  (check-false (tagged-xexpr? "foo")) ; not a list with symbol
-  (check-false (tagged-xexpr? '(p "foo" "bar" ((key "value"))))) ; malformed
-  (check-false (tagged-xexpr? '("p" "foo" "bar"))) ; no name
-  (check-false (tagged-xexpr? '(p 123)))) ; content is a number
-
-
-
 ;; helper for comparison of values
 ;; normal function won't work for this. Has to be syntax-rule
 (define-syntax-rule (values->list vs)
@@ -333,17 +203,6 @@
                 (list '(root "hello" "world" (em "goodnight" "moon"))
                       '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3")))))
 
-;; test for well-formed meta
-(define/contract (meta-xexpr? x)
-  (any/c . -> . boolean?)
-  (match x
-    [`(meta ,(? string? key) ,(? string? value)) #t]
-    [else #f]))
-
-(module+ test
-  (check-true (meta-xexpr? '(meta "key" "value")))
-  (check-false (meta-xexpr? '(meta "key" "value" "foo")))
-  (check-false (meta-xexpr? '(meta))))
 
 
 ;; convert list of meta tags to a hash for export from pollen document.