pull/9/head
Matthew Butterick 11 years ago
parent 4650b485d6
commit d6fb3c1673

@ -62,7 +62,22 @@
(define/contract (has-ext? x ext) (define/contract (has-ext? x ext)
(pathish? stringish? . -> . boolean?) (pathish? stringish? . -> . boolean?)
(define ext-of-path (filename-extension (->path x))) (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 (module+ test
(define foo-path-strings '("foo" "foo.txt" "foo.bar" "foo.bar.txt")) (define foo-path-strings '("foo" "foo.txt" "foo.bar" "foo.bar.txt"))
@ -76,6 +91,7 @@
(module+ test (module+ test
(check-false (has-ext? foo-path 'txt)) (check-false (has-ext? foo-path 'txt))
(check-true (foo.txt-path . has-ext? . '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-true (has-ext? foo.bar.txt-path 'txt))
(check-false (foo.bar.txt-path . has-ext? . 'doc))) ; wrong extension (check-false (foo.bar.txt-path . has-ext? . 'doc))) ; wrong extension
@ -175,7 +191,7 @@
(define/contract (pollen-source? x) (define/contract (pollen-source? x)
(any/c . -> . boolean?) (any/c . -> . boolean?)
(has-ext? x POLLEN_SOURCE_EXT)) (has-ext? x POLLEN_DECODER_EXT))
(module+ test (module+ test
(check-true (pollen-source? "foo.pd")) (check-true (pollen-source? "foo.pd"))
@ -242,7 +258,7 @@
(pathish? . -> . path?) (pathish? . -> . path?)
(->path (if (pollen-source? x) (->path (if (pollen-source? x)
x x
(add-ext x POLLEN_SOURCE_EXT)))) (add-ext x POLLEN_DECODER_EXT))))
(module+ test (module+ test
(check-equal? (->pollen-source-path (->path "foo.pd")) (->path "foo.pd")) (check-equal? (->pollen-source-path (->path "foo.pd")) (->path "foo.pd"))

@ -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;
}

@ -17,7 +17,7 @@
;; Fallback in case ptree file isn't available. ;; Fallback in case ptree file isn't available.
(define/contract (directory->ptree dir) (define/contract (directory->ptree dir)
(directory-pathish? . -> . ptree?) (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") (message "Generating ptree from file listing")
(ptree-root->ptree (cons POLLEN_TREE_ROOT_NAME (map path->name files))))) (ptree-root->ptree (cons POLLEN_TREE_ROOT_NAME (map path->name files)))))

@ -65,13 +65,15 @@
(format-as-code (~v (file->xexpr path)))) (format-as-code (~v (file->xexpr path))))
(define empty-cell (cons #f #f))
(define (route-dashboard dir) (define (route-dashboard dir)
(define empty-cell (cons #f #f))
(define (make-link-cell href+text) (define (make-link-cell href+text)
(match-define (cons href text) href+text) (match-define (cons href text) href+text)
(filter-not void? `(td ,(when (and href text) (filter-not void? `(td ,(when text
`(a ((href ,href)) ,text))))) (if href
`(a ((href ,href)) ,text)
text)))))
(define (make-path-row fn) (define (make-path-row fn)
(define filename (->string fn)) (define filename (->string fn))
(define (file-in-dir? fn) (file-exists? (build-path dir fn))) (define (file-in-dir? fn) (file-exists? (build-path dir fn)))
@ -80,22 +82,24 @@
`(tr ,@(map make-link-cell `(tr ,@(map make-link-cell
(append (list (append (list
;; folder traversal cell ;; 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") (cons (format "~a/~a" filename DASHBOARD_NAME) "dash")
empty-cell) empty-cell)
(cons filename filename) ; main cell (cons filename filename) ; main cell
(if source (if source ; source cell (if needed)
(cons source (format "~a input" (get-ext source))) (cons source (format "~a source" (get-ext source)))
empty-cell) empty-cell)
(cond (cond ; raw cell (if needed)
[(directory-exists? (build-path dir filename)) "(folder)"] [(directory-exists? (build-path dir filename)) (cons #f "(folder)")]
;; [(directory-exists? (build-path dir filename)) "(binary)"] [(has-binary-ext? filename) (cons #f "(binary)")]
[else (cons (format "raw/~a" filename) "output")])) [else (cons (format "raw/~a" filename) "output")]))
(if source (if source
(list (list
(if (has-ext? source POLLEN_DECODER_EXT) ; xexpr cell for pollen decoder files
(cons (format "xexpr/~a" source) "xexpr") (cons (format "xexpr/~a" source) "xexpr")
(cons (format "~a?force=true" filename) filename)) empty-cell)
(cons (format "force/~a" filename) filename)) ; force refresh cell
(make-list 2 empty-cell)))))) (make-list 2 empty-cell))))))
(define (unique-sorted-output-paths xs) (define (unique-sorted-output-paths xs)
@ -105,7 +109,12 @@
(define project-paths (filter-not ineligible-path? (directory-list dir))) (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) (define (get-query-value url key)
@ -122,3 +131,7 @@
(define force (equal? (get-query-value request-url 'force) "true")) (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)))]) (with-handlers ([exn:fail? (λ(e) (message "Render is skipping" (url->string request-url) "because of error\n" (exn-message e)))])
(render path #:force force))) (render path #:force force)))
(module+ main
(route-dashboard "foobar"))

@ -39,7 +39,6 @@
[((string-arg) ... "raw" (string-arg)) (λ(req . string-args) [((string-arg) ... "raw" (string-arg)) (λ(req . string-args)
(logger req) (logger req)
(define path (apply build-path PROJECT_ROOT (flatten string-args))) (define path (apply build-path PROJECT_ROOT (flatten string-args)))
(response/xexpr (route-raw path)))] (response/xexpr (route-raw path)))]
[("xexpr" (string-arg)) (route-wrapper route-xexpr)] [("xexpr" (string-arg)) (route-wrapper route-xexpr)]
[("html" (string-arg)) (route-wrapper route-html)] [("html" (string-arg)) (route-wrapper route-html)]

@ -5,7 +5,7 @@
(define POLLEN_VERSION "0.001") (define POLLEN_VERSION "0.001")
(define POLLEN_PREPROC_EXT 'p) (define POLLEN_PREPROC_EXT 'p)
(define POLLEN_SOURCE_EXT 'pd) (define POLLEN_DECODER_EXT 'pd)
(define TEMPLATE_FILE_PREFIX "-") (define TEMPLATE_FILE_PREFIX "-")
(define POLLEN_EXPRESSION_DELIMITER #\◊) (define POLLEN_EXPRESSION_DELIMITER #\◊)
(define TEMPLATE_FIELD_DELIMITER POLLEN_EXPRESSION_DELIMITER) (define TEMPLATE_FIELD_DELIMITER POLLEN_EXPRESSION_DELIMITER)
@ -41,18 +41,10 @@
(define POLLEN_ROOT 'main) (define POLLEN_ROOT 'main)
(define POLLEN_COMMAND_FILE "polcom") (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") (require "readability.rkt")
(define RESERVED_PATHS (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)) (define PROJECT_ROOT (current-directory))

Loading…
Cancel
Save