From e0908aa9ed4877e9322b7b2dcffc33eba68835a6 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 6 Feb 2014 06:47:46 -0800 Subject: [PATCH] simplification updates --- command.rkt | 4 +- file-tools.rkt | 12 ++--- lang/reader.rkt | 4 +- main-imports.rkt | 6 +-- main.rkt | 2 +- pollen-server-extras/poldash.css | 1 - predicates.rkt | 35 ++++++++------- ptree.rkt | 77 +++++++++++++++----------------- render.rkt | 15 ++++--- server-routes.rkt | 6 +-- server.rkt | 2 +- template.rkt | 4 +- world.rkt | 28 +++++------- 13 files changed, 92 insertions(+), 104 deletions(-) diff --git a/command.rkt b/command.rkt index 241f8a7..016efba 100644 --- a/command.rkt +++ b/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)) diff --git a/file-tools.rkt b/file-tools.rkt index cb7f992..c1b663e 100644 --- a/file-tools.rkt +++ b/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")) diff --git a/lang/reader.rkt b/lang/reader.rkt index 112143a..e763d5f 100644 --- a/lang/reader.rkt +++ b/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)) diff --git a/main-imports.rkt b/main-imports.rkt index a1f9ef4..582f81d 100644 --- a/main-imports.rkt +++ b/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)) \ No newline at end of file + pollen/ptree)) \ No newline at end of file diff --git a/main.rkt b/main.rkt index 69ea131..56d74de 100644 --- a/main.rkt +++ b/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 diff --git a/pollen-server-extras/poldash.css b/pollen-server-extras/poldash.css index f37e68f..ba1b9d4 100644 --- a/pollen-server-extras/poldash.css +++ b/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%; } diff --git a/predicates.rkt b/predicates.rkt index 3d4ab17..31a9f5c 100644 --- a/predicates.rkt +++ b/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"))) diff --git a/ptree.rkt b/ptree.rkt index 6ab9e27..e3bb6da 100644 --- a/ptree.rkt +++ b/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)) diff --git a/render.rkt b/render.rkt index ab4ee2e..78be2b8 100644 --- a/render.rkt +++ b/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 diff --git a/server-routes.rkt b/server-routes.rkt index 6c8dc8f..4a12535 100644 --- a/server-routes.rkt +++ b/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 diff --git a/server.rkt b/server.rkt index b9b9e40..3dffd18 100755 --- a/server.rkt +++ b/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] diff --git a/template.rkt b/template.rkt index 428fab1..085806b 100644 --- a/template.rkt +++ b/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")) diff --git a/world.rkt b/world.rkt index 2e10938..9f7d467 100644 --- a/world.rkt +++ b/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"))