add world: prefix to global values

pull/9/head
Matthew Butterick 11 years ago
parent 62a4d504c7
commit db3bc4be7d

@ -9,7 +9,7 @@
(datum->syntax stx
(let* ([args (current-command-line-arguments)]
[arg (if (> (len args) 0) (get args 0) "")])
(display (format "~a: " COMMAND_FILE))
(display (format "~a: " world:command-file))
(case arg
[("help") (displayln "valid commands are
polcom start (starts project server)
@ -21,7 +21,7 @@ polcom [filename] (renders individual file)")]
;; todo: take extensions off the comand line
(displayln "Render preproc & ptree files ...")
(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
(if (> (len args) 1)
(->path (get args 1))

@ -114,7 +114,7 @@
(define+provide/contract (preproc-source? x)
(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)
(any/c . -> . coerce/boolean?)
@ -147,24 +147,24 @@
(define+provide/contract (ptree-source? x)
(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)
(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)
(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)
(any/c . -> . coerce/boolean?)
(and (pathish? 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?)
(if (preproc-source? x)
x
(add-ext x PREPROC_SOURCE_EXT)))
(add-ext x world:preproc-source-ext)))
(define+provide/contract (->null-source-path x)
(coerce/path? . -> . coerce/path?)
(if (decoder-source? x)
x
(add-ext x NULL_SOURCE_EXT)))
(add-ext x world:null-source-ext)))
(define+provide/contract (->output-path x)
(coerce/path? . -> . coerce/path?)
@ -196,12 +196,12 @@
(coerce/path? . -> . coerce/path?)
(if (decoder-source? x)
x
(add-ext x MARKUP_SOURCE_EXT)))
(add-ext x world:markup-source-ext)))
(define+provide/contract (project-files-with-ext ext)
(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
(define (unsaved-source? path-string)

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

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

@ -25,7 +25,7 @@
;; Build 'inner-here-path and 'inner-here
(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 (here-path->here inner-here-path))
@ -60,22 +60,22 @@
;; set the parser mode based on reader 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+$")]
[here-ext (car (regexp-match file-ext-pattern inner-here-path))])
(cond
[(equal? (string->symbol here-ext) PTREE_SOURCE_EXT) reader-mode-ptree]
[(equal? (string->symbol here-ext) MARKUP_SOURCE_EXT) reader-mode-markup]
[else 'pre]))
[(equal? (string->symbol here-ext) world:ptree-source-ext) world:reader-mode-ptree]
[(equal? (string->symbol here-ext) world:markup-source-ext) world:reader-mode-markup]
[else world:reader-mode-preproc]))
reader-mode))
(define main (apply (cond
[(equal? parser-mode reader-mode-ptree)
(λ xs (decode (cons PTREE_ROOT_NODE xs)
[(equal? parser-mode world:reader-mode-ptree)
(λ xs (decode (cons world:ptree-root-node xs)
#:xexpr-elements-proc (λ(xs) (filter (compose1 not (def/c whitespace?)) xs))))]
;; 'root is the hook for the decoder function.
;; 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.
[else (λ xs (apply string-append (map to-string xs)))])
(cdr main-without-metas))) ;; cdr strips placeholder-root tag
@ -87,6 +87,6 @@
;; for output in DrRacket
(module+ main
(if (equal? parser-mode reader-mode-preproc)
(if (equal? parser-mode world:reader-mode-preproc)
(display main)
(print main)))))

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

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

@ -8,7 +8,7 @@
;; list of all eligible requires in project require directory
(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)
;; #:build? option returns complete paths (instead of just file names)
(let ([files (filter project-require-file? (directory-list extras-directory #:build? #t))])

@ -47,24 +47,24 @@
(define+provide/contract (file->ptree p)
(pathish? . -> . ptree?)
(cached-require (->path p) MAIN_POLLEN_EXPORT))
(cached-require (->path p) world:main-pollen-export))
(define+provide/contract (directory->ptree dir)
(directory-pathish? . -> . ptree?)
(let ([files (map remove-ext (filter (λ(x) (has-ext? x MARKUP_SOURCE_EXT)) (directory-list dir)))])
(ptree-root->ptree (cons PTREE_ROOT_NODE files))))
(let ([files (map remove-ext (filter (λ(x) (has-ext? x world:markup-source-ext)) (directory-list dir)))])
(ptree-root->ptree (cons world:ptree-root-node files))))
;; Try loading from ptree file, or failing that, synthesize ptree.
(define+provide/contract (make-project-ptree project-dir)
(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))
(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)
`(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)])
@ -203,9 +203,9 @@
(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)
`(,PTREE_ROOT_NODE "foo" "bar" (one (two "three")))))
`(,world:ptree-root-node "foo" "bar" (one (two "three")))))
(define+provide/contract (pnodes-unique?/error x)
@ -216,19 +216,19 @@
(define+provide/contract (ptree-source-decode . elements)
(() #: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)))))
(define current-ptree (make-parameter `(,PTREE_ROOT_NODE)))
(define current-url-context (make-parameter (CURRENT_PROJECT_ROOT)))
(define current-ptree (make-parameter `(,world:ptree-root-node)))
(define current-url-context (make-parameter (world:current-project-root)))
(provide current-ptree current-url-context)
;; used to convert here-path into here
(define+provide/contract (path->pnode path)
(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)))))
#|

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

@ -103,7 +103,7 @@
[(needs-template? path) (render-with-template path #:force force)]
[(ptree-source? path) (let ([ptree (cached-require path 'main)])
(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")]
[(file-exists? path) (message "Serving static file" (->string (file-name-from-path path)))])))
(for-each &render xs))
@ -193,14 +193,14 @@
(filter (λ(x) (->boolean x)) ; if any of the possibilities below are invalid, they return #f
(list
(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)])
(and (TEMPLATE_META_KEY . in? . source-metas)
(build-path source-dir (get source-metas TEMPLATE_META_KEY))))) ; path based on metas
(and (world:template-meta-key . in? . source-metas)
(build-path source-dir (get source-metas world:template-meta-key))))) ; path based on metas
(build-path source-dir
(add-ext (add-ext DEFAULT_TEMPLATE_PREFIX (get-ext (->output-path source-path))) TEMPLATE_EXT))))) ; path using default template
(let ([ft-path (build-path source-dir FALLBACK_TEMPLATE)]) ; if none of these work, make fallback template file
(copy-file (build-path (current-server-extras-path) FALLBACK_TEMPLATE) ft-path #t)
(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 world:fallback-template)]) ; if none of these work, make fallback template file
(copy-file (build-path (world:current-server-extras-path) world:fallback-template) ft-path #t)
ft-path)))
(render template-path #:force force-render) ; bc template might have its own preprocessor source
@ -222,7 +222,7 @@
(rendered-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))))
;; 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)]
[current-directory (->complete-path base-dir)]
[current-output-port (current-error-port)]
[current-ptree (make-project-ptree (CURRENT_PROJECT_ROOT))]
[current-url-context (CURRENT_PROJECT_ROOT)])
[current-ptree (make-project-ptree (world:current-project-root))]
[current-url-context (world:current-project-root)])
(for-each (λ(mod-name) (namespace-attach-module original-ns mod-name))
'(web-server/templates
xml
@ -302,14 +302,14 @@
(let ([main (cached-require ,source-name 'main)]
[metas (cached-require ,source-name 'metas)])
(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))
#|
(module+ main
(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
(string->path "/Users/mb/git/bpt/test.html.pm")
(string->path "/Users/mb/git/bpt/-test.html"))))

@ -21,7 +21,7 @@
(meta ([charset "UTF-8"]))
(link ([rel "stylesheet"]
[type "text/css"]
[href ,(format "/~a" DASHBOARD_CSS)])))
[href ,(format "/~a" world:dashboard-css)])))
(body
,content-xexpr (div ((id "pollen-logo"))))))
@ -37,7 +37,7 @@
(define client (request-client-ip req))
(define localhost-client "::1")
(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) "")))
;; pass string args to route, then
@ -48,7 +48,7 @@
(procedure? . -> . procedure?)
(λ(req . string-args)
(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))))
@ -86,7 +86,7 @@
(pathish? . -> . xexpr?)
(define path (->complete-path p))
(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))
`(div
(p "filename =" ,(->string relative-path))
@ -100,7 +100,7 @@
(define (handle-zip-path p)
(pathish? . -> . xexpr?)
(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)))
`(div
(p "filename =" ,(->string relative-path))
@ -141,7 +141,7 @@
(define (dashboard dashfile)
(define dir (get-enclosing-dir dashfile))
(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 empty-cell (cons #f #f))
(define (make-link-cell href+text)
@ -152,8 +152,8 @@
text)))))
(define (make-parent-row)
(if parent-dir
(let* ([url-to-parent-dashboard (format "/~a" (find-relative-path (CURRENT_PROJECT_ROOT) (build-path parent-dir DASHBOARD_NAME)))]
[url-to-parent (string-replace url-to-parent-dashboard 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 world:dashboard-name "")])
`(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"))))
@ -169,7 +169,7 @@
(append (list
(cond ; main cell
[(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))))]
[else (cons filename filename)])
@ -183,7 +183,7 @@
[(ptree-source? filename) empty-cell]
[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 output-paths (map ->output-path xs))
@ -219,7 +219,7 @@
(define/contract (req->path req)
(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
(define (route-default req)

@ -9,31 +9,31 @@
(define-values (pollen-servlet _)
(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) ... "out" (string-arg)) route-out]
[((string-arg) ... "xexpr" (string-arg)) route-xexpr]
[else route-default]))
(message (format "Welcome to Pollen ~a" POLLEN_VERSION) (format "(Racket ~a)" (version)))
(message (format "Project root is ~a" (CURRENT_PROJECT_ROOT)))
(message (format "Welcome to Pollen ~a" world:pollen-version) (format "(Racket ~a)" (version)))
(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 dashboard is ~a/~a" server-name DASHBOARD_NAME))
(message (format "Project dashboard is ~a/~a" server-name world:dashboard-name))
(message "Ready to rock")
(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-module-root (apply build-path (drop-right (explode-path (current-contract-region)) 1)))
(world:current-server-extras-path (build-path (world:current-module-root) "pollen-server-extras"))
(parameterize ([current-module-root (current-module-root)]
[current-server-extras-path (current-server-extras-path)]
(parameterize ([world:current-module-root (world:current-module-root)]
[world:current-server-extras-path (world:current-server-extras-path)]
[current-cache (make-cache)])
(serve/servlet pollen-servlet
#:port SERVER_PORT
#:port world:server-port
#:listen-ip #f
#:servlet-regexp #rx"" ; respond to top level
#:command-line? #t
#: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))))

@ -1,64 +1,60 @@
#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 MARKUP_SOURCE_EXT 'pm)
(define NULL_SOURCE_EXT 'px)
(define PTREE_SOURCE_EXT 'ptree)
(define DECODABLE_EXTENSIONS (list MARKUP_SOURCE_EXT PTREE_SOURCE_EXT))
(define reader-mode-auto 'auto)
(define reader-mode-preproc 'pre)
(define reader-mode-markup 'markup)
(define reader-mode-ptree 'ptree)
(define decodable-extensions (list markup-source-ext ptree-source-ext))
(define DEFAULT_PTREE "main.ptree")
(define PTREE_ROOT_NODE 'ptree-root)
(define default-ptree "main.ptree")
(define ptree-root-node 'ptree-root)
(define TEMPLATE_SOURCE_PREFIX "-")
(define EXPRESSION_DELIMITER #\◊)
(define TEMPLATE_FIELD_DELIMITER EXPRESSION_DELIMITER)
(define template-source-prefix "-")
(define expression-delimiter #\◊)
(define template-field-delimiter expression-delimiter)
(define DEFAULT_TEMPLATE_PREFIX "main")
(define TEMPLATE_EXT 'pt)
(define FALLBACK_TEMPLATE "fallback.html.pt")
(define TEMPLATE_META_KEY "template")
(define default-template-prefix "main")
(define template-ext 'pt)
(define fallback-template "fallback.html.pt")
(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 PARAGRAPH_BREAK "\n\n")
(define line-break "\n")
(define paragraph-break "\n\n")
(define OUTPUT_SUBDIR 'public)
(define output-subdir 'public)
;;(require racket/string racket/port racket/system)
;; 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 racket-path "/usr/bin/racket")
(define COMMAND_FILE "polcom")
(define command-file "polcom")
(define RESERVED_PATHS
(map string->path (list COMMAND_FILE (path->string EXTRAS_DIR) "poldash.css" "compiled")))
(define reserved-paths
(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_CSS "poldash.css")
(define dashboard-name "index.ptree")
(define dashboard-css "poldash.css")
(define current-module-root (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)

Loading…
Cancel
Save