pull/9/head
Matthew Butterick 10 years ago
parent dc3c0b482e
commit 4650b485d6

@ -8,9 +8,6 @@
(module+ test (require rackunit))
; helper functions for regenerate functions
(define pollen-project-directory (current-directory))
;; if something can be successfully coerced to a url,
;; it's urlish.
(define/contract (urlish? x)
@ -255,6 +252,6 @@
(define/contract (project-files-with-ext ext)
(symbol? . -> . (listof complete-path?))
(map ->complete-path (filter (λ(i) (has-ext? i ext)) (directory-list pollen-project-directory))))
(map ->complete-path (filter (λ(i) (has-ext? i ext)) (directory-list PROJECT_ROOT))))
;; todo: write tests for project-files-with-ext

@ -0,0 +1,4 @@
FALLBACK! <root>
hello from barino.txt.pd. Gets rendered with pollen decoder.
</root>

@ -1 +1,3 @@
hello
#lang pollen
hello from barino.txt.pd. Gets rendered with pollen decoder.

@ -0,0 +1 @@
this is world inside dong 40804

@ -0,0 +1,3 @@
#lang pollen
this is world inside dong (* 202 202)

@ -1 +1 @@
hello
hello.txt needs no rendering

@ -1 +1 @@
world 10201
world.txt.p gets rendered with preprocessor = 10201

@ -1,3 +1,3 @@
#lang pollen
world (* 101 101)
world.txt.p gets rendered with preprocessor = (* 101 101)

@ -25,12 +25,12 @@
(require 'pollen-inner) ; provides 'doc
;; reduce text to simplest represetnation: a single ouput string
(define text (apply string-append (map ->string (flatten (trim (->list doc) whitespace?)))))
(provide text (all-from-out 'pollen-inner))
;; reduce text to simplest representation: a single ouput string
(define main (apply string-append (map ->string (flatten (trim (->list doc) whitespace?)))))
(provide main (all-from-out 'pollen-inner))
(module+ main
; (displayln ";-------------------------")
; (displayln (string-append "; pollen 'text"))
; (displayln (string-append "; pollen 'main"))
; (displayln ";-------------------------")
(display text))))
(display main))))

@ -23,7 +23,7 @@
;; Try loading from ptree file, or failing that, synthesize ptree.
(define/contract (make-project-ptree [project-dir pollen-project-directory])
(define/contract (make-project-ptree [project-dir PROJECT_ROOT])
(() (directory-pathish?) . ->* . ptree?)
(define ptree-source (build-path project-dir DEFAULT_POLLEN_TREE))
(if (file-exists? ptree-source)
@ -320,7 +320,7 @@
(visible-files (->path x)))))
;; set the state variable using the setter
(set-current-url-context pollen-project-directory)
(set-current-url-context PROJECT_ROOT)
(module+ main
(displayln "Running module main")

@ -167,7 +167,7 @@
;; 4) source had to be reloaded (some other change)
source-reloaded?)
;; how we render: import 'text from preproc source file,
;; how we render: import 'main from preproc source file,
;; which is rendered during source parsing,
;; and write that to output path
(begin
@ -175,8 +175,8 @@
(file-name-from-path output-path)
(file-name-from-path source-path)))
(store-render-in-mod-dates source-path)
(let ([text (time (render-through-eval source-dir `(dynamic-require ,source-path 'text)))])
(display-to-file text output-path #:exists 'replace))
(let ([main (time (render-through-eval source-dir `(dynamic-require ,source-path 'main)))])
(display-to-file main output-path #:exists 'replace))
(rendered-message output-path))
;; otherwise, skip file because there's no trigger for render
@ -353,8 +353,8 @@
(require (planet mb/pollen/debug) (planet mb/pollen/ptree) (planet mb/pollen/template))
;; import source into eval space. This sets up main & metas
(require ,(->string source-name))
(set-current-ptree (make-project-ptree ,pollen-project-directory))
(set-current-url-context ,pollen-project-directory)
(set-current-ptree (make-project-ptree ,PROJECT_ROOT))
(set-current-url-context ,PROJECT_ROOT)
(include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name)))))

@ -55,45 +55,48 @@
;; 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 path)
(complete-path? . -> . xexpr?)
(format-as-code (slurp path #:render #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)))
;; server route that returns xexpr (before conversion to html)
(define/contract (route-xexpr path)
(complete-path? . -> . xexpr?)
(format-as-code (~v (file->xexpr path))))
(define (route-index [dir pollen-project-directory])
(define empty-cell (cons #f #f))
(define (route-dashboard dir)
(define (make-link-cell href+text)
(match-define (cons href text) href+text)
(filter-not void? `(td ,(when (and href text)
`(a ((href ,href)) ,text)))))
(define (make-path-row p)
(define pstring (->string p))
(define (file-in-dir? p) (file-exists? (apply build-path (map ->path (list dir p)))))
(define sources (filter file-in-dir? (list (->preproc-source-path pstring) (->pollen-source-path pstring))))
(define source (if (not (empty? sources)) (->string (car sources)) #f))
(define (make-path-row fn)
(define filename (->string fn))
(define (file-in-dir? fn) (file-exists? (build-path dir fn)))
(define possible-sources (filter file-in-dir? (list (->preproc-source-path filename) (->pollen-source-path filename))))
(define source (and (not (empty? possible-sources)) (->string (car possible-sources))))
`(tr ,@(map make-link-cell
(append (list
(cons pstring pstring)
(cons (format "raw/~a" pstring) "raw"))
;; folder traversal cell
(if (directory-exists? (build-path dir filename)) ; link subdirs to dashboard
(cons (format "~a/~a" filename DASHBOARD_NAME) "dash")
empty-cell)
(cons filename filename) ; main cell
(if source
(cons source (format "~a input" (get-ext source)))
empty-cell)
(cond
[(directory-exists? (build-path dir filename)) "(folder)"]
;; [(directory-exists? (build-path dir filename)) "(binary)"]
[else (cons (format "raw/~a" filename) "output")]))
(if source
(list
(cons source "source")
(cons (format "xexpr/~a" source) "xexpr")
(cons (format "~a?force=true" pstring) pstring))
(make-list 3 (cons #f #f)))))))
(cons (format "~a?force=true" filename) filename))
(make-list 2 empty-cell))))))
(define (unique-sorted-output-paths xs)
(sort (set->list (list->set (map ->output-path xs))) #:key ->string string<?))
@ -115,7 +118,7 @@
; default route
(define (route-default req)
(define request-url (request-uri req))
(define path (reroot-path (url->path request-url) pollen-project-directory))
(define path (reroot-path (url->path request-url) PROJECT_ROOT))
(define force (equal? (get-query-value request-url 'force) "true"))
(with-handlers ([exn:fail? (λ(e) (message "Render is skipping" (url->string request-url) "because of error\n" (exn-message e)))])
(render path #:force force)))

@ -3,35 +3,45 @@
(require web-server/servlet-env)
(require web-server/dispatch web-server/dispatchers/dispatch)
(require xml)
(require "server-routes.rkt" "predicates.rkt" "debug.rkt")
(require "server-routes.rkt" "debug.rkt" "readability.rkt" "world.rkt")
(define port-number 8088)
(message (format "Project directory is ~a" pollen-project-directory))
(message (format "Project root is ~a" PROJECT_ROOT))
(message (format "Project server is http://localhost:~a" port-number) "(Ctrl-C to exit)")
(define (logger req)
(define client (request-client-ip req))
(message "Request:" (url->string (request-uri req))
"from" (if (equal? client "::1")
"localhost"
client)))
(define url-string (url->string (request-uri req)))
(message "Request:" (string-replace url-string DASHBOARD_NAME " dashboard")
"from" (if (equal? client "::1") "localhost" client)))
(define/contract (route-wrapper route-proc)
(procedure? . -> . procedure?)
(λ(req string-arg)
(logger req)
(define filename string-arg)
(response/xexpr (route-proc (build-path pollen-project-directory filename)))))
(response/xexpr (route-proc (build-path PROJECT_ROOT filename)))))
(define-values (start url)
(dispatch-rules
[("pollen") (λ(req)
(logger req)
(response/xexpr (route-index)))]
[("source" (string-arg)) (route-wrapper route-source)]
;; the match patterns for each rule represent /each/slashed/piece of a url
;; (as if the url is split on slashes into a list before matching)
;; dashboard page: works on any url of form /dir/dir/dir/poldash.html
;; todo: figure out how to use world:DASHBOARD_NAME here
[((string-arg) ... "poldash.html") (λ(req . string-args)
(logger req)
(define subdirs (flatten string-args))
(define dir (apply build-path PROJECT_ROOT subdirs))
(response/xexpr (route-dashboard dir)))]
;; raw viewer: works on any url of form /dir/dir/raw/name.html
;; (pattern matcher automatically takes out the "raw")
[((string-arg) ... "raw" (string-arg)) (λ(req . string-args)
(logger req)
(define path (apply build-path PROJECT_ROOT (flatten string-args)))
(response/xexpr (route-raw path)))]
[("xexpr" (string-arg)) (route-wrapper route-xexpr)]
[("raw" (string-arg)) (route-wrapper route-raw-html)]
[("html" (string-arg)) (route-wrapper route-html)]
[else (λ(req)
;; because it's the "else" route, can't use string-arg matcher
@ -39,7 +49,7 @@
(route-default req)
(next-dispatcher))]))
(message (format "Project dashboard is http://localhost:~a/pollen" port-number))
(message (format "Project dashboard is http://localhost:~a/pollen.html" port-number))
(message "Ready to rock")
@ -48,4 +58,4 @@
#:listen-ip #f
#:servlet-regexp #rx"" ; respond to top level
#:command-line? #t
#:extra-files-paths (list (build-path pollen-project-directory)))
#:extra-files-paths (list (build-path PROJECT_ROOT)))

@ -14,7 +14,7 @@
;; list of all eligible requires in project require directory
(define/contract (get-project-require-files)
(-> (or/c (listof complete-path?) boolean?))
(define extras-directory (build-path pollen-project-directory EXTRAS_DIR))
(define extras-directory (build-path PROJECT_ROOT 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))])

@ -1,4 +1,4 @@
#lang racket/base
#lang racket
(provide (all-defined-out))
@ -55,3 +55,6 @@
(map ->path (list POLLEN_COMMAND_FILE EXTRAS_DIR)))
(define PROJECT_ROOT (current-directory))
(define DASHBOARD_NAME "poldash.html")
Loading…
Cancel
Save