From 4650b485d6368c9dccf6ce5b4bfa9863530d1cd8 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 16 Jan 2014 14:53:08 -0800 Subject: [PATCH] updates --- file-tools.rkt | 5 +--- foobar/barino.txt | 4 +++ foobar/barino.txt.pd | 4 ++- foobar/ding/dong/dongworld.txt | 1 + foobar/ding/dong/dongworld.txt.p | 3 +++ foobar/hello.txt | 2 +- foobar/world.txt | 2 +- foobar/world.txt.p | 2 +- main-preproc.rkt | 10 +++---- ptree.rkt | 4 +-- render.rkt | 10 +++---- server-routes.rkt | 45 +++++++++++++++++--------------- server.rkt | 38 +++++++++++++++++---------- tools.rkt | 2 +- world.rkt | 5 +++- 15 files changed, 80 insertions(+), 57 deletions(-) create mode 100644 foobar/barino.txt create mode 100644 foobar/ding/dong/dongworld.txt create mode 100644 foobar/ding/dong/dongworld.txt.p diff --git a/file-tools.rkt b/file-tools.rkt index d31b229..e192d59 100644 --- a/file-tools.rkt +++ b/file-tools.rkt @@ -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 diff --git a/foobar/barino.txt b/foobar/barino.txt new file mode 100644 index 0000000..5c4c441 --- /dev/null +++ b/foobar/barino.txt @@ -0,0 +1,4 @@ +FALLBACK! + +hello from barino.txt.pd. Gets rendered with pollen decoder. + \ No newline at end of file diff --git a/foobar/barino.txt.pd b/foobar/barino.txt.pd index ce01362..5207e95 100644 --- a/foobar/barino.txt.pd +++ b/foobar/barino.txt.pd @@ -1 +1,3 @@ -hello +#lang pollen + +hello from barino.txt.pd. Gets rendered with pollen decoder. diff --git a/foobar/ding/dong/dongworld.txt b/foobar/ding/dong/dongworld.txt new file mode 100644 index 0000000..9dd0d51 --- /dev/null +++ b/foobar/ding/dong/dongworld.txt @@ -0,0 +1 @@ +this is world inside dong 40804 \ No newline at end of file diff --git a/foobar/ding/dong/dongworld.txt.p b/foobar/ding/dong/dongworld.txt.p new file mode 100644 index 0000000..6537333 --- /dev/null +++ b/foobar/ding/dong/dongworld.txt.p @@ -0,0 +1,3 @@ +#lang pollen + +this is world inside dong ◊(* 202 202) \ No newline at end of file diff --git a/foobar/hello.txt b/foobar/hello.txt index ce01362..a2b2fa8 100644 --- a/foobar/hello.txt +++ b/foobar/hello.txt @@ -1 +1 @@ -hello +hello.txt needs no rendering \ No newline at end of file diff --git a/foobar/world.txt b/foobar/world.txt index 9c3a2a9..5460763 100644 --- a/foobar/world.txt +++ b/foobar/world.txt @@ -1 +1 @@ -world 10201 \ No newline at end of file +world.txt.p gets rendered with preprocessor = 10201 \ No newline at end of file diff --git a/foobar/world.txt.p b/foobar/world.txt.p index b60663c..a6de630 100644 --- a/foobar/world.txt.p +++ b/foobar/world.txt.p @@ -1,3 +1,3 @@ #lang pollen -world ◊(* 101 101) \ No newline at end of file +world.txt.p gets rendered with preprocessor = ◊(* 101 101) \ No newline at end of file diff --git a/main-preproc.rkt b/main-preproc.rkt index e0f897e..ee783e4 100644 --- a/main-preproc.rkt +++ b/main-preproc.rkt @@ -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)))) diff --git a/ptree.rkt b/ptree.rkt index 03e31f9..e940847 100644 --- a/ptree.rkt +++ b/ptree.rkt @@ -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") diff --git a/render.rkt b/render.rkt index 436e51c..b800894 100644 --- a/render.rkt +++ b/render.rkt @@ -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))))) diff --git a/server-routes.rkt b/server-routes.rkt index 7724674..17492e0 100644 --- a/server-routes.rkt +++ b/server-routes.rkt @@ -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 stringpath 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))) \ No newline at end of file diff --git a/server.rkt b/server.rkt index aa37898..4d6d69c 100755 --- a/server.rkt +++ b/server.rkt @@ -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))) \ No newline at end of file + #:extra-files-paths (list (build-path PROJECT_ROOT))) \ No newline at end of file diff --git a/tools.rkt b/tools.rkt index f3f4c3a..9fcfe04 100644 --- a/tools.rkt +++ b/tools.rkt @@ -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))]) diff --git a/world.rkt b/world.rkt index 6bc6eed..f33ba46 100644 --- a/world.rkt +++ b/world.rkt @@ -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") \ No newline at end of file