simplification updates

command.rkt

@@ -8,7 +8,7 @@
   (datum->syntax syntax-context
                  (let* ([args (current-command-line-arguments)]
                         [arg (if (> (len args) 0) (get args 0) "")])
-                   (display (format "~a: " POLLEN_COMMAND_FILE))
+                   (display (format "~a: " COMMAND_FILE))
                    (case arg
                      [("help") (displayln "valid commands are
 polcom start (starts project server)
@@ -20,7 +20,7 @@ polcom [filename] (renders individual file)")]
                                         ;; todo: take extensions off the comand line
                                         (displayln "Render preproc & ptree files ...")
                                         (require "render.rkt" "file-tools.rkt" "world.rkt")
-                                        (apply render-with-session (append-map project-files-with-ext (list POLLEN_PREPROC_EXT POLLEN_TREE_EXT))))]
+                                        (apply render-with-session (append-map project-files-with-ext (list PREPROC_SOURCE_EXT PTREE_SOURCE_EXT))))]
                      [("clone") (let ([target-path 
                                        (if (> (len args) 1)
                                            (->path (get args 1))

file-tools.rkt

@@ -186,7 +186,7 @@
 
 (define/contract (preproc-source? x)
   (any/c . -> . boolean?)
-  (has-ext? (->path x) POLLEN_PREPROC_EXT))
+  (has-ext? (->path x) PREPROC_SOURCE_EXT))
 
 (module+ test
   (check-true (preproc-source? "foo.p"))
@@ -213,7 +213,7 @@
 
 (define/contract (ptree-source? x)
   (any/c . -> . boolean?)
-  (has-ext? x POLLEN_TREE_EXT))
+  (has-ext? x PTREE_SOURCE_EXT))
 
 (module+ test
   (check-true (ptree-source? "foo.ptree"))
@@ -222,7 +222,7 @@
 
 (define/contract (pollen-source? x)
   (any/c . -> . boolean?)
-  (has-ext? x POLLEN_DECODER_EXT))
+  (has-ext? x DECODER_SOURCE_EXT))
 
 (module+ test
   (check-true (pollen-source? "foo.pd"))
@@ -232,7 +232,7 @@
 (define/contract (template-source? x)
   (any/c . -> . boolean?)
   (define-values (dir name ignore) (split-path x))
-  (equal? (get (->string name) 0) TEMPLATE_FILE_PREFIX))
+  (equal? (get (->string name) 0) TEMPLATE_SOURCE_PREFIX))
 
 (module+ test
   (check-true (template-source? "-foo.html"))
@@ -258,7 +258,7 @@
   (pathish? . -> . path?)
   (->path (if (preproc-source? x)
               x
-              (add-ext x POLLEN_PREPROC_EXT))))
+              (add-ext x PREPROC_SOURCE_EXT))))
 
 (module+ test
   (check-equal? (->preproc-source-path (->path "foo.p")) (->path "foo.p"))
@@ -289,7 +289,7 @@
   (pathish? . -> . path?)
   (->path (if (pollen-source? x)
               x
-              (add-ext x POLLEN_DECODER_EXT))))
+              (add-ext x DECODER_SOURCE_EXT))))
 
 (module+ test
   (check-equal? (->pollen-source-path (->path "foo.pd")) (->path "foo.pd"))

lang/reader.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
 (require (only-in scribble/reader make-at-reader)
-         (only-in "../world.rkt" POLLEN_EXPRESSION_DELIMITER)
+         (only-in "../world.rkt" EXPRESSION_DELIMITER)
          (only-in "../file-tools.rkt" preproc-source?))
 
 (provide (rename-out [mb-read read]
@@ -9,7 +9,7 @@
          )
 
 (define read-inner
-  (make-at-reader #:command-char POLLEN_EXPRESSION_DELIMITER
+  (make-at-reader #:command-char EXPRESSION_DELIMITER
                   #:syntax? #t
                   #:inside? #t))
 

main-imports.rkt

@@ -8,11 +8,9 @@
 (require racket/list
          pollen/tools 
          pollen/main-helper
-         (only-in pollen/ptree ptree-source-decode path->ptree-name)
-         (only-in pollen/predicates ptree?))
+         (only-in pollen/ptree ptree-source-decode path->pnode ptree?))
 
 (provide (all-from-out racket/list
                        pollen/tools 
                        pollen/main-helper
-                       pollen/ptree
-                       pollen/predicates))
+                       pollen/ptree))

main.rkt

@@ -49,7 +49,7 @@
    
    (require 'pollen-inner) ; provides doc & #%top, among other things
    
-   (define here (path->ptree-name inner-here-path))
+   (define here (path->pnode inner-here-path))
    
    ;; prepare the elements, and append inner-here-path as meta.
    ;; put it first so it can be overridden by custom meta later on

pollen-server-extras/poldash.css

@@ -15,7 +15,6 @@ div#pollen-logo {
     bottom: 0;
     width: 76;
     height: 76;
-    background-image: url("pollen.svg");
     background-size: 100%;
 }
 

predicates.rkt

@@ -134,16 +134,19 @@
   (check-equal? (hash-ref (count-incidence '(a b c d b c)) 'b) 2)
   (check-equal? (hash-ref (count-incidence '(a b c d b c)) 'a) 1))
 
-;; exploit uniqueness constraint of set data structure
-(define/contract (elements-unique? x #:loud [loud #f])
-  ((any/c) (#:loud boolean?) . ->* . boolean?)
-  (define result 
-    (cond 
-      [(list? x) (= (len (apply set x)) (len x))]
-      [(vector? x) (elements-unique? (->list x))]
-      [(string? x) (elements-unique? (string->list x))]
-      [else #t]))
-  (if (and (not result) loud)
+
+(define/contract (members-unique? x)
+  (any/c . -> . boolean?)
+  (cond 
+    [(list? x) (= (len (apply set x)) (len x))]
+    [(vector? x) (members-unique? (->list x))]
+    [(string? x) (members-unique? (string->list x))]
+    [else #t]))
+
+(define/contract (members-unique?/error x)
+  (any/c . -> . boolean?)
+  (define result (members-unique? x))
+  (if (not result)
       (let* ([duplicate-keys (filter-not empty? (hash-map (count-incidence x) 
                                                           (λ(k v) (if (> v 1) k '()))))])
         (error (string-append (if (= (len duplicate-keys) 1) 
@@ -152,12 +155,12 @@
       result))
 
 (module+ test
-  (check-true (elements-unique? '(1 2 3)))
-  (check-false (elements-unique? '(1 2 2)))
-  (check-true (elements-unique? (->vector '(1 2 3))))
-  (check-false (elements-unique? (->vector '(1 2 2))))
-  (check-true (elements-unique? "fob"))
-  (check-false (elements-unique? "foo")))
+  (check-true (members-unique? '(1 2 3)))
+  (check-false (members-unique? '(1 2 2)))
+  (check-true (members-unique? (->vector '(1 2 3))))
+  (check-false (members-unique? (->vector '(1 2 2))))
+  (check-true (members-unique? "fob"))
+  (check-false (members-unique? "foo")))
 
 
 

ptree.rkt

@@ -4,7 +4,7 @@
 
 (module+ test (require rackunit))
 
-(provide pnode? ptree? parent children previous next)
+(provide pnode? ptree? parent children previous next pnode->url ptree-source-decode path->pnode ptree->list file->ptree make-project-ptree current-ptree current-url-context)
 
 (define/contract (pnode? x)
   (any/c . -> . boolean?)
@@ -14,7 +14,6 @@
   (any/c . -> . boolean?)
   (or (pnode? x) (error "Not a valid pnode:" x)))
 
-
 (module+ test
   (check-true (pnode? "foo-bar"))
   (check-true (pnode? "Foo_Bar_0123"))
@@ -38,20 +37,20 @@
 
 (define/contract (file->ptree path)
   (pathish? . -> . ptree?)
-  (message "Loading ptree file" (file-name-from-path path))
-  (dynamic-require path POLLEN_ROOT))
+  (message "Loading ptree file" (->string (file-name-from-path path)))
+  (dynamic-require path MAIN_POLLEN_EXPORT))
 
 (define/contract (directory->ptree dir)
   (directory-pathish? . -> . ptree?)
-  (let ([files (map remove-ext (filter (λ(x) (has-ext? x POLLEN_DECODER_EXT)) (directory-list dir)))])
+  (let ([files (map remove-ext (filter (λ(x) (has-ext? x DECODER_SOURCE_EXT)) (directory-list dir)))])
     (message "Generating ptree from file listing of" dir)
-    (ptree-root->ptree (cons POLLEN_TREE_ROOT_NAME files))))
+    (ptree-root->ptree (cons PTREE_ROOT_NODE files))))
 
 
 ;; Try loading from ptree file, or failing that, synthesize ptree.
 (define/contract (make-project-ptree [project-dir PROJECT_ROOT])
   (() (directory-pathish?) . ->* . ptree?)
-  (define ptree-source (build-path project-dir DEFAULT_POLLEN_TREE))
+  (define ptree-source (build-path project-dir DEFAULT_PTREE))
   (if (file-exists? ptree-source)
       (file->ptree ptree-source)
       (directory->ptree project-dir)))
@@ -163,28 +162,30 @@
 
 
 
-(define/contract (pnode->url pnode [files (current-url-context)])
-  ((pnode?) ((listof pathish?)) . ->* . (or/c pnode? false?))
-  ;; upconvert all files to their output path
-  ;; then remove duplicates because some sources might have already been rendered
-  (define output-paths (remove-duplicates (map ->output-path files) equal?))
-  ;; find ones that match name
-  (define matching-paths (filter (λ(x) (equal? (->string x) (->string pnode))) output-paths))
-  
-  (cond
-    [((len matching-paths) . = . 1) (->string (car matching-paths))]
-    [((len matching-paths) . > . 1) (error "More than one matching URL for" pnode)]
-    [else #f] ))
-
-(define ptree-name->url pnode->url)
-
+;; this is a helper function to permit unit tests
+(define (pnode->url/paths pnode url-list)
+    ;; check for duplicates because some sources might have already been rendered
+    (define output-paths (remove-duplicates (map ->output-path url-list) equal?))
+    (define matching-paths (filter (λ(x) (equal? (->string x) (->string pnode))) output-paths))
+    
+    (cond
+      [((len matching-paths) . = . 1) (->string (car matching-paths))]
+      [((len matching-paths) . > . 1) (error "More than one matching URL for" pnode)]
+      [else #f]))
 
 (module+ test
   (define files '("foo.html" "bar.html" "bar.html.p" "zap.html" "zap.xml"))
-  (check-equal? (pnode->url 'foo.html files) "foo.html")
-  (check-equal? (pnode->url 'bar.html files) "bar.html")
+  (check-equal? (pnode->url/paths 'foo.html files) "foo.html")
+  (check-equal? (pnode->url/paths 'bar.html files) "bar.html")
   ;;  (check-equal? (name->url 'zap files) 'error) ;; todo: how to test error?
-  (check-false (pnode->url 'hee files)))
+  (check-false (pnode->url/paths 'hee files)))
+
+
+(define/contract (pnode->url pnode [url-context (current-url-context)])
+  ((pnode?) (pathish?) . ->* . (or/c pnode? false?))
+  (parameterize ([current-url-context url-context])
+    (pnode->url/paths pnode (directory-list (current-url-context)))))
+
 
 
 
@@ -196,32 +197,24 @@
 
 
 (module+ test
-  (set! test-ptree-main `(ptree-main "foo" "bar" (one (two "three"))))
+  (set! test-ptree-main `(,PTREE_ROOT_NODE "foo" "bar" (one (two "three"))))
   (check-equal? (ptree-root->ptree test-ptree-main) 
-                `(ptree-main "foo" "bar" (one (two "three")))))
+                `(,PTREE_ROOT_NODE "foo" "bar" (one (two "three")))))
 
 
-
-
-;; contract for ptree-source-decode
-(define/contract (valid-names? x)
+(define/contract (pnodes-unique?/error x)
   (any/c . -> . boolean?)
-  (andmap pnode?/error (filter-not whitespace? (flatten x))))
-
-;; contract for ptree-source-decode
-(define/contract (unique-names? x)
-  (any/c . -> . boolean?)
-  ;; use map ->string to make keys comparable
-  (elements-unique? #:loud #t (map ->string (filter-not whitespace? (flatten x)))))
-
+  (define members (filter-not whitespace? (flatten x)))
+  (and (andmap pnode?/error members)
+       (members-unique?/error (map ->string members))))
 
 (define/contract (ptree-source-decode . elements)
-  (() #:rest (and/c valid-names? unique-names?) . ->* . ptree?)
-  (ptree-root->ptree (decode (cons POLLEN_TREE_ROOT_NAME elements)
+  (() #:rest pnodes-unique?/error . ->* . ptree?)
+  (ptree-root->ptree (decode (cons PTREE_ROOT_NODE elements)
                              #:xexpr-elements-proc (λ(xs) (filter-not whitespace? xs)))))
 
 
-(define current-ptree (make-parameter `(,POLLEN_TREE_ROOT_NAME)))
+(define current-ptree (make-parameter `(,PTREE_ROOT_NODE)))
 (define current-url-context (make-parameter PROJECT_ROOT))
 
 

render.rkt

@@ -118,7 +118,7 @@
         ;; this will catch ptree files
         [(ptree-source? path) (let ([ptree (dynamic-require path 'main)])
                                 (render-files-in-ptree ptree #:force force))]
-        [(equal? FALLBACK_TEMPLATE_NAME (->string (file-name-from-path path)))
+        [(equal? FALLBACK_TEMPLATE (->string (file-name-from-path path)))
          (message "Render: using fallback template")]
         [(file-exists? path) (message "Serving static file" (->string (file-name-from-path path)))])))
   (for-each &render xs))
@@ -250,10 +250,11 @@
                      ;; "-main" + extension from output path (e.g. foo.xml.p -> -main.xml)
                      (build-path source-dir (add-ext DEFAULT_TEMPLATE_PREFIX (get-ext (->output-path source-path)))))))
      ;; if none of these work, make fallback template file
-     (let ([ft-path (build-path source-dir FALLBACK_TEMPLATE_NAME)])
+     (let ([ft-path (build-path source-dir FALLBACK_TEMPLATE)])
        (display-to-file fallback-template-data ft-path #:exists 'replace)
        ft-path)))
   
+  
   ;; render template (it might have its own preprocessor file)
   (render template-path #:force force)
   
@@ -279,8 +280,8 @@
       (up-to-date-message output-path))
   
   ;; delete fallback template if needed
-  (let ([tp (build-path source-dir FALLBACK_TEMPLATE_NAME)])
-    (when (file-exists? tp) (delete-file tp))))
+  (let ([ft-path (build-path source-dir FALLBACK_TEMPLATE)])
+    (when (file-exists? ft-path) (delete-file ft-path))))
 
 ;; cache some modules inside this namespace so they can be shared by namespace for eval
 ;; todo: macrofy this to avoid repeating names
@@ -353,9 +354,9 @@
       (require pollen/debug pollen/ptree pollen/template)
       ;; import source into eval space. This sets up main & metas
       (require ,(->string source-name))
-      (set-current-ptree (make-project-ptree ,PROJECT_ROOT))
-      (set-current-url-context ,PROJECT_ROOT)
-      (include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name)))))
+      (parameterize ([current-ptree (make-project-ptree ,PROJECT_ROOT)]
+                     [current-url-context ,PROJECT_ROOT])
+        (include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name))))))
 
 
 ;; render files listed in a ptree file

server-routes.rkt

@@ -174,12 +174,12 @@
                          
                          (cond ; in cell
                            [source  (cons (format "in/~a" source) "in")]
-                           [(or (has-ext? filename POLLEN_TREE_EXT) (sourceish? filename))  (cons (format "in/~a" filename) "in")]
+                           [(or (has-ext? filename PTREE_SOURCE_EXT) (sourceish? filename))  (cons (format "in/~a" filename) "in")]
                            [else empty-cell])
                          
                          (cond ; out cell 
                            [(directory-exists? (build-path dir filename)) (cons #f #f)]
-                           [(has-ext? filename POLLEN_TREE_EXT) empty-cell]
+                           [(has-ext? filename PTREE_SOURCE_EXT) empty-cell]
                            [else (cons (format "out/~a" filename) "out")]))))))
   
   (define (ineligible-path? x) (or (not (visible? x)) (member x RESERVED_PATHS)))  
@@ -196,7 +196,7 @@
     (append (sort-names subdirectories) (sort-names files)))
   
   (define project-paths (filter-not ineligible-path? (if (file-exists? dashfile)
-                                                         (map ->path (all-names (ptree-source->ptree dashfile)))
+                                                         (map ->path (ptree->list (file->ptree dashfile)))
                                                          (unique-sorted-output-paths (directory-list dir)))))
   
   (body-wrapper

server.rkt

@@ -8,7 +8,7 @@
 
 (define-values (pollen-servlet _)
   (dispatch-rules
-   [((string-arg) ... (? (λ(x) (x . has-ext? . POLLEN_TREE_EXT)))) route-dashboard]
+   [((string-arg) ... (? (λ(x) (x . has-ext? . PTREE_SOURCE_EXT)))) route-dashboard]
    [((string-arg) ... "in" (string-arg)) route-in]
    [((string-arg) ... "out" (string-arg)) route-out]
    [((string-arg) ... "xexpr" (string-arg)) route-xexpr]

template.rkt

@@ -17,7 +17,7 @@
   (any/c . -> . boolean?)
   (or (tagged-xexpr? x) 
       (has-pollen-source? x) 
-      (has-pollen-source? (name->url x))))
+      (has-pollen-source? (pnode->url x))))
 
 (define/contract (query-key? x)
   (any/c . -> . boolean?)
@@ -29,7 +29,7 @@
     ;; Using put has no effect on tagged-xexprs. It's here to make the idiom smooth.
     [(tagged-xexpr? x) x] 
     [(has-pollen-source? x) (dynamic-require (->pollen-source-path x) 'main)]
-    [(has-pollen-source? (name->url x)) (dynamic-require (->pollen-source-path (name->url x)) 'main)]))
+    [(has-pollen-source? (pnode->url x)) (dynamic-require (->pollen-source-path (pnode->url x)) 'main)]))
 
 (module+ test
   (check-equal? (put '(foo "bar")) '(foo "bar"))

world.rkt

@@ -4,26 +4,22 @@
 
 (define POLLEN_VERSION "0.001")
 
-(define POLLEN_PREPROC_EXT 'p)
-(define POLLEN_DECODER_EXT 'pd)
-(define POLLEN_TREE_EXT 'ptree)
+(define PREPROC_SOURCE_EXT 'p)
+(define DECODER_SOURCE_EXT 'pd)
+(define PTREE_SOURCE_EXT 'ptree)
 
-(define DEFAULT_POLLEN_TREE "main.ptree")
-(define POLLEN_TREE_PARENT_NAME 'parent)
-(define POLLEN_TREE_ROOT_NAME 'ptree-root)
+(define DEFAULT_PTREE "main.ptree")
+(define PTREE_ROOT_NODE 'ptree-root)
 
-(define TEMPLATE_FILE_PREFIX "-")
-(define POLLEN_EXPRESSION_DELIMITER #\◊)
-(define TEMPLATE_FIELD_DELIMITER POLLEN_EXPRESSION_DELIMITER)
+(define TEMPLATE_SOURCE_PREFIX "-")
+(define EXPRESSION_DELIMITER #\◊)
+(define TEMPLATE_FIELD_DELIMITER EXPRESSION_DELIMITER)
 
 (define DEFAULT_TEMPLATE_PREFIX "-main")
-(define FALLBACK_TEMPLATE_NAME "-temp-fallback-template.html")
+(define FALLBACK_TEMPLATE "-temp-fallback-template.html")
 (define TEMPLATE_META_KEY "template")
 
-
 (define MAIN_POLLEN_EXPORT 'main)
-;(define META_POLLEN_TAG 'metas)
-;(define META_POLLEN_EXPORT 'metas)
 
 (define EXTRAS_DIR (string->path "pollen-require"))
 
@@ -40,17 +36,15 @@
 ;;(define RACKET_PATH (string-trim (with-output-to-string (λ() (system "which racket")))))
 (define RACKET_PATH "/usr/bin/racket") ;; todo: this won't always work
 
-(define POLLEN_ROOT 'main)
-(define POLLEN_COMMAND_FILE "polcom")
+(define COMMAND_FILE "polcom")
 
 (require "readability.rkt")
 (define RESERVED_PATHS
-  (map ->path (list POLLEN_COMMAND_FILE EXTRAS_DIR "poldash.css" "compiled")))
+  (map ->path (list COMMAND_FILE EXTRAS_DIR "poldash.css" "compiled")))
 
 
 (define PROJECT_ROOT (current-directory))
 (define (reset-project-root) (set! PROJECT_ROOT (current-directory)))
-;; use current-contract-region to calculate containing directory of module
 (define MODULE_ROOT (apply build-path (drop-right (explode-path (current-contract-region)) 1)))
 (define SERVER_EXTRAS_DIR (build-path MODULE_ROOT "pollen-server-extras"))