From 7209b6ae4d60e3d6efa96ab1f41770f7c2068711 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Wed, 19 Mar 2014 23:44:41 -0700
Subject: [PATCH] fixes

---
 pagetree.rkt      | 23 ++++++++++++++++++++---
 server-routes.rkt | 27 +++++++--------------------
 template.rkt      |  4 ++--
 3 files changed, 29 insertions(+), 25 deletions(-)

diff --git a/pagetree.rkt b/pagetree.rkt
index 02cc71e..c67b2f5 100644
--- a/pagetree.rkt
+++ b/pagetree.rkt
@@ -44,12 +44,29 @@
        (except [exn:fail? (λ(e) #f)])))
 
 
+(define+provide/contract (directory->pagetree dir)
+  (coerce/path? . -> . pagetree?)
+  
+  (define (unique-sorted-output-paths xs)
+    (define output-paths (map ->output-path xs))
+    (define all-paths (filter visible? (remove-duplicates output-paths)))
+    (define path-is-directory? (λ(f) (directory-exists? (build-path dir f))))
+    (define-values (subdirectories files) (partition path-is-directory? all-paths))
+    (define-values (pagetree-sources other-files) (partition pagetree-source? files))
+    (define (sort-names xs) (sort xs #:key ->string string<?))
+    ;; put subdirs in list ahead of files (so they appear at the top)
+    (append (sort-names subdirectories) (sort-names pagetree-sources) (sort-names other-files)))
+  
+  (if (directory-exists? dir )
+      (decode-pagetree (map ->symbol (unique-sorted-output-paths (directory-list dir))))
+      (error (format "directory->pagetree: directory ~a doesn't exist" dir)))) 
+
 ;; Try loading from pagetree file, or failing that, synthesize pagetree.
 (define+provide/contract (make-project-pagetree project-dir)
   (pathish? . -> . pagetree?)
-  (define pagetree-source (build-path project-dir world:default-pagetree))
-  (cached-require pagetree-source world:main-pollen-export))
-
+  (with-handlers ([exn:fail? (λ(exn) (directory->pagetree project-dir))])
+    (define pagetree-source (build-path project-dir world:default-pagetree))
+    (cached-require pagetree-source world:main-pollen-export)))
 
 (define+provide/contract (parent pnish [pt (current-pagetree)])
   (((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?)) 
diff --git a/server-routes.rkt b/server-routes.rkt
index 605dbab..1ce89f2 100644
--- a/server-routes.rkt
+++ b/server-routes.rkt
@@ -154,8 +154,8 @@
                            (explode-path (find-relative-path (world:current-project-root) dashboard-dir))
                            null)))
     (define dirlinks (cons "/" (map (λ(ps) (format "/~a/" (apply build-path ps)))  
-                                   (for/list ([i (length (cdr dirs))])
-                                     (take (cdr dirs) (add1 i))))))
+                                    (for/list ([i (length (cdr dirs))])
+                                      (take (cdr dirs) (add1 i))))))
     `(tr (th ((colspan "3")) ,@(add-between (map (λ(dir dirlink) `(a ((href ,(format "~a~a" dirlink world:default-pagetree))) ,(->string dir))) dirs dirlinks) "/"))))
   
   (define (make-path-row filename-path)
@@ -182,26 +182,13 @@
                            [(pagetree-source? filename) empty-cell]
                            [else (cons (format "out/~a" filename) "out")]))))))
   
-  (define (ineligible-path? x) (or (not (visible? x)) (member x world:paths-excluded-from-dashboard)))  
-  
-  (define (unique-sorted-output-paths xs)
-    (define output-paths (map ->output-path xs))
-    (define (unique-members xs) (set->list (list->set xs)))
-    (define all-paths (unique-members output-paths))
-    (define path-is-directory? (λ(f) (directory-exists? (build-path dashboard-dir f))))
-    (define subdirectories (filter path-is-directory? all-paths))
-    (define files (filter-not path-is-directory? all-paths))
-    (define pagetree-sources (filter pagetree-source? files))
-    (define other-files (filter-not pagetree-source? files))
-    (define (sort-names xs) (sort xs #:key ->string string<?))
-    ;; put subdirs in list ahead of files (so they appear at the top)
-    (append (sort-names subdirectories) (sort-names pagetree-sources) (sort-names other-files)))
+  (define (ineligible-path? x) (member x world:paths-excluded-from-dashboard))  
   
   (define project-paths 
-    (filter-not ineligible-path? 
-                (if (file-exists? dashboard-ptree)
-                    (map ->path (pagetree->list (cached-require (->path dashboard-ptree) world:main-pollen-export)))
-                    (unique-sorted-output-paths (directory-list dashboard-dir)))))
+    (filter-not ineligible-path? (map ->path (pagetree->list 
+                                              (if (file-exists? dashboard-ptree)
+                                                  (cached-require (->path dashboard-ptree) world:main-pollen-export)
+                                                  (directory->pagetree dashboard-dir))))))
   
   (body-wrapper
    `(table 
diff --git a/template.rkt b/template.rkt
index 4025c26..99b55b3 100644
--- a/template.rkt
+++ b/template.rkt
@@ -1,7 +1,7 @@
 #lang racket/base
 (require (for-syntax racket/base))
 (require racket/string xml xml/path sugar/define sugar/container sugar/coerce/contract)
-(require "file.rkt" txexpr "world.rkt" "cache.rkt" "pagetree.rkt")
+(require "file.rkt" txexpr "world.rkt" "cache.rkt" "pagetree.rkt" "debug.rkt")
 
 
 (require sugar/coerce/value)
@@ -10,7 +10,7 @@
 
 (define/contract+provide (metas->here metas)
   (hash? . -> . pagenode?)
-  (path->pagenode (select-from-metas 'here-path metas)))
+  (path->pagenode (report (select-from-metas 'here-path metas))))
 
 
 (define (pagenode->path pagenode)