various small improvements and fixes

pull/102/head
Matthew Butterick 9 years ago
parent 9ab1bd31b6
commit 11c1c6842f

@ -12,7 +12,11 @@
(define (reset-cache) (define (reset-cache)
(cache-remove #f (get-cache-dir))) (for ([path (in-directory)]
#:when (and (directory-exists? path)
(equal? (path->string (car (reverse (explode-path path)))) (world:current-cache-dir-name))))
(message (format "removing cache directory: ~a" path))
(delete-directory/files path)))
(define (paths->key source-path [template-path #f]) (define (paths->key source-path [template-path #f])

@ -64,9 +64,8 @@ version print the version (~a)" (world:current-server-port) (worl
(displayln (world:current-pollen-version))) (displayln (world:current-pollen-version)))
(define (handle-reset) (define (handle-reset)
(display "Resetting cache ...") (displayln "resetting cache ...")
((dynamic-require 'pollen/cache 'reset-cache)) ((dynamic-require 'pollen/cache 'reset-cache)))
(displayln " done"))
(define (handle-render path-args) (define (handle-render path-args)
@ -85,14 +84,14 @@ version print the version (~a)" (world:current-server-port) (worl
(map very-nice-path (map very-nice-path
(cond (cond
[(null? preprocs-and-static-pagetrees) [(null? preprocs-and-static-pagetrees)
(displayln (format "Rendering generated pagetree for directory ~a" dir)) (displayln (format "rendering generated pagetree for directory ~a" dir))
(cdr (make-project-pagetree dir))] (cdr (make-project-pagetree dir))]
[else [else
(displayln (format "Rendering preproc & pagetree files in directory ~a" dir)) (displayln (format "rendering preproc & pagetree files in directory ~a" dir))
preprocs-and-static-pagetrees]))) preprocs-and-static-pagetrees])))
(apply render-batch batch-to-render))) (apply render-batch batch-to-render)))
(begin ; first arg is a file (begin ; first arg is a file
(displayln (format "Rendering ~a" (string-join (map ->string path-args) " "))) (displayln (format "rendering ~a" (string-join (map ->string path-args) " ")))
(apply render-batch path-args))))) (apply render-batch path-args)))))
(define (handle-start directory [port #f]) (define (handle-start directory [port #f])
@ -100,7 +99,7 @@ version print the version (~a)" (world:current-server-port) (worl
(error (format "~a is not a directory" directory))) (error (format "~a is not a directory" directory)))
(parameterize ([world:current-project-root directory] (parameterize ([world:current-project-root directory]
[world:current-server-port (or port world:default-port)]) [world:current-server-port (or port world:default-port)])
(displayln "Starting project server ...") (displayln "starting project server ...")
((dynamic-require 'pollen/server 'start-server)))) ((dynamic-require 'pollen/server 'start-server))))

@ -6,8 +6,7 @@
;; used to track renders according to modification dates of component files ;; used to track renders according to modification dates of component files
(define mod-date-hash (make-hash)) (define mod-date-hash (make-hash))
;; when you want to generate everything fresh, ;; when you want to generate everything fresh.
;; but without having to #:force everything.
;; render functions will always go when no mod-date is found. ;; render functions will always go when no mod-date is found.
(define (reset-mod-date-hash) (define (reset-mod-date-hash)
(set! mod-date-hash (make-hash))) (set! mod-date-hash (make-hash)))
@ -80,13 +79,13 @@
(for-each render-from-source-or-output-path (map ->complete-path (pagetree->list pagetree))))) (for-each render-from-source-or-output-path (map ->complete-path (pagetree->list pagetree)))))
(define/contract+provide (render-from-source-or-output-path so-pathish #:force [force #f]) (define/contract+provide (render-from-source-or-output-path so-pathish)
((pathish?) (#:force boolean?) . ->* . void?) (pathish? . -> . void?)
(let ([so-path (->complete-path so-pathish)]) ; so-path = source or output path (could be either) (let ([so-path (->complete-path so-pathish)]) ; so-path = source or output path (could be either)
(cond (cond
[(ormap (λ(test) (test so-path)) (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source? has/is-template-source?)) [(ormap (λ(test) (test so-path)) (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source? has/is-template-source?))
(let-values ([(source-path output-path) (->source+output-paths so-path)]) (let-values ([(source-path output-path) (->source+output-paths so-path)])
(render-to-file-if-needed source-path output-path #:force force))] (render-to-file-if-needed source-path output-path))]
[(pagetree-source? so-path) (render-pagetree so-path)])) [(pagetree-source? so-path) (render-pagetree so-path)]))
(void)) (void))
@ -106,15 +105,14 @@
(cond (cond
[(not (file-exists? output-path)) 'file-missing] [(not (file-exists? output-path)) 'file-missing]
[(mod-date-missing-or-changed? source-path template-path) 'mod-key-missing-or-changed] [(mod-date-missing-or-changed? source-path template-path) 'mod-key-missing-or-changed]
[(file-needed-rerequire? source-path) 'file-needed-rerequire]
[else #f])) [else #f]))
(define/contract+provide (render-to-file-if-needed source-path [template-path #f] [maybe-output-path #f] #:force [force #f]) (define/contract+provide (render-to-file-if-needed source-path [template-path #f] [maybe-output-path #f])
((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?) #:force boolean?) . ->* . void?) ((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . void?)
(define output-path (or maybe-output-path (->output-path source-path))) (define output-path (or maybe-output-path (->output-path source-path)))
(define template-path (get-template-for source-path)) (define template-path (get-template-for source-path))
(when (or force (render-needed? source-path template-path output-path)) (when (render-needed? source-path template-path output-path)
(render-to-file source-path template-path output-path))) (render-to-file source-path template-path output-path)))
@ -153,7 +151,7 @@
(define/contract (render-scribble-source source-path) (define/contract (render-scribble-source source-path)
(complete-path? . -> . string?) (complete-path? . -> . string?)
(match-define-values (source-dir source-filename _) (split-path source-path)) (match-define-values (source-dir source-filename _) (split-path source-path))
(file-needed-rerequire? source-path) (dynamic-rerequire source-path) ; to suppress namespace caching by dynamic-require below
(define scribble-render (dynamic-require 'scribble/render 'render)) (define scribble-render (dynamic-require 'scribble/render 'render))
(time (parameterize ([current-directory (->complete-path source-dir)]) (time (parameterize ([current-directory (->complete-path source-dir)])
;; if there's a compiled zo file for the Scribble file, ;; if there's a compiled zo file for the Scribble file,
@ -223,12 +221,6 @@
(and (filename-extension output-path) (build-path (world:current-server-extras-path) (add-ext (world:current-fallback-template-prefix) (get-ext output-path)))))))) ; fallback template (and (filename-extension output-path) (build-path (world:current-server-extras-path) (add-ext (world:current-fallback-template-prefix) (get-ext output-path)))))))) ; fallback template
(define/contract (file-needed-rerequire? source-path)
(complete-path? . -> . boolean?)
(and (not (null-source? source-path)) ; null sources can't be compiled
;; if the file needed to be reloaded, the dependency list will be > 0
(> (length (dynamic-rerequire source-path)) 0)))
(define/contract (render-through-eval expr-to-eval) (define/contract (render-through-eval expr-to-eval)
(list? . -> . (or/c string? bytes?)) (list? . -> . (or/c string? bytes?))

@ -5,7 +5,7 @@
(require web-server/http/request-structs) (require web-server/http/request-structs)
(require web-server/http/response-structs) (require web-server/http/response-structs)
(require 2htdp/image) (require 2htdp/image)
(require "world.rkt" "render.rkt" sugar txexpr "file.rkt" "debug.rkt" "pagetree.rkt" "cache.rkt" "rerequire.rkt") (require "world.rkt" "render.rkt" sugar txexpr "file.rkt" "debug.rkt" "pagetree.rkt" "cache.rkt")
(module+ test (require rackunit)) (module+ test (require rackunit))
@ -13,7 +13,7 @@
;;; separated out for ease of testing ;;; separated out for ease of testing
;;; because it's tedious to start the server just to check a route. ;;; because it's tedious to start the server just to check a route.
(provide route-dashboard route-xexpr route-default route-404 route-in route-out) (provide route-dashboard route-default route-404 route-in route-out)
(define (response/xexpr+doctype xexpr) (define (response/xexpr+doctype xexpr)
(response/xexpr #:preamble #"<!DOCTYPE html>" xexpr)) (response/xexpr #:preamble #"<!DOCTYPE html>" xexpr))
@ -57,16 +57,6 @@
(response/xexpr+doctype (route-proc path)))) (response/xexpr+doctype (route-proc path))))
;; extract main xexpr from a path
(define/contract (file->xexpr path #:render [wants-render #t])
((complete-path?) (#:render boolean?) . ->* . txexpr?)
(when wants-render (render-from-source-or-output-path path))
(dynamic-rerequire path) ; stores module mod date; reloads if it's changed
(dynamic-require path (world:current-main-export)))
;; todo: rewrite this test, obsolete since filename convention changed
;;(module+ test
;; (check-equal? (file->xexpr (build-path (current-directory) "tests/server-routes/foo.p") #:render #f) '(root "\n" "foo")))
;; read contents of file to string ;; read contents of file to string
;; just file->string with a render option ;; just file->string with a render option
@ -224,8 +214,7 @@
;; default route ;; default route
(define (route-default req) (define (route-default req)
(logger req) (logger req)
(define force (->boolean (get-query-value (request-uri req) 'force))) (render-from-source-or-output-path (req->path req))
(render-from-source-or-output-path (req->path req) #:force force)
(next-dispatcher)) (next-dispatcher))
@ -235,12 +224,3 @@
(define error-text (format "route-404: Can't find ~a" (->string (req->path req)))) (define error-text (format "route-404: Can't find ~a" (->string (req->path req))))
(message error-text) (message error-text)
(response/xexpr+doctype `(html ,error-text))) (response/xexpr+doctype `(html ,error-text)))
;; server route that returns xexpr (before conversion to html)
(define/contract (xexpr path)
(complete-path? . -> . xexpr?)
(format-as-code (~v (file->xexpr path))))
(define route-xexpr (route-wrapper xexpr))

@ -17,7 +17,6 @@
[((string-arg) ... (? pagetree-source?)) route-dashboard] [((string-arg) ... (? pagetree-source?)) route-dashboard]
[((string-arg) ... "in" (string-arg)) route-in] [((string-arg) ... "in" (string-arg)) route-in]
[((string-arg) ... "out" (string-arg)) route-out] [((string-arg) ... "out" (string-arg)) route-out]
[((string-arg) ... "xexpr" (string-arg)) route-xexpr]
[else route-default])) [else route-default]))
(message (format "Welcome to Pollen ~a" (world:current-pollen-version)) (format "(Racket ~a)" (version))) (message (format "Welcome to Pollen ~a" (world:current-pollen-version)) (format "(Racket ~a)" (version)))

@ -1,5 +1,5 @@
#lang at-exp racket/base #lang at-exp racket/base
(require rackunit racket/runtime-path pollen/render racket/file racket/system) (require rackunit racket/runtime-path pollen/render racket/file racket/system pollen/world)
;; define-runtime-path only allowed at top level ;; define-runtime-path only allowed at top level
(define-runtime-path rerequire-dir "data/rerequire") (define-runtime-path rerequire-dir "data/rerequire")
@ -14,14 +14,16 @@
(copy-file markup.txt.pm pre.txt.pp #t) (copy-file markup.txt.pm pre.txt.pp #t)
;; test makes sure that file render changes after pollen.rkt changes ;; test makes sure that file render changes after pollen.rkt changes
(parameterize ([current-output-port (open-output-string)]) (parameterize ([current-output-port (open-output-string)]
[current-directory rerequire-dir]
[world:current-project-root rerequire-dir])
(display-to-file @string-append{#lang racket/base (display-to-file @string-append{#lang racket/base
(provide id) (provide id)
(define (id) "first")} pollen.rkt #:exists 'replace) (define (id) "first")} pollen.rkt #:exists 'replace)
(render-to-file-if-needed markup.txt.pm) (render-to-file-if-needed markup.txt.pm)
(check-equal? (file->string markup.txt) "rootfirst") (check-equal? (file->string markup.txt) "(root first)")
(render-to-file-if-needed pre.txt.pp) (render-to-file-if-needed pre.txt.pp)
(check-equal? (file->string pre.txt) "first") (check-equal? (file->string pre.txt) "first")
@ -31,7 +33,7 @@
(define (id) "second")} pollen.rkt #:exists 'replace) (define (id) "second")} pollen.rkt #:exists 'replace)
(render-to-file-if-needed markup.txt.pm) (render-to-file-if-needed markup.txt.pm)
(check-equal? (file->string markup.txt) "rootsecond") (check-equal? (file->string markup.txt) "(root second)")
(render-to-file-if-needed pre.txt.pp) (render-to-file-if-needed pre.txt.pp)
(check-equal? (file->string pre.txt) "second")) (check-equal? (file->string pre.txt) "second"))

@ -7,8 +7,19 @@
(define current-project-root (make-parameter (current-directory))) (define current-project-root (make-parameter (current-directory)))
(define directory-require "pollen.rkt") (define directory-require "pollen.rkt")
(define (get-path-to-override) (define (get-path-to-override)
(build-path (current-project-root) directory-require)) (define file-with-config-submodule directory-require)
(define (dirname path)
(let-values ([(dir name dir?) (split-path path)])
dir))
(let loop ([dir (current-directory)][path file-with-config-submodule])
(and dir ; dir is #f when it hits the top of the filesystem
(let ([completed-path (path->complete-path path)])
(if (file-exists? completed-path)
(simplify-path completed-path)
(loop (dirname dir) (build-path 'up path)))))))
;; parameters should not be made settable. ;; parameters should not be made settable.
(define-for-syntax config-submodule-name 'config) (define-for-syntax config-submodule-name 'config)
@ -23,7 +34,7 @@
(define base-name default-value) (define base-name default-value)
(define fail-thunk-name (λ _ base-name)) (define fail-thunk-name (λ _ base-name))
(define current-name (λ _ (with-handlers ([exn:fail? fail-thunk-name]) (define current-name (λ _ (with-handlers ([exn:fail? fail-thunk-name])
(dynamic-require `(submod ,(get-path-to-override) config-submodule) 'base-name fail-thunk-name))))))])) (dynamic-require `(submod ,(get-path-to-override) config-submodule) 'base-name fail-thunk-name))))))]))
(define-settable pollen-version "0.001") (define-settable pollen-version "0.001")

Loading…
Cancel
Save