simplify messages

dev-stylish
Matthew Butterick 6 years ago
parent fff6c3f5e9
commit a7c4733e58

@ -61,11 +61,11 @@
(define client (request-client-ip req)) (define client (request-client-ip req))
(define localhost-client "::1") (define localhost-client "::1")
(define url-string (url->string (request-uri req))) (define url-string (url->string (request-uri req)))
(when (not (ends-with? url-string "favicon.ico")) (unless (ends-with? url-string "favicon.ico")
(message "request:" (if (regexp-match #rx"/$" url-string) (message (if (regexp-match #rx"/$" url-string)
(string-append url-string " directory default page") (string-append url-string " directory default page")
(string-replace url-string (setup:main-pagetree) " dashboard")) (string-replace url-string (setup:main-pagetree) " dashboard"))
(if (not (equal? client localhost-client)) (format "from ~a" client) "")))) (if (not (equal? client localhost-client)) (format "from ~a" client) "")))
;; pass string args to route, then ;; pass string args to route, then
;; package route into right format for web server ;; package route into right format for web server
@ -307,7 +307,7 @@
(define/contract (route-404 req) (define/contract (route-404 req)
(request? . -> . response?) (request? . -> . response?)
(define missing-path-string (path->string (simplify-path (req->path req)))) (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 (response/xexpr+doctype
`(html `(html
(head (title "404 error") (link ((href "/error.css") (rel "stylesheet")))) (head (title "404 error") (link ((href "/error.css") (rel "stylesheet"))))

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

Loading…
Cancel
Save