mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

add world: prefix to global values

Browse Source
pull/9/head
Matthew Butterick 11 years ago
parent 62a4d504c7
commit db3bc4be7d
14 changed files with 107 additions and 111 deletions
Show Stats Download Patch File Download Diff File

4
command.rkt
Unescape Escape View File

@ -9,7 +9,7 @@
(datum->syntax stx (datum->syntax stx
(let* ([args (current-command-line-arguments)] (let* ([args (current-command-line-arguments)]
[arg (if (> (len args) 0) (get args 0) "")]) [arg (if (> (len args) 0) (get args 0) "")])
(display (format "~a: " COMMAND_FILE)) (display (format "~a: " world:command-file))
(case arg (case arg
[("help") (displayln "valid commands are [("help") (displayln "valid commands are
polcom start (starts project server) polcom start (starts project server)
@ -21,7 +21,7 @@ polcom [filename] (renders individual file)")]
;; todo: take extensions off the comand line ;; todo: take extensions off the comand line
(displayln "Render preproc & ptree files ...") (displayln "Render preproc & ptree files ...")
(require "render.rkt" "file-tools.rkt" "world.rkt") (require "render.rkt" "file-tools.rkt" "world.rkt")
(apply render-batch (append-map project-files-with-ext (list PREPROC_SOURCE_EXT PTREE_SOURCE_EXT))))] (apply render-batch (append-map project-files-with-ext (list world:preproc-source-ext world:ptree-source-ext))))]
[("clone") (let ([target-path [("clone") (let ([target-path
(if (> (len args) 1) (if (> (len args) 1)
(->path (get args 1)) (->path (get args 1))

18
file-tools.rkt
Unescape Escape View File

@ -114,7 +114,7 @@
(define+provide/contract (preproc-source? x) (define+provide/contract (preproc-source? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(and (pathish? x) (has-ext? (->path x) PREPROC_SOURCE_EXT))) (and (pathish? x) (has-ext? (->path x) world:preproc-source-ext)))
(define+provide/contract (has-null-source? x) (define+provide/contract (has-null-source? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
@ -147,24 +147,24 @@
(define+provide/contract (ptree-source? x) (define+provide/contract (ptree-source? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(and (pathish? x) ((->path x) . has-ext? . PTREE_SOURCE_EXT))) (and (pathish? x) ((->path x) . has-ext? . world:ptree-source-ext)))
(define+provide/contract (decoder-source? x) (define+provide/contract (decoder-source? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(and (pathish? x) ((->path x) . has-ext? . MARKUP_SOURCE_EXT))) (and (pathish? x) ((->path x) . has-ext? . world:markup-source-ext)))
(define+provide/contract (null-source? x) (define+provide/contract (null-source? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(and (pathish? x) ((->path x) . has-ext? . NULL_SOURCE_EXT))) (and (pathish? x) ((->path x) . has-ext? . world:null-source-ext)))
(define+provide/contract (template-source? x) (define+provide/contract (template-source? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(and (pathish? x) (and (pathish? x)
(let-values ([(dir name ignore) (split-path x)]) (let-values ([(dir name ignore) (split-path x)])
(equal? (get (->string name) 0) TEMPLATE_SOURCE_PREFIX)))) (equal? (get (->string name) 0) world:template-source-prefix))))
@ -174,13 +174,13 @@
(coerce/path? . -> . coerce/path?) (coerce/path? . -> . coerce/path?)
(if (preproc-source? x) (if (preproc-source? x)
x x
(add-ext x PREPROC_SOURCE_EXT))) (add-ext x world:preproc-source-ext)))
(define+provide/contract (->null-source-path x) (define+provide/contract (->null-source-path x)
(coerce/path? . -> . coerce/path?) (coerce/path? . -> . coerce/path?)
(if (decoder-source? x) (if (decoder-source? x)
x x
(add-ext x NULL_SOURCE_EXT))) (add-ext x world:null-source-ext)))
(define+provide/contract (->output-path x) (define+provide/contract (->output-path x)
(coerce/path? . -> . coerce/path?) (coerce/path? . -> . coerce/path?)
@ -196,12 +196,12 @@
(coerce/path? . -> . coerce/path?) (coerce/path? . -> . coerce/path?)
(if (decoder-source? x) (if (decoder-source? x)
x x
(add-ext x MARKUP_SOURCE_EXT))) (add-ext x world:markup-source-ext)))
(define+provide/contract (project-files-with-ext ext) (define+provide/contract (project-files-with-ext ext)
(coerce/symbol? . -> . (listof complete-path?)) (coerce/symbol? . -> . (listof complete-path?))
(map ->complete-path (filter (λ(i) (has-ext? i ext)) (directory-list (CURRENT_PROJECT_ROOT))))) (map ->complete-path (filter (λ(i) (has-ext? i ext)) (directory-list (world:current-project-root)))))
;; to identify unsaved sources in DrRacket ;; to identify unsaved sources in DrRacket
(define (unsaved-source? path-string) (define (unsaved-source? path-string)

2
lang/reader-base.rkt
Unescape Escape View File

@ -4,7 +4,7 @@
(provide make-reader-with-mode (all-from-out pollen/world)) (provide make-reader-with-mode (all-from-out pollen/world))
(define read-inner (make-at-reader (define read-inner (make-at-reader
#:command-char EXPRESSION_DELIMITER #:command-char world:expression-delimiter
#:syntax? #t #:syntax? #t
#:inside? #t)) #:inside? #t))

2
lang/reader.rkt
Unescape Escape View File

@ -1,4 +1,4 @@
#lang racket/base #lang racket/base
(require pollen/lang/reader-base) (require pollen/lang/reader-base)
(make-reader-with-mode reader-mode-auto) (make-reader-with-mode world:reader-mode-auto)

18
main.rkt
Unescape Escape View File

@ -25,7 +25,7 @@
;; Build 'inner-here-path and 'inner-here ;; Build 'inner-here-path and 'inner-here
(define (here-path->here here-path) (define (here-path->here here-path)
(path->string (path-replace-suffix (pollen-find-relative-path (CURRENT_PROJECT_ROOT) here-path) ""))) (path->string (path-replace-suffix (pollen-find-relative-path (world:current-project-root) here-path) "")))
(define inner-here-path (get-here-path)) (define inner-here-path (get-here-path))
(define inner-here (here-path->here inner-here-path)) (define inner-here (here-path->here inner-here-path))
@ -60,22 +60,22 @@
;; set the parser mode based on reader mode ;; set the parser mode based on reader mode
(define parser-mode (define parser-mode
(if (reader-mode . equal? . reader-mode-auto) (if (reader-mode . equal? . world:reader-mode-auto)
(let* ([file-ext-pattern (pregexp "\\w+$")] (let* ([file-ext-pattern (pregexp "\\w+$")]
[here-ext (car (regexp-match file-ext-pattern inner-here-path))]) [here-ext (car (regexp-match file-ext-pattern inner-here-path))])
(cond (cond
[(equal? (string->symbol here-ext) PTREE_SOURCE_EXT) reader-mode-ptree] [(equal? (string->symbol here-ext) world:ptree-source-ext) world:reader-mode-ptree]
[(equal? (string->symbol here-ext) MARKUP_SOURCE_EXT) reader-mode-markup] [(equal? (string->symbol here-ext) world:markup-source-ext) world:reader-mode-markup]
[else 'pre])) [else world:reader-mode-preproc]))
reader-mode)) reader-mode))
(define main (apply (cond (define main (apply (cond
[(equal? parser-mode reader-mode-ptree) [(equal? parser-mode world:reader-mode-ptree)
(λ xs (decode (cons PTREE_ROOT_NODE xs) (λ xs (decode (cons world:ptree-root-node xs)
#:xexpr-elements-proc (λ(xs) (filter (compose1 not (def/c whitespace?)) xs))))] #:xexpr-elements-proc (λ(xs) (filter (compose1 not (def/c whitespace?)) xs))))]
;; 'root is the hook for the decoder function. ;; 'root is the hook for the decoder function.
;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...) ;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...)
[(equal? parser-mode 'markup) root] [(equal? parser-mode world:reader-mode-markup) root]
;; for preprocessor output, just make a string. ;; for preprocessor output, just make a string.
[else (λ xs (apply string-append (map to-string xs)))]) [else (λ xs (apply string-append (map to-string xs)))])
(cdr main-without-metas))) ;; cdr strips placeholder-root tag (cdr main-without-metas))) ;; cdr strips placeholder-root tag
@ -87,6 +87,6 @@
;; for output in DrRacket ;; for output in DrRacket
(module+ main (module+ main
(if (equal? parser-mode reader-mode-preproc) (if (equal? parser-mode world:reader-mode-preproc)
(display main) (display main)
(print main))))) (print main)))))

2
markup/lang/reader.rkt
Unescape Escape View File

@ -1,4 +1,4 @@
#lang racket/base #lang racket/base
(require pollen/lang/reader-base) (require pollen/lang/reader-base)
(make-reader-with-mode reader-mode-markup) (make-reader-with-mode world:reader-mode-markup)

2
pre/lang/reader.rkt
Unescape Escape View File

@ -1,4 +1,4 @@
#lang racket/base #lang racket/base
(require pollen/lang/reader-base) (require pollen/lang/reader-base)
(make-reader-with-mode reader-mode-preproc) (make-reader-with-mode world:reader-mode-preproc)

2
project-requires.rkt
Unescape Escape View File

@ -8,7 +8,7 @@
;; list of all eligible requires in project require directory ;; list of all eligible requires in project require directory
(define (get-project-require-files) (define (get-project-require-files)
(define extras-directory (build-path (current-directory) EXTRAS_DIR)) (define extras-directory (build-path (current-directory) world:extras-dir))
(and (directory-exists? extras-directory) (and (directory-exists? extras-directory)
;; #:build? option returns complete paths (instead of just file names) ;; #:build? option returns complete paths (instead of just file names)
(let ([files (filter project-require-file? (directory-list extras-directory #:build? #t))]) (let ([files (filter project-require-file? (directory-list extras-directory #:build? #t))])

24
ptree.rkt
Unescape Escape View File

@ -47,24 +47,24 @@
(define+provide/contract (file->ptree p) (define+provide/contract (file->ptree p)
(pathish? . -> . ptree?) (pathish? . -> . ptree?)
(cached-require (->path p) MAIN_POLLEN_EXPORT)) (cached-require (->path p) world:main-pollen-export))
(define+provide/contract (directory->ptree dir) (define+provide/contract (directory->ptree dir)
(directory-pathish? . -> . ptree?) (directory-pathish? . -> . ptree?)
(let ([files (map remove-ext (filter (λ(x) (has-ext? x MARKUP_SOURCE_EXT)) (directory-list dir)))]) (let ([files (map remove-ext (filter (λ(x) (has-ext? x world:markup-source-ext)) (directory-list dir)))])
(ptree-root->ptree (cons PTREE_ROOT_NODE files)))) (ptree-root->ptree (cons world:ptree-root-node files))))
;; Try loading from ptree file, or failing that, synthesize ptree. ;; Try loading from ptree file, or failing that, synthesize ptree.
(define+provide/contract (make-project-ptree project-dir) (define+provide/contract (make-project-ptree project-dir)
(directory-pathish? . -> . ptree?) (directory-pathish? . -> . ptree?)
(define ptree-source (build-path project-dir DEFAULT_PTREE)) (define ptree-source (build-path project-dir world:default-ptree))
(cached-require ptree-source 'main)) (cached-require ptree-source 'main))
(module+ test (module+ test
(let ([sample-main `(POLLEN_TREE_ROOT_NAME "foo" "bar" (one (two "three")))]) (let ([sample-main `(world:pollen-tree-root-name "foo" "bar" (one (two "three")))])
(check-equal? (ptree-root->ptree sample-main) (check-equal? (ptree-root->ptree sample-main)
`(POLLEN_TREE_ROOT_NAME "foo" "bar" (one (two "three")))))) `(world:pollen-tree-root-name "foo" "bar" (one (two "three"))))))
(define+provide/contract (parent pnode [ptree (current-ptree)]) (define+provide/contract (parent pnode [ptree (current-ptree)])
@ -203,9 +203,9 @@
(module+ test (module+ test
(set! test-ptree-main `(,PTREE_ROOT_NODE "foo" "bar" (one (two "three")))) (set! test-ptree-main `(,world:ptree-root-node "foo" "bar" (one (two "three"))))
(check-equal? (ptree-root->ptree test-ptree-main) (check-equal? (ptree-root->ptree test-ptree-main)
`(,PTREE_ROOT_NODE "foo" "bar" (one (two "three"))))) `(,world:ptree-root-node "foo" "bar" (one (two "three")))))
(define+provide/contract (pnodes-unique?/error x) (define+provide/contract (pnodes-unique?/error x)
@ -216,19 +216,19 @@
(define+provide/contract (ptree-source-decode . elements) (define+provide/contract (ptree-source-decode . elements)
(() #:rest pnodes-unique?/error . ->* . ptree?) (() #:rest pnodes-unique?/error . ->* . ptree?)
(ptree-root->ptree (decode (cons PTREE_ROOT_NODE elements) (ptree-root->ptree (decode (cons world:ptree-root-node elements)
#:xexpr-elements-proc (λ(xs) (filter-not whitespace? xs))))) #:xexpr-elements-proc (λ(xs) (filter-not whitespace? xs)))))
(define current-ptree (make-parameter `(,PTREE_ROOT_NODE))) (define current-ptree (make-parameter `(,world:ptree-root-node)))
(define current-url-context (make-parameter (CURRENT_PROJECT_ROOT))) (define current-url-context (make-parameter (world:current-project-root)))
(provide current-ptree current-url-context) (provide current-ptree current-url-context)
;; used to convert here-path into here ;; used to convert here-path into here
(define+provide/contract (path->pnode path) (define+provide/contract (path->pnode path)
(pathish? . -> . pnode?) (pathish? . -> . pnode?)
(->string (->output-path (find-relative-path (CURRENT_PROJECT_ROOT) (->path path))))) (->string (->output-path (find-relative-path (world:current-project-root) (->path path)))))
#| #|

2
ptree/lang/reader.rkt
Unescape Escape View File

@ -1,4 +1,4 @@
#lang racket/base #lang racket/base
(require pollen/lang/reader-base) (require pollen/lang/reader-base)
(make-reader-with-mode reader-mode-ptree) (make-reader-with-mode world:reader-mode-ptree)

24
render.rkt
Unescape Escape View File

@ -103,7 +103,7 @@
[(needs-template? path) (render-with-template path #:force force)] [(needs-template? path) (render-with-template path #:force force)]
[(ptree-source? path) (let ([ptree (cached-require path 'main)]) [(ptree-source? path) (let ([ptree (cached-require path 'main)])
(render-files-in-ptree ptree #:force force))] (render-files-in-ptree ptree #:force force))]
[(equal? FALLBACK_TEMPLATE (->string (file-name-from-path path))) [(equal? world:fallback-template (->string (file-name-from-path path)))
(message "Render: using fallback template")] (message "Render: using fallback template")]
[(file-exists? path) (message "Serving static file" (->string (file-name-from-path path)))]))) [(file-exists? path) (message "Serving static file" (->string (file-name-from-path path)))])))
(for-each &render xs)) (for-each &render xs))
@ -193,14 +193,14 @@
(filter (λ(x) (->boolean x)) ; if any of the possibilities below are invalid, they return #f (filter (λ(x) (->boolean x)) ; if any of the possibilities below are invalid, they return #f
(list (list
(and template-name (build-path source-dir template-name)) ; path based on template-name (and template-name (build-path source-dir template-name)) ; path based on template-name
(parameterize ([current-directory (CURRENT_PROJECT_ROOT)]) (parameterize ([current-directory (world:current-project-root)])
(let ([source-metas (cached-require source-path 'metas)]) (let ([source-metas (cached-require source-path 'metas)])
(and (TEMPLATE_META_KEY . in? . source-metas) (and (world:template-meta-key . in? . source-metas)
(build-path source-dir (get source-metas TEMPLATE_META_KEY))))) ; path based on metas (build-path source-dir (get source-metas world:template-meta-key))))) ; path based on metas
(build-path source-dir (build-path source-dir
(add-ext (add-ext DEFAULT_TEMPLATE_PREFIX (get-ext (->output-path source-path))) TEMPLATE_EXT))))) ; path using default template (add-ext (add-ext world:default-template-prefix (get-ext (->output-path source-path))) world:template-ext))))) ; path using default template
(let ([ft-path (build-path source-dir FALLBACK_TEMPLATE)]) ; if none of these work, make fallback template file (let ([ft-path (build-path source-dir world:fallback-template)]) ; if none of these work, make fallback template file
(copy-file (build-path (current-server-extras-path) FALLBACK_TEMPLATE) ft-path #t) (copy-file (build-path (world:current-server-extras-path) world:fallback-template) ft-path #t)
ft-path))) ft-path)))
(render template-path #:force force-render) ; bc template might have its own preprocessor source (render template-path #:force force-render) ; bc template might have its own preprocessor source
@ -222,7 +222,7 @@
(rendered-message output-path))) (rendered-message output-path)))
(up-to-date-message output-path)) (up-to-date-message output-path))
(let ([ft-path (build-path source-dir FALLBACK_TEMPLATE)]) ; delete fallback template if needed (let ([ft-path (build-path source-dir world:fallback-template)]) ; delete fallback template if needed
(when (file-exists? ft-path) (delete-file ft-path)))) (when (file-exists? ft-path) (delete-file ft-path))))
;; cache some modules inside this namespace so they can be shared by namespace for eval ;; cache some modules inside this namespace so they can be shared by namespace for eval
@ -256,8 +256,8 @@
(parameterize ([current-namespace (make-base-namespace)] (parameterize ([current-namespace (make-base-namespace)]
[current-directory (->complete-path base-dir)] [current-directory (->complete-path base-dir)]
[current-output-port (current-error-port)] [current-output-port (current-error-port)]
[current-ptree (make-project-ptree (CURRENT_PROJECT_ROOT))] [current-ptree (make-project-ptree (world:current-project-root))]
[current-url-context (CURRENT_PROJECT_ROOT)]) [current-url-context (world:current-project-root)])
(for-each (λ(mod-name) (namespace-attach-module original-ns mod-name)) (for-each (λ(mod-name) (namespace-attach-module original-ns mod-name))
'(web-server/templates '(web-server/templates
xml xml
@ -302,14 +302,14 @@
(let ([main (cached-require ,source-name 'main)] (let ([main (cached-require ,source-name 'main)]
[metas (cached-require ,source-name 'metas)]) [metas (cached-require ,source-name 'metas)])
(local-require pollen/debug pollen/ptree pollen/template pollen/top) (local-require pollen/debug pollen/ptree pollen/template pollen/top)
(include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name))))) (include-template #:command-char ,world:template-field-delimiter ,(->string template-name)))))
(render-through-eval source-dir string-to-eval)) (render-through-eval source-dir string-to-eval))
#| #|
(module+ main (module+ main
(parameterize ([current-cache (make-cache)] (parameterize ([current-cache (make-cache)]
[CURRENT_PROJECT_ROOT (string->path "/Users/mb/git/bpt")]) [world:current-project-root (string->path "/Users/mb/git/bpt")])
(render-source-with-template (render-source-with-template
(string->path "/Users/mb/git/bpt/test.html.pm") (string->path "/Users/mb/git/bpt/test.html.pm")
(string->path "/Users/mb/git/bpt/-test.html")))) (string->path "/Users/mb/git/bpt/-test.html"))))

22
server-routes.rkt
Unescape Escape View File

@ -21,7 +21,7 @@
(meta ([charset "UTF-8"])) (meta ([charset "UTF-8"]))
(link ([rel "stylesheet"] (link ([rel "stylesheet"]
[type "text/css"] [type "text/css"]
[href ,(format "/~a" DASHBOARD_CSS)]))) [href ,(format "/~a" world:dashboard-css)])))
(body (body
,content-xexpr (div ((id "pollen-logo")))))) ,content-xexpr (div ((id "pollen-logo"))))))
@ -37,7 +37,7 @@
(define client (request-client-ip req)) (define client (request-client-ip req))
(define localhost-client "::1") (define localhost-client "::1")
(define url-string (url->string (request-uri req))) (define url-string (url->string (request-uri req)))
(message "Request:" (string-replace url-string DASHBOARD_NAME " dashboard") (message "Request:" (string-replace url-string world:dashboard-name " dashboard")
(if (not (equal? client localhost-client)) (format "from ~a" client) ""))) (if (not (equal? client localhost-client)) (format "from ~a" client) "")))
;; pass string args to route, then ;; pass string args to route, then
@ -48,7 +48,7 @@
(procedure? . -> . procedure?) (procedure? . -> . procedure?)
(λ(req . string-args) (λ(req . string-args)
(logger req) (logger req)
(define path (apply build-path (CURRENT_PROJECT_ROOT) (flatten string-args))) (define path (apply build-path (world:current-project-root) (flatten string-args)))
(response/xexpr (route-proc path)))) (response/xexpr (route-proc path))))
@ -86,7 +86,7 @@
(pathish? . -> . xexpr?) (pathish? . -> . xexpr?)
(define path (->complete-path p)) (define path (->complete-path p))
(define img (bitmap/file path)) (define img (bitmap/file path))
(define relative-path (->string (find-relative-path (CURRENT_PROJECT_ROOT) path))) (define relative-path (->string (find-relative-path (world:current-project-root) path)))
(define img-url (format "/~a" relative-path)) (define img-url (format "/~a" relative-path))
`(div `(div
(p "filename =" ,(->string relative-path)) (p "filename =" ,(->string relative-path))
@ -100,7 +100,7 @@
(define (handle-zip-path p) (define (handle-zip-path p)
(pathish? . -> . xexpr?) (pathish? . -> . xexpr?)
(define path (->path p)) (define path (->path p))
(define relative-path (->string (find-relative-path (CURRENT_PROJECT_ROOT) path))) (define relative-path (->string (find-relative-path (world:current-project-root) path)))
(define ziplist (zip-directory-entries (read-zip-directory path))) (define ziplist (zip-directory-entries (read-zip-directory path)))
`(div `(div
(p "filename =" ,(->string relative-path)) (p "filename =" ,(->string relative-path))
@ -141,7 +141,7 @@
(define (dashboard dashfile) (define (dashboard dashfile)
(define dir (get-enclosing-dir dashfile)) (define dir (get-enclosing-dir dashfile))
(define (in-project-root?) (define (in-project-root?)
(directories-equal? dir (CURRENT_PROJECT_ROOT))) (directories-equal? dir (world:current-project-root)))
(define parent-dir (and (not (in-project-root?)) (get-enclosing-dir dir))) (define parent-dir (and (not (in-project-root?)) (get-enclosing-dir dir)))
(define empty-cell (cons #f #f)) (define empty-cell (cons #f #f))
(define (make-link-cell href+text) (define (make-link-cell href+text)
@ -152,8 +152,8 @@
text))))) text)))))
(define (make-parent-row) (define (make-parent-row)
(if parent-dir (if parent-dir
(let* ([url-to-parent-dashboard (format "/~a" (find-relative-path (CURRENT_PROJECT_ROOT) (build-path parent-dir DASHBOARD_NAME)))] (let* ([url-to-parent-dashboard (format "/~a" (find-relative-path (world:current-project-root) (build-path parent-dir world:dashboard-name)))]
[url-to-parent (string-replace url-to-parent-dashboard DASHBOARD_NAME "")]) [url-to-parent (string-replace url-to-parent-dashboard world:dashboard-name "")])
`(tr (th ((colspan "3")) (a ((href ,url-to-parent-dashboard)) ,(format "up to ~a" url-to-parent))))) `(tr (th ((colspan "3")) (a ((href ,url-to-parent-dashboard)) ,(format "up to ~a" url-to-parent)))))
`(tr (th ((colspan "3")(class "root")) "Pollen root")))) `(tr (th ((colspan "3")(class "root")) "Pollen root"))))
@ -169,7 +169,7 @@
(append (list (append (list
(cond ; main cell (cond ; main cell
[(directory-exists? (build-path dir filename)) ; links subdir to its dashboard [(directory-exists? (build-path dir filename)) ; links subdir to its dashboard
(cons (format "~a/~a" filename DASHBOARD_NAME) (format "~a/" filename))] (cons (format "~a/~a" filename world:dashboard-name) (format "~a/" filename))]
[source (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) "." ,(get-ext source))))] [source (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) "." ,(get-ext source))))]
[else (cons filename filename)]) [else (cons filename filename)])
@ -183,7 +183,7 @@
[(ptree-source? filename) empty-cell] [(ptree-source? filename) empty-cell]
[else (cons (format "out/~a" filename) "out")])))))) [else (cons (format "out/~a" filename) "out")]))))))
(define (ineligible-path? x) (or (not (visible? x)) (member x RESERVED_PATHS))) (define (ineligible-path? x) (or (not (visible? x)) (member x world:reserved-paths)))
(define (unique-sorted-output-paths xs) (define (unique-sorted-output-paths xs)
(define output-paths (map ->output-path xs)) (define output-paths (map ->output-path xs))
@ -219,7 +219,7 @@
(define/contract (req->path req) (define/contract (req->path req)
(request? . -> . path?) (request? . -> . path?)
(reroot-path (url->path (request-uri req)) (CURRENT_PROJECT_ROOT))) (reroot-path (url->path (request-uri req)) (world:current-project-root)))
;; default route ;; default route
(define (route-default req) (define (route-default req)

22
server.rkt
Unescape Escape View File

@ -9,31 +9,31 @@
(define-values (pollen-servlet _) (define-values (pollen-servlet _)
(dispatch-rules (dispatch-rules
[((string-arg) ... (? (λ(x) (x . has-ext? . PTREE_SOURCE_EXT)))) route-dashboard] [((string-arg) ... (? (λ(x) (x . has-ext? . world:ptree-source-ext)))) route-dashboard]
[((string-arg) ... "in" (string-arg)) route-in] [((string-arg) ... "in" (string-arg)) route-in]
[((string-arg) ... "out" (string-arg)) route-out] [((string-arg) ... "out" (string-arg)) route-out]
[((string-arg) ... "xexpr" (string-arg)) route-xexpr] [((string-arg) ... "xexpr" (string-arg)) route-xexpr]
[else route-default])) [else route-default]))
(message (format "Welcome to Pollen ~a" POLLEN_VERSION) (format "(Racket ~a)" (version))) (message (format "Welcome to Pollen ~a" world:pollen-version) (format "(Racket ~a)" (version)))
(message (format "Project root is ~a" (CURRENT_PROJECT_ROOT))) (message (format "Project root is ~a" (world:current-project-root)))
(define server-name (format "http://localhost:~a" SERVER_PORT)) (define server-name (format "http://localhost:~a" world: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/~a" server-name DASHBOARD_NAME)) (message (format "Project dashboard is ~a/~a" server-name world:dashboard-name))
(message "Ready to rock") (message "Ready to rock")
(current-module-root (apply build-path (drop-right (explode-path (current-contract-region)) 1))) (world:current-module-root (apply build-path (drop-right (explode-path (current-contract-region)) 1)))
(current-server-extras-path (build-path (current-module-root) "pollen-server-extras")) (world:current-server-extras-path (build-path (world:current-module-root) "pollen-server-extras"))
(parameterize ([current-module-root (current-module-root)] (parameterize ([world:current-module-root (world:current-module-root)]
[current-server-extras-path (current-server-extras-path)] [world:current-server-extras-path (world:current-server-extras-path)]
[current-cache (make-cache)]) [current-cache (make-cache)])
(serve/servlet pollen-servlet (serve/servlet pollen-servlet
#:port SERVER_PORT #:port world:server-port
#:listen-ip #f #:listen-ip #f
#:servlet-regexp #rx"" ; respond to top level #:servlet-regexp #rx"" ; respond to top level
#:command-line? #t #:command-line? #t
#:file-not-found-responder route-404 #:file-not-found-responder route-404
#:extra-files-paths (list (current-server-extras-path) (CURRENT_PROJECT_ROOT)))) #:extra-files-paths (list (world:current-server-extras-path) (world:current-project-root))))

74
world.rkt
Unescape Escape View File

@ -1,64 +1,60 @@
#lang racket/base #lang racket/base
;; todo: how to make project- or user-specific prefs (provide (prefix-out world: (all-defined-out)))
(provide (all-defined-out)) (define pollen-version "0.001")
(define POLLEN_VERSION "0.001") (define preproc-source-ext 'p)
(define markup-source-ext 'pm)
(define null-source-ext 'px)
(define ptree-source-ext 'ptree)
(define PREPROC_SOURCE_EXT 'p) (define reader-mode-auto 'auto)
(define MARKUP_SOURCE_EXT 'pm) (define reader-mode-preproc 'pre)
(define NULL_SOURCE_EXT 'px) (define reader-mode-markup 'markup)
(define PTREE_SOURCE_EXT 'ptree) (define reader-mode-ptree 'ptree)
(define DECODABLE_EXTENSIONS (list MARKUP_SOURCE_EXT PTREE_SOURCE_EXT))
(define decodable-extensions (list markup-source-ext ptree-source-ext))
(define DEFAULT_PTREE "main.ptree") (define default-ptree "main.ptree")
(define PTREE_ROOT_NODE 'ptree-root) (define ptree-root-node 'ptree-root)
(define TEMPLATE_SOURCE_PREFIX "-") (define template-source-prefix "-")
(define EXPRESSION_DELIMITER #\◊) (define expression-delimiter #\◊)
(define TEMPLATE_FIELD_DELIMITER EXPRESSION_DELIMITER) (define template-field-delimiter expression-delimiter)
(define DEFAULT_TEMPLATE_PREFIX "main") (define default-template-prefix "main")
(define TEMPLATE_EXT 'pt) (define template-ext 'pt)
(define FALLBACK_TEMPLATE "fallback.html.pt") (define fallback-template "fallback.html.pt")
(define TEMPLATE_META_KEY "template") (define template-meta-key "template")
(define MAIN_POLLEN_EXPORT 'main) (define main-pollen-export 'main)
(define EXTRAS_DIR (string->path "pollen-require")) (define extras-dir (string->path "pollen-require"))
(define MISSING_FILE_BOILERPLATE "#lang pollen\n\n") (define missing-file-boilerplace "#lang pollen\n\n")
(define LINE_BREAK "\n") (define line-break "\n")
(define PARAGRAPH_BREAK "\n\n") (define paragraph-break "\n\n")
(define OUTPUT_SUBDIR 'public) (define output-subdir 'public)
;;(require racket/string racket/port racket/system) (define racket-path "/usr/bin/racket")
;; todo: is path to racket already available as an environment variable?
;; e.g., (find-system-path 'xxx)? Because this next line is sort of slow
;;(define RACKET_PATH (string-trim (with-output-to-string (λ() (system "which racket")))))
(define RACKET_PATH "/usr/bin/racket") ;; todo: this won't always work
(define COMMAND_FILE "polcom") (define command-file "polcom")
(define RESERVED_PATHS (define reserved-paths
(map string->path (list COMMAND_FILE (path->string EXTRAS_DIR) "poldash.css" "compiled"))) (map string->path (list command-file (path->string extras-dir) "poldash.css" "compiled")))
(define CURRENT_PROJECT_ROOT (make-parameter (current-directory))) (define current-project-root (make-parameter (current-directory)))
(define SERVER_PORT 8088) (define server-port 8088)
(define DASHBOARD_NAME "index.ptree") (define dashboard-name "index.ptree")
(define DASHBOARD_CSS "poldash.css") (define dashboard-css "poldash.css")
(define current-module-root (make-parameter #f)) (define current-module-root (make-parameter #f))
(define current-server-extras-path (make-parameter #f)) (define current-server-extras-path (make-parameter #f))
(define reader-mode-auto 'auto)
(define reader-mode-preproc 'pre)
(define reader-mode-markup 'markup)
(define reader-mode-ptree 'ptree)

Write Preview
Loading…
Cancel
Save