From d6fb3c1673cb5251bc0d68f1a5276ae966d6e1ff Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 16 Jan 2014 18:28:34 -0800 Subject: [PATCH] updates --- file-tools.rkt | 22 ++++++++++++++++++--- foobar/poldash.css | 48 ++++++++++++++++++++++++++++++++++++++++++++++ ptree.rkt | 2 +- server-routes.rkt | 43 ++++++++++++++++++++++++++--------------- server.rkt | 1 - world.rkt | 12 ++---------- 6 files changed, 98 insertions(+), 30 deletions(-) create mode 100644 foobar/poldash.css diff --git a/file-tools.rkt b/file-tools.rkt index e192d59..adf5867 100644 --- a/file-tools.rkt +++ b/file-tools.rkt @@ -62,7 +62,22 @@ (define/contract (has-ext? x ext) (pathish? stringish? . -> . boolean?) (define ext-of-path (filename-extension (->path x))) - (and ext-of-path (equal? (bytes->string/utf-8 ext-of-path) (->string ext)))) + (and ext-of-path (equal? (string-downcase (bytes->string/utf-8 ext-of-path)) (string-downcase (->string ext))))) + + +;; todo: add extensions +(define binary-extensions + '(gif jpg jpeg mp3 png zip)) + +(define/contract (has-binary-ext? x) + (pathish? . -> . boolean?) + (define path-x (->path x)) + (ormap (λ(ext) (has-ext? path-x ext)) binary-extensions)) + +(module+ test + (check-true (has-binary-ext? "foo.MP3")) + (check-false (has-binary-ext? "foo.py"))) + (module+ test (define foo-path-strings '("foo" "foo.txt" "foo.bar" "foo.bar.txt")) @@ -76,6 +91,7 @@ (module+ test (check-false (has-ext? foo-path 'txt)) (check-true (foo.txt-path . has-ext? . 'txt)) + (check-true ((->path "foo.TXT") . has-ext? . 'txt)) (check-true (has-ext? foo.bar.txt-path 'txt)) (check-false (foo.bar.txt-path . has-ext? . 'doc))) ; wrong extension @@ -175,7 +191,7 @@ (define/contract (pollen-source? x) (any/c . -> . boolean?) - (has-ext? x POLLEN_SOURCE_EXT)) + (has-ext? x POLLEN_DECODER_EXT)) (module+ test (check-true (pollen-source? "foo.pd")) @@ -242,7 +258,7 @@ (pathish? . -> . path?) (->path (if (pollen-source? x) x - (add-ext x POLLEN_SOURCE_EXT)))) + (add-ext x POLLEN_DECODER_EXT)))) (module+ test (check-equal? (->pollen-source-path (->path "foo.pd")) (->path "foo.pd")) diff --git a/foobar/poldash.css b/foobar/poldash.css new file mode 100644 index 0000000..21fb7dc --- /dev/null +++ b/foobar/poldash.css @@ -0,0 +1,48 @@ +* { + margin: 0; + padding: 0; +} + +body { + padding: 1em; + font-family: "Triplicate T3"; +} + +table { + border-collapse:collapse; + width: 100%; +} + +table:before { + content: "Pollen dashboard"; +} + + +tr > td:first-child + td { + font-family: "Triplicate T4"; + background: #f6f6f6; +} + +tr, tr + tr { + border-top: 1px solid #ccc; +} + +td { + font-size: 20px; + width: 20%; +} + +a:hover { + background: #eee; +} + +a { + text-decoration: none; + color: #6a6; + display: block; + padding: 1em; +} + +a:active { + text-decoration: underline; +} \ No newline at end of file diff --git a/ptree.rkt b/ptree.rkt index e940847..28dbc78 100644 --- a/ptree.rkt +++ b/ptree.rkt @@ -17,7 +17,7 @@ ;; Fallback in case ptree file isn't available. (define/contract (directory->ptree dir) (directory-pathish? . -> . ptree?) - (let ([files (map remove-ext (filter (λ(x) (has-ext? x POLLEN_SOURCE_EXT)) (directory-list dir)))]) + (let ([files (map remove-ext (filter (λ(x) (has-ext? x POLLEN_DECODER_EXT)) (directory-list dir)))]) (message "Generating ptree from file listing") (ptree-root->ptree (cons POLLEN_TREE_ROOT_NAME (map path->name files))))) diff --git a/server-routes.rkt b/server-routes.rkt index 17492e0..3ea7f88 100644 --- a/server-routes.rkt +++ b/server-routes.rkt @@ -65,13 +65,15 @@ (format-as-code (~v (file->xexpr path)))) -(define empty-cell (cons #f #f)) + (define (route-dashboard dir) + (define empty-cell (cons #f #f)) (define (make-link-cell href+text) (match-define (cons href text) href+text) - (filter-not void? `(td ,(when (and href text) - `(a ((href ,href)) ,text))))) - + (filter-not void? `(td ,(when text + (if href + `(a ((href ,href)) ,text) + text))))) (define (make-path-row fn) (define filename (->string fn)) (define (file-in-dir? fn) (file-exists? (build-path dir fn))) @@ -80,22 +82,24 @@ `(tr ,@(map make-link-cell (append (list ;; folder traversal cell - (if (directory-exists? (build-path dir filename)) ; link subdirs to dashboard + (if (directory-exists? (build-path dir filename)) ; links subdir to its dashboard (cons (format "~a/~a" filename DASHBOARD_NAME) "dash") empty-cell) (cons filename filename) ; main cell - (if source - (cons source (format "~a input" (get-ext source))) + (if source ; source cell (if needed) + (cons source (format "~a source" (get-ext source))) empty-cell) - (cond - [(directory-exists? (build-path dir filename)) "(folder)"] - ;; [(directory-exists? (build-path dir filename)) "(binary)"] - [else (cons (format "raw/~a" filename) "output")])) + (cond ; raw cell (if needed) + [(directory-exists? (build-path dir filename)) (cons #f "(folder)")] + [(has-binary-ext? filename) (cons #f "(binary)")] + [else (cons (format "raw/~a" filename) "output")])) (if source (list - (cons (format "xexpr/~a" source) "xexpr") - (cons (format "~a?force=true" filename) filename)) + (if (has-ext? source POLLEN_DECODER_EXT) ; xexpr cell for pollen decoder files + (cons (format "xexpr/~a" source) "xexpr") + empty-cell) + (cons (format "force/~a" filename) filename)) ; force refresh cell (make-list 2 empty-cell)))))) (define (unique-sorted-output-paths xs) @@ -105,7 +109,12 @@ (define project-paths (filter-not ineligible-path? (directory-list dir))) - `(table ,@(map make-path-row (unique-sorted-output-paths project-paths)))) + ;; todo: add link to parent directory + `(html + (head (link ((rel "stylesheet") (type "text/css") (href "/poldash.css")))) + (body + (table + ,@(map make-path-row (unique-sorted-output-paths project-paths)))))) (define (get-query-value url key) @@ -121,4 +130,8 @@ (define path (reroot-path (url->path request-url) PROJECT_ROOT)) (define force (equal? (get-query-value request-url 'force) "true")) (with-handlers ([exn:fail? (λ(e) (message "Render is skipping" (url->string request-url) "because of error\n" (exn-message e)))]) - (render path #:force force))) \ No newline at end of file + (render path #:force force))) + + +(module+ main + (route-dashboard "foobar")) \ No newline at end of file diff --git a/server.rkt b/server.rkt index 4d6d69c..df7d3f1 100755 --- a/server.rkt +++ b/server.rkt @@ -39,7 +39,6 @@ [((string-arg) ... "raw" (string-arg)) (λ(req . string-args) (logger req) (define path (apply build-path PROJECT_ROOT (flatten string-args))) - (response/xexpr (route-raw path)))] [("xexpr" (string-arg)) (route-wrapper route-xexpr)] [("html" (string-arg)) (route-wrapper route-html)] diff --git a/world.rkt b/world.rkt index f33ba46..b77741b 100644 --- a/world.rkt +++ b/world.rkt @@ -5,7 +5,7 @@ (define POLLEN_VERSION "0.001") (define POLLEN_PREPROC_EXT 'p) -(define POLLEN_SOURCE_EXT 'pd) +(define POLLEN_DECODER_EXT 'pd) (define TEMPLATE_FILE_PREFIX "-") (define POLLEN_EXPRESSION_DELIMITER #\◊) (define TEMPLATE_FIELD_DELIMITER POLLEN_EXPRESSION_DELIMITER) @@ -41,18 +41,10 @@ (define POLLEN_ROOT 'main) (define POLLEN_COMMAND_FILE "polcom") -; get the starting directory, which is the parent of 'run-file -(define POLLEN_PROJECT_DIR - (let-values ([(dir ignored also-ignored) - (split-path (find-system-path 'run-file))]) - (if (equal? dir 'relative) - (string->path ".") - dir))) - (require "readability.rkt") (define RESERVED_PATHS - (map ->path (list POLLEN_COMMAND_FILE EXTRAS_DIR))) + (map ->path (list POLLEN_COMMAND_FILE EXTRAS_DIR "poldash.css"))) (define PROJECT_ROOT (current-directory))