improvements

cache.rkt

@@ -34,7 +34,7 @@
   (when (not (current-cache)) (error "cached-require: No cache set up."))
   
   (define path 
-    (with-handlers ([exn:fail? (λ(exn) (displayln (format "cached-require: ~a is not a valid path" path-string)))])
+    (with-handlers ([exn:fail? (λ(exn) (error (format "cached-require: ~a is not a valid path" path-string)))])
       (->complete-path path-string)))  
   
   (when (or (not (cache-has-key? path))

file.rkt

@@ -43,6 +43,7 @@
      (let ([stem-datum (syntax->datum #'stem)])
        (with-syntax ([file-ext (format-id stx "world:~a-source-ext" #'stem)]
                      [stem-source? (format-id stx "~a-source?" #'stem)]
+                     [get-stem-source (format-id stx "get-~a-source" #'stem)]
                      [has-stem-source? (format-id stx "has-~a-source?" #'stem)]
                      [has/is-stem-source? (format-id stx "has/is-~a-source?" #'stem)]
                      [->stem-source-path (format-id stx "->~a-source-path" #'stem)]
@@ -52,9 +53,14 @@
              (define+provide (stem-source? x)
                (->boolean (and (pathish? x) (has-ext? (->path x) file-ext))))
              
+             (define+provide (get-stem-source x)
+               (and (pathish? x) 
+                    (let ([source-path (->stem-source-path (->path x))])
+                      (and source-path (file-exists? source-path) source-path))))
+             
              ;; does the source-ified version of the file exist
              (define+provide (has-stem-source? x)
-               (->boolean (and (pathish? x) (file-exists? (->stem-source-path (->path x))))))
+               (->boolean (get-stem-source x)))
              
              ;; it's a file-ext source file, or a file that's the result of a file-ext source
              (define+provide (has/is-stem-source? x)
@@ -62,12 +68,15 @@
              
              ;; add the file extension if it's not there
              (define+provide/contract (->stem-source-path x)
-               (pathish? . -> . path?)
-               (->path (if (stem-source? x) 
-                           x 
-                           #,(if (equal? stem-datum 'scribble)
-                                 #'(add-ext (remove-all-ext x) file-ext) ; different logic for scribble sources
-                                 #'(add-ext x file-ext)))))
+               (pathish? . -> . (or/c #f path?))
+               (define result (if (stem-source? x) 
+                                  x 
+                                  #,(if (equal? stem-datum 'scribble)
+                                        #'(if (x . has-ext? . 'html) ; different logic for scribble sources
+                                              (add-ext (remove-all-ext x) file-ext)
+                                              #f)
+                                        #'(add-ext x file-ext))))
+               (and result (->path result)))
              
              ;; coerce either a source or output file to both
              (define+provide/contract (->stem-source+output-paths path)
@@ -84,15 +93,9 @@
 (make-source-utility-functions scribble)
 
 
-;; todo: use has-source? for this
 (define/contract+provide (->source-path path)
-  (coerce/path? . -> . path?)
-  (define possible-sources 
-    (if (directory-exists? path)
-        null
-        (filter file-exists? (map (λ(proc) (proc path)) (list ->preproc-source-path ->markup-source-path ->null-source-path ->scribble-source-path)))))
-    (if (null? possible-sources) path (car possible-sources)))
-
+  (coerce/path? . -> . (or/c #f path?))
+  (ormap (λ(proc) (proc path)) (list get-markup-source get-preproc-source get-null-source get-scribble-source)))
 
 (define+provide/contract (->output-path x)
   (coerce/path? . -> . coerce/path?)

project-requires.rkt

@@ -9,7 +9,7 @@
 
 
 (define+provide/contract (require+provide-project-require-files here-path #:provide [provide #t])
-  (coerce/path? . -> . list?)
+  (coerce/path? . -> . (or/c list? void?))
   (define (put-file-in-require-form file)
     `(file ,(path->string file)))
   (define project-require-files (get-project-require-files here-path))
@@ -21,7 +21,7 @@
            ,@(if provide
                  (list `(provide (all-from-out ,@files-in-require-form)))
                  '())))
-      (void)))
+      '(begin)))
 
 
 (define+provide (require-project-require-files here-path)

render.rkt

@@ -166,7 +166,7 @@
          (local-require pollen/pagemap pollen/template pollen/top)
          (include-template #:command-char ,world:template-field-delimiter ,(->string (find-relative-path source-dir template-path))))))
   
-  (time (parameterize ([current-directory source-dir])
+  (time (parameterize ([current-directory source-dir]) ; because include-template wants to work relative to source location
           (render-through-eval expr-to-eval))))
 
 

server-routes.rkt

@@ -138,11 +138,11 @@
 
 
 ;; dashboard route
-(define (dashboard dashfile)
-  (define dir (get-enclosing-dir dashfile))
+(define (dashboard dashboard-pmap)
+  (define dashboard-dir (get-enclosing-dir dashboard-pmap))
   (define (in-project-root?)
-    (directories-equal? dir (world:current-project-root)))
-  (define parent-dir (and (not (in-project-root?)) (get-enclosing-dir dir)))
+    (directories-equal? dashboard-dir (world:current-project-root)))
+  (define parent-dir (and (not (in-project-root?)) (get-enclosing-dir dashboard-dir)))
   (define empty-cell (cons #f #f))
   (define (make-link-cell href+text)
     (match-define (cons href text) href+text) 
@@ -157,13 +157,14 @@
           `(tr (th ((colspan "3")) (a ((href ,url-to-parent-dashboard)) ,(format "up to ~a" url-to-parent))))) 
         `(tr (th ((colspan "3")(class "root")) "Pollen root"))))
   
-  (define (make-path-row fn)
-    (define filename (->string fn))
-    (define source (->string (->source-path fn)))
+  (define (make-path-row filename-path)
+    (define filename (->string filename-path))
+    (define possible-source (->source-path (build-path dashboard-dir filename-path)))
+    (define source (and possible-source (->string possible-source)))
     `(tr ,@(map make-link-cell 
                 (append (list                          
                          (cond ; main cell
-                           [(directory-exists? (build-path dir filename)) ; links subdir to its dashboard
+                           [(directory-exists? (build-path dashboard-dir filename)) ; links subdir to its dashboard
                             (cons (format "~a/~a" filename world:dashboard-name) (format "~a/" filename))]
                            [(and source (equal? (get-ext source) "scrbl")) 
                             (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) " (from " ,source ")")))]
@@ -176,7 +177,7 @@
                            [else empty-cell])
                          
                          (cond ; out cell 
-                           [(directory-exists? (build-path dir filename)) (cons #f #f)]
+                           [(directory-exists? (build-path dashboard-dir filename)) (cons #f #f)]
                            [(pagemap-source? filename) empty-cell]
                            [else (cons (format "out/~a" filename) "out")]))))))
   
@@ -186,7 +187,7 @@
     (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 dir f))))
+    (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 pagemap-sources (filter pagemap-source? files))
@@ -195,9 +196,11 @@
     ;; put subdirs in list ahead of files (so they appear at the top)
     (append (sort-names subdirectories) (sort-names pagemap-sources) (sort-names other-files)))
   
-  (define project-paths (filter-not ineligible-path? (if (file-exists? dashfile)
-                                                         (map ->path (pagemap->list (cached-require (->path dashfile) world:main-pollen-export)))
-                                                         (unique-sorted-output-paths (directory-list dir)))))
+  (define project-paths 
+    (filter-not ineligible-path? 
+                (if (file-exists? dashboard-pmap)
+                    (map ->path (pagemap->list (cached-require (->path dashboard-pmap) world:main-pollen-export)))
+                    (unique-sorted-output-paths (directory-list dashboard-dir)))))
   
   (body-wrapper
    `(table 

template.rkt

@@ -9,30 +9,37 @@
 
 
 (define/contract+provide (get-doc x)
-  (coerce/path? . -> . txexpr?)
-  (cached-require (->source-path x) world:main-pollen-export))
+  (coerce/path? . -> . (or/c #f txexpr? string?))
+  (define source-path (->source-path x))
+  (if source-path
+      (cached-require source-path world:main-pollen-export)
+      (error (format "get-doc: no source found for '~a' in directory ~a" x (current-directory)))))
 
 
 (define/contract+provide (get-metas x)
   (coerce/path? . -> . hash?)
-  (cached-require (->source-path x) world:meta-pollen-export))
+  (define source-path (->source-path x))
+  (if source-path
+      (cached-require source-path world:meta-pollen-export)
+      (error (format "get-doc: no source found for '~a' in directory ~a" x (current-directory)))))
 
 
-(define/contract+provide (find query . xs)
-  ((coerce/symbol?) #:rest (listof (or/c #f hash? txexpr? pathish?)) . ->* . (or/c #f txexpr-element?))
-  (define result (apply find* query xs))
-  (or (null? result) (car result)))
+(define/contract+provide (from-node query node)
+  (coerce/symbol? coerce/symbol? . -> . (or/c #f txexpr-element?))
+  (define node-path (build-path (world:current-project-root) (->string node)))
+  (define result (append (find-in-metas query node-path) (find-in-doc query node-path)))
+  (if (null? result) #f (car result)))
 
 
-(define/contract+provide (find* query . pxs)
-  ((coerce/symbol?) #:rest (listof (or/c #f hash? txexpr? pathish?)) . ->* . (or/c #f txexpr-elements?))
+(define/contract+provide (find* query . nodes)
+  ((coerce/symbol?) #:rest (listof symbol?) . ->* . (or/c #f txexpr-elements?))
   (define (finder x)
     (cond
       [(hash? x) (find-in-metas query x)]
       [(txexpr? x) (find-in-doc query x)]
       [(pathish? x) (find* query (get-doc x) (get-metas x))]
       [else null]))
-  (append-map finder pxs))
+  (append-map finder nodes))
 
 
 (define/contract+provide (find-in-metas query hash-or-path)
@@ -65,8 +72,8 @@
 
 
 (define+provide/contract (->html x)
-  (txexpr? . -> . string?)
-  (txexpr->html x))
+  (xexpr? . -> . string?)  
+  (xexpr->html x))
 
 
 (provide when/block)
@@ -74,7 +81,11 @@
   (syntax-case stx ()
     [(_ condition body ...)
      #'(if condition (string-append* 
-                      (with-handlers ([exn:fail? (λ(exn) (error (format "when/block: ~a" (exn-message exn))))])
-                        (map ->string (list body ...)))) ; todo: should this be ->html not ->string?
+                      (with-handlers ([exn:fail? (λ(exn) (error (format "within when/block, ~a" (exn-message exn))))])
+                        (map ->string (list body ...)))) 
            "")]))
 
+
+(module+ main
+  (parameterize ([current-directory (string->path "/Users/MB/git/bpt/down/")])
+    (get-doc "introduction.html")))