updates

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"))

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

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)))))
 

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)))
+    (render path #:force force)))
+
+
+(module+ main
+  (route-dashboard "foobar"))

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)]

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))