diff --git a/predicates.rkt b/predicates.rkt index 6bd8845..7fba50e 100644 --- a/predicates.rkt +++ b/predicates.rkt @@ -206,7 +206,7 @@ (or (eq? x #f) ; OK for map-key to be #f (and (or (symbol? x) (string? x)) ;; todo: should test be same as valid module ptree-name? - (->boolean (regexp-match #px"^[-_A-Za-z0-9]+$" (->string x)))))) + (->boolean (regexp-match #px"^[-_A-Za-z0-9.]+$" (->string x)))))) (if (and (not result) loud) (error "Not a valid ptree key:" x) result)) @@ -216,7 +216,7 @@ (check-true (ptree-name? "foo-bar")) (check-true (ptree-name? "Foo_Bar_0123")) (check-true (ptree-name? 'foo-bar)) - (check-false (ptree-name? "foo-bar.p")) + (check-true (ptree-name? "foo-bar.p")) (check-false (ptree-name? "/Users/MB/foo-bar")) (check-false (ptree-name? "")) (check-false (ptree-name? " "))) diff --git a/server-routes.rkt b/server-routes.rkt index 8dcdc38..6c8dc8f 100644 --- a/server-routes.rkt +++ b/server-routes.rkt @@ -5,7 +5,7 @@ (require web-server/http/request-structs) (require web-server/http/response-structs) (require 2htdp/image) -(require "world.rkt" "render.rkt" "readability.rkt" "predicates.rkt" "debug.rkt") +(require "world.rkt" "render.rkt" "readability.rkt" "predicates.rkt" "debug.rkt" "ptree.rkt") (module+ test (require rackunit)) @@ -173,9 +173,8 @@ [else (cons filename filename)]) (cond ; in cell - [(has-ext? filename POLLEN_TREE_EXT) (cons (format "in/~a" filename) "ptree")] [source (cons (format "in/~a" source) "in")] - [(sourceish? filename) (cons (format "in/~a" filename) "in")] + [(or (has-ext? filename POLLEN_TREE_EXT) (sourceish? filename)) (cons (format "in/~a" filename) "in")] [else empty-cell]) (cond ; out cell @@ -184,7 +183,6 @@ [else (cons (format "out/~a" filename) "out")])))))) (define (ineligible-path? x) (or (not (visible? x)) (member x RESERVED_PATHS))) - (define project-paths (filter-not ineligible-path? (directory-list dir))) (define (unique-sorted-output-paths xs) (define output-paths (map ->output-path xs)) @@ -197,10 +195,14 @@ ;; put subdirs in list ahead of files (so they appear at the top) (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))) + (unique-sorted-output-paths (directory-list dir))))) + (body-wrapper `(table ,@(cons (make-parent-row) - (map make-path-row (unique-sorted-output-paths project-paths)))))) + (map make-path-row project-paths))))) (define route-dashboard (route-wrapper dashboard)) diff --git a/server.rkt b/server.rkt index c272eb6..b9b9e40 100755 --- a/server.rkt +++ b/server.rkt @@ -3,11 +3,12 @@ web-server/dispatch) (require "server-routes.rkt" "debug.rkt" - "world.rkt") + "world.rkt" + "file-tools.rkt") (define-values (pollen-servlet _) (dispatch-rules - [((string-arg) ... (? (λ(x) (equal? DASHBOARD_NAME x)))) route-dashboard] + [((string-arg) ... (? (λ(x) (x . has-ext? . POLLEN_TREE_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/world.rkt b/world.rkt index b962e51..2e10938 100644 --- a/world.rkt +++ b/world.rkt @@ -56,5 +56,5 @@ (define SERVER_PORT 8088) -(define DASHBOARD_NAME "poldash.html") +(define DASHBOARD_NAME "index.ptree") (define DASHBOARD_CSS "poldash.css") \ No newline at end of file