simplify messages

pollen/private/project-server-routes.rkt

@@ -61,11 +61,11 @@
   (define client (request-client-ip req))
   (define localhost-client "::1")
   (define url-string (url->string (request-uri req)))
-  (when (not (ends-with? url-string "favicon.ico"))
-    (message "request:" (if (regexp-match #rx"/$" url-string)
-                            (string-append url-string " directory default page")
-                            (string-replace url-string (setup:main-pagetree) " dashboard"))
-             (if (not (equal? client localhost-client)) (format "from ~a" client) ""))))
+  (unless (ends-with? url-string "favicon.ico")
+    (message (if (regexp-match #rx"/$" url-string)
+                           (string-append url-string " directory default page")
+                           (string-replace url-string (setup:main-pagetree) " dashboard"))
+             (if (not (equal? client localhost-client)) (format "from ~a" client) "")))
 
 ;; pass string args to route, then
 ;; package route into right format for web server
@@ -164,9 +164,9 @@
   (define (make-link-cell href+text)
     (match-define (cons href text) href+text) 
     (filter-not void? `(cell ,(when text 
-                              (if href 
-                                  `(a ((href ,href)) ,text)
-                                  text)))))
+                                (if href 
+                                    `(a ((href ,href)) ,text)
+                                    text)))))
   
   (define (make-parent-row)
     (define title (string-append "Project root" (if (equal? (current-project-root) dashboard-dir) (format " = ~a" dashboard-dir) "")))
@@ -180,51 +180,51 @@
   
   (define (make-path-row filename source indent-level)
     `(row ,@(map make-link-cell 
-                (append (list                          
-                         (let ([main-cell (cond ; main cell
-                                            [(directory-exists? (build-path dashboard-dir filename)) ; links subdir to its dashboard
-                                             (cons (format "~a/~a" filename (setup:main-pagetree)) (format "~a/" filename))]
-                                            [(and source (equal? (get-ext source) "scrbl")) ; scribble source
-                                             (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) " (from " ,(->string (find-relative-path dashboard-dir source)) ")")))]
-                                            [source ; ordinary source. use remove-ext because source may have escaped extension in it
-                                             (define source-first-ext (get-ext source))
-                                             (define source-minus-ext (unescape-ext (remove-ext source)))
-                                             (define source-second-ext (get-ext source-minus-ext))
-                                             (cond ; multi source. expand to multiple output files.
-                                               [(and source-second-ext (equal? source-second-ext (->string (setup:poly-source-ext (->complete-path source)))))
-                                                (define source-base (remove-ext source-minus-ext))
-                                                (define output-names (map (λ (ext) (->string (add-ext source-base ext))) (setup:poly-targets (->complete-path source))))
-                                                (cons #f `(div ,@(map (λ (on) `(a ((href ,on)) ,on (span ((class "file-ext")) "." ,source-first-ext ,(format " (from ~a)" (->string (find-relative-path dashboard-dir source)))))) output-names)))]
-                                               [else
-                                                (define extra-row-string
-                                                  (if (equal? source-minus-ext (remove-ext source)) ; escaped and unescaped versions are equal
-                                                      "" ; no extra string needed
-                                                      (format " (from ~a)" (->string (find-relative-path dashboard-dir source)))))
-                                                
-                                                (cons #f `(a ((href ,filename)) ,(->string source-minus-ext) (span ((class "file-ext")) "." ,source-first-ext ,extra-row-string)))])]
-                                            [else ; other non-source file
-                                             (cons filename filename)])])
-                           
-                           (cons (car main-cell)
-                                 (let* ([cell-content (cdr main-cell)]
-                                       [indent-padding (+ 1 indent-level)]
-                                       [padding-attr `(class ,(format "indent_~a" indent-padding))])
-                                   (cond
-                                     [(string? cell-content) `(span (,padding-attr) ,cell-content)]
-                                     [(txexpr? cell-content)
-                                      ;; indent link text by depth in pagetree
-                                      `(,(get-tag cell-content) ,(cons padding-attr (get-attrs cell-content)) ,@(get-elements cell-content))]
-                                     [else (error 'make-path-row (format "mysterious cell data: ~v" cell-content))]))))
-                         
-                         (cond ; 'in' cell
-                           [source  (cons (format "in/~a" source) "in")]
-                           [(or (pagetree-source? filename) (sourceish? filename))  (cons (format "in/~a" filename) "in")]
-                           [else empty-cell])
-                         
-                         (cond ; 'out' cell 
-                           [(directory-exists? (build-path dashboard-dir filename)) (cons #f #f)]
-                           [(pagetree-source? filename) empty-cell]
-                           [else (cons (format "out/~a" filename) "out")]))))))
+                 (append (list                          
+                          (let ([main-cell (cond ; main cell
+                                             [(directory-exists? (build-path dashboard-dir filename)) ; links subdir to its dashboard
+                                              (cons (format "~a/~a" filename (setup:main-pagetree)) (format "~a/" filename))]
+                                             [(and source (equal? (get-ext source) "scrbl")) ; scribble source
+                                              (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) " (from " ,(->string (find-relative-path dashboard-dir source)) ")")))]
+                                             [source ; ordinary source. use remove-ext because source may have escaped extension in it
+                                              (define source-first-ext (get-ext source))
+                                              (define source-minus-ext (unescape-ext (remove-ext source)))
+                                              (define source-second-ext (get-ext source-minus-ext))
+                                              (cond ; multi source. expand to multiple output files.
+                                                [(and source-second-ext (equal? source-second-ext (->string (setup:poly-source-ext (->complete-path source)))))
+                                                 (define source-base (remove-ext source-minus-ext))
+                                                 (define output-names (map (λ (ext) (->string (add-ext source-base ext))) (setup:poly-targets (->complete-path source))))
+                                                 (cons #f `(div ,@(map (λ (on) `(a ((href ,on)) ,on (span ((class "file-ext")) "." ,source-first-ext ,(format " (from ~a)" (->string (find-relative-path dashboard-dir source)))))) output-names)))]
+                                                [else
+                                                 (define extra-row-string
+                                                   (if (equal? source-minus-ext (remove-ext source)) ; escaped and unescaped versions are equal
+                                                       "" ; no extra string needed
+                                                       (format " (from ~a)" (->string (find-relative-path dashboard-dir source)))))
+                                                
+                                                 (cons #f `(a ((href ,filename)) ,(->string source-minus-ext) (span ((class "file-ext")) "." ,source-first-ext ,extra-row-string)))])]
+                                             [else ; other non-source file
+                                              (cons filename filename)])])
+                           
+                            (cons (car main-cell)
+                                  (let* ([cell-content (cdr main-cell)]
+                                         [indent-padding (+ 1 indent-level)]
+                                         [padding-attr `(class ,(format "indent_~a" indent-padding))])
+                                    (cond
+                                      [(string? cell-content) `(span (,padding-attr) ,cell-content)]
+                                      [(txexpr? cell-content)
+                                       ;; indent link text by depth in pagetree
+                                       `(,(get-tag cell-content) ,(cons padding-attr (get-attrs cell-content)) ,@(get-elements cell-content))]
+                                      [else (error 'make-path-row (format "mysterious cell data: ~v" cell-content))]))))
+                         
+                          (cond ; 'in' cell
+                            [source  (cons (format "in/~a" source) "in")]
+                            [(or (pagetree-source? filename) (sourceish? filename))  (cons (format "in/~a" filename) "in")]
+                            [else empty-cell])
+                         
+                          (cond ; 'out' cell 
+                            [(directory-exists? (build-path dashboard-dir filename)) (cons #f #f)]
+                            [(pagetree-source? filename) empty-cell]
+                            [else (cons (format "out/~a" filename) "out")]))))))
   
   (define (ineligible-path? x) (member x (setup:paths-excluded-from-dashboard)))
   
@@ -241,32 +241,32 @@
           depth)))
   
   (apply body-wrapper #:title (format "~a" dashboard-dir)
-                (cons (make-parent-row) 
-                          (cond
-                            [(not (null? project-paths))
-                             (define path-source-pairs
-                               (map
-                                (λ (p) (define source
-                                        (let ([possible-source (get-source (build-path dashboard-dir p))])
-                                          (and possible-source (->string (find-relative-path dashboard-dir possible-source)))))
-                                  (cons p source))
-                                project-paths))
-                             
-                             (define-values (reversed-unique-path-source-pairs seen-paths) ; delete pairs with duplicate sources
-                               (for/fold ([psps empty][seen-source-paths empty])
-                                         ([psp (in-list path-source-pairs)])
-                                 (define source-path (cdr psp))
-                                 (if (and source-path (member source-path seen-source-paths))
-                                     (values psps seen-source-paths) ; skip the pair
-                                     (values (cons psp psps) (cons source-path seen-source-paths)))))
-                             
-                             (define unique-path-source-pairs (reverse reversed-unique-path-source-pairs))
-                             (define filenames (map (compose1 ->string car) unique-path-source-pairs))
-                             (define sources (map cdr unique-path-source-pairs))
-                             (define indent-levels (map directory-pagetree-depth filenames))
-                             (parameterize ([current-directory dashboard-dir])
-                               (map make-path-row filenames sources indent-levels))]
-                            [else (list '(row (cell ((class "no-files")) "No files yet in this directory") (td) (td)))]))))
+         (cons (make-parent-row) 
+               (cond
+                 [(not (null? project-paths))
+                  (define path-source-pairs
+                    (map
+                     (λ (p) (define source
+                              (let ([possible-source (get-source (build-path dashboard-dir p))])
+                                (and possible-source (->string (find-relative-path dashboard-dir possible-source)))))
+                       (cons p source))
+                     project-paths))
+                             
+                  (define-values (reversed-unique-path-source-pairs seen-paths) ; delete pairs with duplicate sources
+                    (for/fold ([psps empty][seen-source-paths empty])
+                              ([psp (in-list path-source-pairs)])
+                      (define source-path (cdr psp))
+                      (if (and source-path (member source-path seen-source-paths))
+                          (values psps seen-source-paths) ; skip the pair
+                          (values (cons psp psps) (cons source-path seen-source-paths)))))
+                             
+                  (define unique-path-source-pairs (reverse reversed-unique-path-source-pairs))
+                  (define filenames (map (compose1 ->string car) unique-path-source-pairs))
+                  (define sources (map cdr unique-path-source-pairs))
+                  (define indent-levels (map directory-pagetree-depth filenames))
+                  (parameterize ([current-directory dashboard-dir])
+                    (map make-path-row filenames sources indent-levels))]
+                 [else (list '(row (cell ((class "no-files")) "No files yet in this directory") (td) (td)))]))))
 
 (define route-dashboard (route-wrapper dashboard))
 
@@ -307,7 +307,7 @@
 (define/contract (route-404 req)
   (request? . -> . response?)
   (define missing-path-string (path->string (simplify-path (req->path req))))
-  (message (format "route-404: Can't find ~a" missing-path-string))
+  (message (format "can't find ~a" missing-path-string))
   (response/xexpr+doctype
    `(html 
      (head (title "404 error") (link ((href "/error.css") (rel "stylesheet"))))

pollen/render.rkt

@@ -107,7 +107,7 @@
                                  #:dest-path 'output
                                  #:notify-cache-use
                                  (λ (str)
-                                   (message (format "rendering: /~a (from cache)"
+                                   (message (format "loading from cache /~a"
                                                     (find-relative-path (current-project-root) output-path))))))))) ; will either be string or bytes
     (display-to-file render-result output-path
                      #:exists 'replace
@@ -145,16 +145,19 @@
     (raise-argument-error 'render (format "valid rendering function for ~a" source-path) render-proc))
   
   (define template-path (or maybe-template-path (get-template-for source-path output-path)))
-  (message (format "rendering: /~a as /~a"
-                   (find-relative-path (current-project-root) source-path)
-                   (find-relative-path (current-project-root) output-path)))
+  
   ;; output-path and template-path may not have an extension, so check them in order with fallback
-  (define render-result (parameterize ([current-poly-target (->symbol (or (get-ext output-path)
-                                                                          (and template-path (get-ext template-path))
-                                                                          (current-poly-target)))])
-                          (apply render-proc (list source-path template-path output-path))))
+  (match-define-values ((cons render-result _) _ real _)
+    (parameterize ([current-poly-target (->symbol (or (get-ext output-path)
+                                                      (and template-path (get-ext template-path))
+                                                      (current-poly-target)))])
+      (time-apply render-proc (list source-path template-path output-path))))
   ;; wait till last possible moment to store mod dates, because render-proc may also trigger its own subrenders
   ;; e.g., of a template.
+  (message (format "rendering /~a as /~a (~a ms)"
+                   (find-relative-path (current-project-root) source-path)
+                   (find-relative-path (current-project-root) output-path)
+                   real))
   (update-mod-date-hash! source-path template-path) 
   render-result)
 
@@ -169,29 +172,29 @@
   (local-require scribble/core scribble/manual (prefix-in scribble- scribble/render))
   (define source-dir (dirname source-path))
   ;; make fresh namespace for scribble rendering (avoids dep/zo caching)
-  (time (parameterize ([current-namespace (make-base-namespace)]
-                       [current-directory (->complete-path source-dir)])
-          (define ns (namespace-anchor->namespace render-module-ns))
-          (namespace-attach-module ns 'scribble/core (current-namespace))
-          (namespace-attach-module ns 'scribble/manual (current-namespace))
-          ;; scribble/lp files have their doc export in a 'doc submodule, so check both locations
-          (match (cond
-                   [(dynamic-require source-path 'doc (λ () #false))]
-                   [(dynamic-require `(submod ,source-path doc) 'doc (λ () #false))]
-                   [else #false])
-            ;; BTW this next action has side effects: scribble will copy in its core files if they don't exist.
-            [(? part? doc) (scribble-render (list doc) (list source-path))]
-            [_ (void)])))
+  (parameterize ([current-namespace (make-base-namespace)]
+                 [current-directory (->complete-path source-dir)])
+    (define ns (namespace-anchor->namespace render-module-ns))
+    (namespace-attach-module ns 'scribble/core (current-namespace))
+    (namespace-attach-module ns 'scribble/manual (current-namespace))
+    ;; scribble/lp files have their doc export in a 'doc submodule, so check both locations
+    (match (cond
+             [(dynamic-require source-path 'doc (λ () #false))]
+             [(dynamic-require `(submod ,source-path doc) 'doc (λ () #false))]
+             [else #false])
+      ;; BTW this next action has side effects: scribble will copy in its core files if they don't exist.
+      [(? part? doc) (scribble-render (list doc) (list source-path))]
+      [_ (void)]))
   (begin0 ; because render promises the data, not the side effect
     (file->string (->output-path source-path))
     (delete-file (->output-path source-path))))
 
 (define (render-preproc-source source-path . _)
-  (time (parameterize ([current-directory (->complete-path (dirname source-path))])
-          (render-datum-through-eval (syntax->datum
-                                      (with-syntax ([SOURCE-PATH source-path])
-                                        #'(begin (require pollen/cache)
-                                                 (cached-doc SOURCE-PATH))))))))
+  (parameterize ([current-directory (->complete-path (dirname source-path))])
+    (render-datum-through-eval (syntax->datum
+                                (with-syntax ([SOURCE-PATH source-path])
+                                  #'(begin (require pollen/cache)
+                                           (cached-doc SOURCE-PATH)))))))
 
 (define (render-markup-or-markdown-source source-path [maybe-template-path #f] [maybe-output-path #f])
   (define output-path (or maybe-output-path (->output-path source-path)))
@@ -229,8 +232,8 @@
                  DOC-ID
                  (include-template #:command-char COMMAND-CHAR (file TEMPLATE-PATH))))))))
   ;; set current-directory because include-template wants to work relative to source location
-  (time (parameterize ([current-directory (->complete-path (dirname source-path))]) 
-          (render-datum-through-eval datum-to-eval))))
+  (parameterize ([current-directory (->complete-path (dirname source-path))]) 
+    (render-datum-through-eval datum-to-eval)))
 
 (define (templated-source? path)
   (or (markup-source? path) (markdown-source? path)))