pull/9/head
Matthew Butterick 11 years ago
parent e296044888
commit 414518af4f

@ -24,6 +24,7 @@
(procedure? . -> . procedure?) (procedure? . -> . procedure?)
(λ(req . string-args) (λ(req . string-args)
(logger req) (logger req)
(message string-args)
(define path (apply build-path PROJECT_ROOT (flatten string-args))) (define path (apply build-path PROJECT_ROOT (flatten string-args)))
(response/xexpr (route-proc path)))) (response/xexpr (route-proc path))))
@ -81,7 +82,8 @@
(format-as-code (~v (file->xexpr path)))) (format-as-code (~v (file->xexpr path))))
(define (dashboard dir) (define (dashboard dashfile)
(define dir (apply build-path (drop-right (explode-path dashfile) 1)))
(define empty-cell (cons #f #f)) (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)
@ -113,9 +115,8 @@
(list (list
(if (has-ext? source POLLEN_DECODER_EXT) ; xexpr cell for pollen decoder files (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")
empty-cell) empty-cell))
(cons (format "force/~a" filename) filename)) ; force refresh cell (make-list 1 empty-cell))))))
(make-list 2 empty-cell))))))
(define (unique-sorted-output-paths xs) (define (unique-sorted-output-paths xs)
(sort (set->list (list->set (map ->output-path xs))) #:key ->string string<?)) (sort (set->list (list->set (map ->output-path xs))) #:key ->string string<?))

@ -5,13 +5,11 @@
"debug.rkt" "debug.rkt"
"world.rkt") "world.rkt")
(define-values (pollen-servlet url) (define-values (pollen-servlet _)
(dispatch-rules (dispatch-rules
;; todo: figure out how to use world:DASHBOARD_NAME here [((string-arg) ... (? (λ(x) (equal? DASHBOARD_NAME x)))) route-dashboard]
[((string-arg) ... "poldash.html") route-dashboard]
[((string-arg) ... "raw" (string-arg)) route-raw] [((string-arg) ... "raw" (string-arg)) route-raw]
[((string-arg) ... "xexpr" (string-arg)) route-xexpr] [((string-arg) ... "xexpr" (string-arg)) route-xexpr]
;; [((string-arg) ... "force" (string-arg)) (route-wrapper route-force)]
[else route-default])) [else route-default]))
(message (format "Welcome to Pollen ~a" POLLEN_VERSION) (format "(Racket ~a)" (version))) (message (format "Welcome to Pollen ~a" POLLEN_VERSION) (format "(Racket ~a)" (version)))
@ -19,7 +17,7 @@
(define server-name (format "http://localhost:~a" SERVER_PORT)) (define server-name (format "http://localhost:~a" SERVER_PORT))
(message (format "Project server is ~a" server-name) "(Ctrl-C to exit)") (message (format "Project server is ~a" server-name) "(Ctrl-C to exit)")
(message (format "Project dashboard is ~a/pollen.html" server-name)) (message (format "Project dashboard is ~a/~a" server-name DASHBOARD_NAME))
(message "Ready to rock") (message "Ready to rock")

Loading…
Cancel
Save