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