working on server + server routes

pull/9/head
Matthew Butterick 11 years ago
parent 5ed2269bea
commit 5c7777ab6a

@ -90,10 +90,16 @@
(check-equal? (filename-of (build-path (current-directory) "pollen-file-tools.rkt")) (->path "pollen-file-tools.rkt")))|# (check-equal? (filename-of (build-path (current-directory) "pollen-file-tools.rkt")) (->path "pollen-file-tools.rkt")))|#
;; todo: tests for these predicates
(define/contract (preproc-source? x) (define/contract (preproc-source? x)
(any/c . -> . boolean?) (any/c . -> . boolean?)
(has-ext? (->path x) POLLEN_PREPROC_EXT)) (has-ext? (->path x) POLLEN_PREPROC_EXT))
(module+ test
(check-true (preproc-source? "foo.pp"))
(check-false (preproc-source? "foo.bar")))
(define/contract (has-preproc-source? x) (define/contract (has-preproc-source? x)
(any/c . -> . boolean?) (any/c . -> . boolean?)
(file-exists? (make-preproc-source-path (->path x)))) (file-exists? (make-preproc-source-path (->path x))))
@ -117,10 +123,31 @@
(any/c . -> . boolean?) (any/c . -> . boolean?)
(has-ext? (->path x) POLLEN_MAP_EXT)) (has-ext? (->path x) POLLEN_MAP_EXT))
(module+ test
(check-true (pmap-source? "foo.pmap"))
(check-false (pmap-source? "pmap.bar")))
(define/contract (pollen-source? x) (define/contract (pollen-source? x)
(any/c . -> . boolean?) (any/c . -> . boolean?)
(has-ext? (->path x) POLLEN_SOURCE_EXT)) (has-ext? (->path x) POLLEN_SOURCE_EXT))
(module+ test
(check-true (pollen-source? "foo.p"))
(check-false (pollen-source? "foo.pp")))
(define/contract (template-source? x)
(any/c . -> . boolean?)
(define-values (dir name ignore) (split-path x))
(equal? (get (->string name) 0) TEMPLATE_FILE_PREFIX))
(module+ test
(check-true (template-source? "-foo.html"))
(check-false (template-source? "foo.html")))
;; this is for regenerate module. ;; this is for regenerate module.
;; when we want to be friendly with inputs for functions that require a path. ;; when we want to be friendly with inputs for functions that require a path.
;; Strings & symbols often result from xexpr parsing ;; Strings & symbols often result from xexpr parsing

@ -1,5 +1,5 @@
#lang racket/base #lang racket/base
(require racket/list racket/contract racket/rerequire racket/file racket/format) (require racket/list racket/contract racket/rerequire racket/file racket/format xml)
(require (only-in net/url url-query url->path)) (require (only-in net/url url-query url->path))
(require (only-in web-server/http/request-structs request-uri)) (require (only-in web-server/http/request-structs request-uri))
(require "world.rkt" "regenerate.rkt" "readability.rkt" "predicates.rkt") (require "world.rkt" "regenerate.rkt" "readability.rkt" "predicates.rkt")
@ -12,61 +12,98 @@
(provide (all-defined-out)) (provide (all-defined-out))
;; extract main xexpr from a path
(define/contract (file->xexpr path) (define/contract (file->xexpr path #:regen [regen #t])
(complete-path? . -> . tagged-xexpr?) ((complete-path?) (#:regen boolean?) . ->* . tagged-xexpr?)
(regenerate path) (when regen (regenerate path)) ; refresh path
(dynamic-rerequire path) (dynamic-rerequire path) ; stores module mod date; reloads if it's changed
(dynamic-require path 'main)) (dynamic-require path 'main))
(module+ test
(check-equal? (file->xexpr (build-path (current-directory) "tests/server-routes/foo.p") #:regen #f) '(root "\n" "foo")))
(define/contract (slurp path #:regenerate? [regenerate? #t]) ;; read contents of file to string
(complete-path? . -> . string?) ;; just file->string with a regenerate option
(when regenerate? (regenerate path)) (define/contract (slurp path #:regen [regen #t])
((complete-path?) (#:regen boolean?) . ->* . string?)
(when regen (regenerate path))
(file->string path)) (file->string path))
(define/contract (format-as-code tx) (module+ test
(tagged-xexpr? . -> . tagged-xexpr?) (check-equal? (slurp (build-path (current-directory) "tests/server-routes/bar.html") #:regen #f) "<html><body><p>bar</p></body></html>"))
`(div ((style "white-space:pre-wrap;font-family:AlixFB,monospaced")) ,tx))
;; add a wrapper to tagged-xexpr that displays it as monospaced text
;; for "view source"ish functions
;; takes either a string or an xexpr
(define/contract (format-as-code x)
(xexpr? . -> . tagged-xexpr?)
`(div ((style "white-space:pre-wrap;font-family:AlixFB,monospaced")) ,x))
(module+ test
(check-equal? (format-as-code '(p "foo")) '(div ((style "white-space:pre-wrap;font-family:AlixFB,monospaced")) (p "foo"))))
;; server routes
;; these all produce an xexpr, which is handled upstream by (response/xexpr x)
;; server route that returns html
;; todo: what is this for?
(define/contract (route-html path) (define/contract (route-html path)
(complete-path? . -> . tagged-xexpr?) (complete-path? . -> . xexpr?)
(file->xexpr path)) (file->xexpr path))
;; server route that returns raw html, formatted as code
;; for viewing source without using "view source"
(define/contract (route-raw-html path) (define/contract (route-raw-html path)
(complete-path? . -> . tagged-xexpr?) (complete-path? . -> . xexpr?)
(format-as-code (slurp path #:regen #f)))
;; todo: consolidate with function above, they're the same.
;; server route that shows contents of file on disk
(define/contract (route-source path)
(complete-path? . -> . xexpr?)
(format-as-code (slurp path))) (format-as-code (slurp path)))
;; server route that returns xexpr (before conversion to html)
(define/contract (route-xexpr path) (define/contract (route-xexpr path)
(complete-path? . -> . tagged-xexpr?) (complete-path? . -> . xexpr?)
(format-as-code (~v (file->xexpr path)))) (format-as-code (~v (file->xexpr path))))
(define/contract (route-source path)
(complete-path? . -> . tagged-xexpr?)
(format-as-code (slurp path #:regenerate? #f)))
(define/contract (route-index pollen-file-root) (define/contract (route-index pollen-file-root)
((and/c path? complete-path?) . -> . tagged-xexpr?) (complete-path? . -> . xexpr?)
; set up filter functions by mapping a function-maker for each file type
(define-values (pollen-file? preproc-file? pmap-file?) ;; This function generates the Pollen dashboard.
(apply values (map (λ(ext)(λ(f)(has-ext? f ext))) (list POLLEN_SOURCE_EXT POLLEN_PREPROC_EXT POLLEN_MAP_EXT)))) ;; First, generate some lists of files.
(define (template-file? x)
(define-values (dir name ignore) (split-path x)) ;; get lists of files by mapping a filter function for each file type
(equal? (get (->string name) 0) TEMPLATE_FILE_PREFIX))
; get lists of files by mapping a filter function for each file type
(define-values (pollen-files preproc-files pmap-files template-files) (define-values (pollen-files preproc-files pmap-files template-files)
(apply values (map (λ(test) (filter test (directory-list pollen-file-root))) (list pollen-file? preproc-file? pmap-file? template-file?)))) (let ([all-files-in-project-directory (directory-list pollen-file-root)])
; the actual post-p files may not have been generated yet (apply values
(map (λ(test) (filter test all-files-in-project-directory))
(list pollen-source? preproc-source? pmap-source? template-source?)))))
;; The actual post-preproc files may not have been generated yet
;; so calculate their names (rather than rely on directory list)
(define post-preproc-files (map (λ(path) (remove-ext path)) preproc-files)) (define post-preproc-files (map (λ(path) (remove-ext path)) preproc-files))
; make a combined list of p-files and post-p files
(define all-preproc-files (sort (append preproc-files post-preproc-files) #:key path->string string<?))
;; Make a combined list of preproc files and post-preproc file, in alphabetical order
(define all-preproc-files (sort (append preproc-files post-preproc-files)
#:key path->string string<?))
;; calculate names of post-pollen files
;; todo: this isn't quite right. Assumes post-pollen file will have html extension.
;; not necessarily true (it will assume the extension of its template.)
;; But pulling out all the template extensions requires parsing all the files,
;; which is slow and superfluous, since we're trying to be lazy about rendering.
(define post-pollen-files (map (λ(path) (add-ext (remove-ext path) 'html)) pollen-files)) (define post-pollen-files (map (λ(path) (add-ext (remove-ext path) 'html)) pollen-files))
(define all-pollen-files (sort (append pollen-files post-pollen-files) #:key path->string string<?))
;; Make a combined list of pollen files and post-pollen files, in alphabetical order
(define all-pollen-files (sort (append pollen-files post-pollen-files) #:key path->string string<?))
;; Utility function for making file rows
(define (make-file-row file routes) (define (make-file-row file routes)
(define (make-link-cell type) (define (make-link-cell type)
(letrec ([source (add-ext (remove-ext file) POLLEN_SOURCE_EXT)] (letrec ([source (add-ext (remove-ext file) POLLEN_SOURCE_EXT)]
@ -86,18 +123,18 @@
`(tr ,(make-link-cell 'direct) ,@(map make-link-cell routes))) `(tr ,(make-link-cell 'direct) ,@(map make-link-cell routes)))
(if (andmap empty? (list pmap-files all-pollen-files all-preproc-files template-files)) (if (andmap empty? (list pmap-files all-pollen-files all-preproc-files template-files))
'(body "No files yet. Get to work!") '(body "No files yet. Get to work!")
`(body `(body
(style ((type "text/css")) "td a { display: block; width: 100%; height: 100%; padding: 8px; }" (style ((type "text/css")) "td a { display: block; width: 100%; height: 100%; padding: 8px; }"
"td:hover {background: #eee}") "td:hover {background: #eee}")
(table ((style "font-family:Concourse T3;font-size:115%")) (table ((style "font-family:Concourse T3;font-size:115%"))
; options for pmap files and template files ; options for pmap files and template files
,@(map (λ(file) (make-file-row file '(raw))) (append pmap-files template-files)) ,@(map (λ(file) (make-file-row file '(raw))) (append pmap-files template-files))
; options for pollen files ; options for pollen files
,@(map (λ(file) (make-file-row file '(raw source xexpr force))) post-pollen-files) ,@(map (λ(file) (make-file-row file '(raw source xexpr force))) post-pollen-files)
; options for preproc files ; options for preproc files
; branching in λ is needed so these files can be interleaved on the list ; branching in λ is needed so these files can be interleaved on the list
,@(map (λ(file) (make-file-row file '(raw preproc-source))) post-preproc-files))))) ,@(map (λ(file) (make-file-row file '(raw preproc-source))) post-preproc-files)))))
(define (get-query-value url key) (define (get-query-value url key)

@ -2,13 +2,14 @@
#lang web-server #lang web-server
(require web-server/servlet-env) (require web-server/servlet-env)
(require web-server/dispatch web-server/dispatchers/dispatch) (require web-server/dispatch web-server/dispatchers/dispatch)
(require xml)
(require "server-routes.rkt" "predicates.rkt") (require "server-routes.rkt" "predicates.rkt")
(displayln "Pollen server starting...") (displayln "Pollen server starting...")
(define/contract (route-wrapper route-proc) (define/contract (route-wrapper route-proc)
;; todo: make better contract for return value ;; todo: make better contract for return value
((complete-path? . -> . tagged-xexpr?) . -> . procedure?) (procedure? . -> . procedure?)
(λ(req string-arg) (λ(req string-arg)
(define filename string-arg) (define filename string-arg)
(response/xexpr (route-proc (build-path pollen-file-root filename))))) (response/xexpr (route-proc (build-path pollen-file-root filename)))))
@ -25,7 +26,7 @@
;; so extract the path manually ;; so extract the path manually
(define req-uri (request-uri req)) (define req-uri (request-uri req))
(define path (reroot-path (url->path req-uri) pollen-file-root)) (define path (reroot-path (url->path req-uri) pollen-file-root))
(define force (get-query-value req-uri 'force)) (define force (equal? (get-query-value req-uri 'force) "true"))
(route-preproc path #:force force) (route-preproc path #:force force)
(next-dispatcher))])) (next-dispatcher))]))

@ -0,0 +1 @@
<html><body><p>bar</p></body></html>

@ -0,0 +1,2 @@
FALLBACK! put-as-htmlroot
foo

@ -0,0 +1,2 @@
#lang planet mb/pollen
foo

@ -1 +0,0 @@
#lang racket/base

@ -2,7 +2,7 @@
(define POLLEN_PREPROC_EXT 'pp) (define POLLEN_PREPROC_EXT 'pp)
(define POLLEN_SOURCE_EXT 'p) (define POLLEN_SOURCE_EXT 'p)
(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)

Loading…
Cancel
Save