updates

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

foobar/barino.txt

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

foobar/barino.txt.pd

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

foobar/ding/dong/dongworld.txt

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

foobar/ding/dong/dongworld.txt.p

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

foobar/hello.txt

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

foobar/world.txt

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

foobar/world.txt.p

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

main-preproc.rkt

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

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

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)))])
+        (let ([main (time (render-through-eval source-dir `(dynamic-require ,source-path 'main)))])
-          (display-to-file text output-path #:exists 'replace))
+          (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-ptree (make-project-ptree ,PROJECT_ROOT))
-                          (set-current-url-context ,pollen-project-directory)
+                          (set-current-url-context ,PROJECT_ROOT)
                           (include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name)))))
 
 

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 empty-cell (cons #f #f))
-(define (route-index [dir pollen-project-directory])
+(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 (make-path-row fn)
-    (define pstring (->string p))
+    (define filename (->string fn))
-    (define (file-in-dir? p) (file-exists? (apply build-path (map ->path (list dir p)))))
+    (define (file-in-dir? fn) (file-exists? (build-path dir fn)))
-    (define sources (filter file-in-dir? (list (->preproc-source-path pstring) (->pollen-source-path pstring))))
+    (define possible-sources (filter file-in-dir? (list (->preproc-source-path filename) (->pollen-source-path filename))))
-    (define source (if (not (empty? sources)) (->string (car sources)) #f))
+    (define source (and (not (empty? possible-sources)) (->string (car possible-sources))))
     `(tr ,@(map make-link-cell 
                 (append (list 
-                         (cons pstring pstring) 
+                         ;; folder traversal cell
-                         (cons (format "raw/~a" pstring) "raw"))
+                         (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))
+                             (cons (format "~a?force=true" filename) filename))
-                            (make-list 3 (cons #f #f)))))))
+                            (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)))

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)) 
+  (define url-string (url->string (request-uri req)))
-           "from" (if (equal? client "::1")
+  (message "Request:" (string-replace url-string DASHBOARD_NAME " dashboard")
-                      "localhost" 
+           "from" (if (equal? client "::1") "localhost" client)))
-                      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) 
+   ;; 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) 
-                (response/xexpr (route-index)))]
+                                        (define subdirs (flatten string-args))
-   [("source" (string-arg)) (route-wrapper route-source)]
+                                        (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)))

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

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