From 5c7777ab6a6c3c033e001a84743a1568876f14e2 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Fri, 30 Aug 2013 17:36:06 -0700
Subject: [PATCH] working on server + server routes

---
 pollen-file-tools.rkt        |  27 ++++++++
 server-routes.rkt            | 121 +++++++++++++++++++++++------------
 server.rkt                   |   5 +-
 tests/favicon.ico            |   1 +
 tests/server-routes/bar.html |   1 +
 tests/server-routes/foo.html |   2 +
 tests/server-routes/foo.p    |   2 +
 tests/test-requirer.p        |   1 -
 world.rkt                    |   2 +-
 9 files changed, 116 insertions(+), 46 deletions(-)
 create mode 100644 tests/favicon.ico
 create mode 100644 tests/server-routes/bar.html
 create mode 100644 tests/server-routes/foo.html
 create mode 100644 tests/server-routes/foo.p
 delete mode 100644 tests/test-requirer.p

diff --git a/pollen-file-tools.rkt b/pollen-file-tools.rkt
index 230a8a4..7911c64 100644
--- a/pollen-file-tools.rkt
+++ b/pollen-file-tools.rkt
@@ -90,10 +90,16 @@
  (check-equal? (filename-of (build-path (current-directory) "pollen-file-tools.rkt")) (->path "pollen-file-tools.rkt")))|#
 
 
+;; todo: tests for these predicates
+
 (define/contract (preproc-source? x)
   (any/c . -> . boolean?)
   (has-ext? (->path x) POLLEN_PREPROC_EXT))
 
+(module+ test
+  (check-true (preproc-source? "foo.pp"))
+  (check-false (preproc-source? "foo.bar")))
+
 (define/contract (has-preproc-source? x)
   (any/c . -> . boolean?)
   (file-exists? (make-preproc-source-path (->path x))))
@@ -117,10 +123,31 @@
   (any/c . -> . boolean?)
   (has-ext? (->path x) POLLEN_MAP_EXT))
 
+(module+ test
+  (check-true (pmap-source? "foo.pmap"))
+  (check-false (pmap-source? "pmap.bar")))
+
+
 (define/contract (pollen-source? x)
   (any/c . -> . boolean?)
   (has-ext? (->path x) POLLEN_SOURCE_EXT))
 
+(module+ test
+  (check-true (pollen-source? "foo.p"))
+  (check-false (pollen-source? "foo.pp")))
+
+
+(define/contract (template-source? x)
+  (any/c . -> . boolean?)
+  (define-values (dir name ignore) (split-path x))
+  (equal? (get (->string name) 0) TEMPLATE_FILE_PREFIX))
+
+(module+ test
+  (check-true (template-source? "-foo.html"))
+  (check-false (template-source? "foo.html")))
+
+
+
 ;; this is for regenerate module.
 ;; when we want to be friendly with inputs for functions that require a path.
 ;; Strings & symbols often result from xexpr parsing
diff --git a/server-routes.rkt b/server-routes.rkt
index 0cc6b56..709d4c6 100644
--- a/server-routes.rkt
+++ b/server-routes.rkt
@@ -1,5 +1,5 @@
 #lang racket/base
-(require racket/list racket/contract racket/rerequire racket/file racket/format)
+(require racket/list racket/contract racket/rerequire racket/file racket/format xml)
 (require (only-in net/url url-query url->path))
 (require (only-in web-server/http/request-structs request-uri))
 (require "world.rkt" "regenerate.rkt" "readability.rkt" "predicates.rkt")
@@ -12,61 +12,98 @@
 
 (provide (all-defined-out))
 
-
-(define/contract (file->xexpr path)
-  (complete-path? . -> . tagged-xexpr?)
-  (regenerate path)
-  (dynamic-rerequire path)
+;; extract main xexpr from a path
+(define/contract (file->xexpr path #:regen [regen #t])
+  ((complete-path?) (#:regen boolean?) . ->* . tagged-xexpr?)
+  (when regen (regenerate path)) ; refresh path 
+  (dynamic-rerequire path) ; stores module mod date; reloads if it's changed
   (dynamic-require path 'main))
 
+(module+ test
+  (check-equal? (file->xexpr (build-path (current-directory) "tests/server-routes/foo.p") #:regen #f) '(root "\n" "foo")))
 
-(define/contract (slurp path #:regenerate? [regenerate? #t])
-  (complete-path? . -> . string?) 
-  (when regenerate? (regenerate path))
+;; read contents of file to string
+;; just file->string with a regenerate option
+(define/contract (slurp path #:regen [regen #t])
+  ((complete-path?) (#:regen boolean?) . ->* . string?) 
+  (when regen (regenerate path))
   (file->string path))
 
-(define/contract (format-as-code tx)
-  (tagged-xexpr? . -> . tagged-xexpr?)
-  `(div ((style "white-space:pre-wrap;font-family:AlixFB,monospaced")) ,tx))
+(module+ test
+  (check-equal? (slurp (build-path (current-directory) "tests/server-routes/bar.html") #:regen #f) "<html><body><p>bar</p></body></html>"))
+
+
+;; add a wrapper to tagged-xexpr that displays it as monospaced text
+;; for "view source"ish functions
+;; takes either a string or an xexpr
+(define/contract (format-as-code x)
+  (xexpr? . -> . tagged-xexpr?)
+  `(div ((style "white-space:pre-wrap;font-family:AlixFB,monospaced")) ,x))
+
+(module+ test
+  (check-equal? (format-as-code '(p "foo")) '(div ((style "white-space:pre-wrap;font-family:AlixFB,monospaced")) (p "foo"))))
 
+;; server routes
+;; these all produce an xexpr, which is handled upstream by (response/xexpr x)
 
+;; server route that returns html
+;; todo: what is this for?
 (define/contract (route-html path)
-  (complete-path? . -> . tagged-xexpr?)
+  (complete-path? . -> . xexpr?)
   (file->xexpr path))
 
+;; server route that returns raw html, formatted as code
+;; for viewing source without using "view source"
 (define/contract (route-raw-html path)
-  (complete-path? . -> . tagged-xexpr?)
+  (complete-path? . -> . xexpr?)
+  (format-as-code (slurp path #:regen #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? . -> . tagged-xexpr?)
+  (complete-path? . -> . xexpr?)
   (format-as-code (~v (file->xexpr path))))
 
-(define/contract (route-source path)
-  (complete-path? . -> . tagged-xexpr?)
-  (format-as-code (slurp path #:regenerate? #f)))
 
 
 (define/contract (route-index pollen-file-root)   
-  ((and/c path? complete-path?) . -> . tagged-xexpr?)
-  ; set up filter functions by mapping a function-maker for each file type
-  (define-values (pollen-file? preproc-file? pmap-file?)
-    (apply values (map (λ(ext)(λ(f)(has-ext? f ext))) (list POLLEN_SOURCE_EXT POLLEN_PREPROC_EXT POLLEN_MAP_EXT))))
-  (define (template-file? x)
-    (define-values (dir name ignore) (split-path x))
-    (equal? (get (->string name) 0) TEMPLATE_FILE_PREFIX))
-  ; get lists of files by mapping a filter function for each file type
+  (complete-path? . -> . xexpr?)
+  
+  ;; This function generates the Pollen dashboard.
+  ;; First, generate some lists of files.
+  
+  ;; get lists of files by mapping a filter function for each file type
   (define-values (pollen-files preproc-files pmap-files template-files)
-    (apply values (map (λ(test) (filter test (directory-list pollen-file-root))) (list pollen-file? preproc-file? pmap-file? template-file?))))
-  ; the actual post-p files may not have been generated yet
+    (let ([all-files-in-project-directory (directory-list pollen-file-root)])
+      (apply values 
+             (map (λ(test) (filter test all-files-in-project-directory)) 
+                  (list pollen-source? preproc-source? pmap-source? template-source?)))))
+  
+  ;; The actual post-preproc files may not have been generated yet
+  ;; so calculate their names (rather than rely on directory list)
   (define post-preproc-files (map (λ(path) (remove-ext path)) preproc-files))
-  ; make a combined list of p-files and post-p files
-  (define all-preproc-files (sort (append preproc-files post-preproc-files) #:key path->string string<?))
   
+  ;; Make a combined list of preproc files and post-preproc file, in alphabetical order
+  (define all-preproc-files (sort (append preproc-files post-preproc-files) 
+                                  #:key path->string string<?))
+  
+  ;; calculate names of post-pollen files
+  ;; todo: this isn't quite right. Assumes post-pollen file will have html extension.
+  ;; not necessarily true (it will assume the extension of its template.)
+  ;; But pulling out all the template extensions requires parsing all the files,
+  ;; which is slow and superfluous, since we're trying to be lazy about rendering.
   (define post-pollen-files (map (λ(path) (add-ext (remove-ext path) 'html)) pollen-files))
-  (define all-pollen-files (sort (append pollen-files post-pollen-files) #:key path->string string<?))
   
+  ;; Make a combined list of pollen files and post-pollen files, in alphabetical order
+  (define all-pollen-files (sort (append pollen-files post-pollen-files) #:key path->string string<?))
   
+  ;; Utility function for making file rows
   (define (make-file-row file routes)
     (define (make-link-cell type)
       (letrec ([source (add-ext (remove-ext file) POLLEN_SOURCE_EXT)]
@@ -86,18 +123,18 @@
     `(tr ,(make-link-cell 'direct) ,@(map make-link-cell routes)))
   
   (if (andmap empty? (list pmap-files all-pollen-files all-preproc-files template-files))
-       '(body "No files yet. Get to work!")
+      '(body "No files yet. Get to work!")
       `(body 
-         (style ((type "text/css")) "td a { display: block; width: 100%; height: 100%; padding: 8px; }"
-                "td:hover {background: #eee}")
-         (table ((style "font-family:Concourse T3;font-size:115%"))
-                ; options for pmap files and template files
-                ,@(map (λ(file) (make-file-row file '(raw))) (append pmap-files template-files))
-                ; options for pollen files
-                ,@(map (λ(file) (make-file-row file '(raw source xexpr force))) post-pollen-files)
-                ; options for preproc files
-                ; branching in λ is needed so these files can be interleaved on the list
-                ,@(map (λ(file) (make-file-row file '(raw preproc-source))) post-preproc-files)))))
+        (style ((type "text/css")) "td a { display: block; width: 100%; height: 100%; padding: 8px; }"
+               "td:hover {background: #eee}")
+        (table ((style "font-family:Concourse T3;font-size:115%"))
+               ; options for pmap files and template files
+               ,@(map (λ(file) (make-file-row file '(raw))) (append pmap-files template-files))
+               ; options for pollen files
+               ,@(map (λ(file) (make-file-row file '(raw source xexpr force))) post-pollen-files)
+               ; options for preproc files
+               ; branching in λ is needed so these files can be interleaved on the list
+               ,@(map (λ(file) (make-file-row file '(raw preproc-source))) post-preproc-files)))))
 
 
 (define (get-query-value url key)
diff --git a/server.rkt b/server.rkt
index 7400757..141a87c 100755
--- a/server.rkt
+++ b/server.rkt
@@ -2,13 +2,14 @@
 #lang web-server
 (require web-server/servlet-env)
 (require web-server/dispatch web-server/dispatchers/dispatch)
+(require xml)
 (require "server-routes.rkt" "predicates.rkt")
 
 (displayln "Pollen server starting...")
 
 (define/contract (route-wrapper route-proc)
   ;; todo: make better contract for return value
-  ((complete-path? . -> . tagged-xexpr?) . -> . procedure?)
+  (procedure? . -> . procedure?)
   (λ(req string-arg) 
     (define filename string-arg)
     (response/xexpr (route-proc (build-path pollen-file-root filename)))))
@@ -25,7 +26,7 @@
             ;; so extract the path manually
             (define req-uri (request-uri req))
             (define path (reroot-path (url->path req-uri) pollen-file-root))
-            (define force (get-query-value req-uri 'force))
+            (define force (equal? (get-query-value req-uri 'force) "true"))
             (route-preproc path #:force force)
             (next-dispatcher))]))
 
diff --git a/tests/favicon.ico b/tests/favicon.ico
new file mode 100644
index 0000000..8b13789
--- /dev/null
+++ b/tests/favicon.ico
@@ -0,0 +1 @@
+
diff --git a/tests/server-routes/bar.html b/tests/server-routes/bar.html
new file mode 100644
index 0000000..9a6a8d8
--- /dev/null
+++ b/tests/server-routes/bar.html
@@ -0,0 +1 @@
+<html><body><p>bar</p></body></html>
\ No newline at end of file
diff --git a/tests/server-routes/foo.html b/tests/server-routes/foo.html
new file mode 100644
index 0000000..bb742b4
--- /dev/null
+++ b/tests/server-routes/foo.html
@@ -0,0 +1,2 @@
+FALLBACK! put-as-htmlroot
+                     foo
\ No newline at end of file
diff --git a/tests/server-routes/foo.p b/tests/server-routes/foo.p
new file mode 100644
index 0000000..8b98967
--- /dev/null
+++ b/tests/server-routes/foo.p
@@ -0,0 +1,2 @@
+#lang planet mb/pollen
+foo
\ No newline at end of file
diff --git a/tests/test-requirer.p b/tests/test-requirer.p
deleted file mode 100644
index 7bc35af..0000000
--- a/tests/test-requirer.p
+++ /dev/null
@@ -1 +0,0 @@
-#lang racket/base
diff --git a/world.rkt b/world.rkt
index a86130d..d9a42bf 100644
--- a/world.rkt
+++ b/world.rkt
@@ -2,7 +2,7 @@
 
 (define POLLEN_PREPROC_EXT 'pp)
 (define POLLEN_SOURCE_EXT 'p)
-(define TEMPLATE_FILE_PREFIX #\-)
+(define TEMPLATE_FILE_PREFIX "-")
 (define POLLEN_EXPRESSION_DELIMITER #\◊)
 (define TEMPLATE_FIELD_DELIMITER POLLEN_EXPRESSION_DELIMITER)