@ -3,8 +3,6 @@
( require racket/port racket/file racket/rerequire racket/path racket/list racket/match )
( require sugar " file-tools.rkt " " cache.rkt " " world.rkt " " debug.rkt " " ptree.rkt " " project-requires.rkt " )
( module+ test ( require rackunit ) )
;; for shared use by eval & system
( define nowhere-port ( open-output-nowhere ) )
@ -23,20 +21,10 @@
( file-or-directory-modify-seconds path ) ) )
( module+ test
( check-false ( path->mod-date-value ( ->path " nonexistent-file-is-false.rkt " ) ) ) )
( define ( store-render-in-mod-dates . rest-paths )
( define key ( make-mod-dates-key rest-paths ) )
( hash-set! mod-dates key ( map path->mod-date-value key ) ) )
( module+ test
( reset-mod-dates )
( store-render-in-mod-dates ( build-path ( current-directory ) ( ->path " render.rkt " ) ) )
( check-true ( = ( len mod-dates ) 1 ) )
( reset-mod-dates ) )
;; when you want to generate everything fresh,
;; but without having to #:force everything.
@ -44,25 +32,12 @@
( define ( reset-mod-dates )
( set! mod-dates ( make-hash ) ) )
( module+ test
( reset-mod-dates )
( store-render-in-mod-dates ( build-path ( current-directory ) ( ->path " render.rkt " ) ) )
( reset-mod-dates )
( check-true ( = ( len mod-dates ) 0 ) ) )
( define ( mod-date-expired? . rest-paths )
( define key ( make-mod-dates-key rest-paths ) )
( or ( not ( key . in? . mod-dates ) ) ; no stored mod date
( not ( equal? ( map path->mod-date-value key ) ( get mod-dates key ) ) ) ) ) ; data has changed
( module+ test
( reset-mod-dates )
( let ( [ path ( build-path ( current-directory ) ( ->path " render.rkt " ) ) ] )
( store-render-in-mod-dates path )
( check-false ( mod-date-expired? path ) )
( reset-mod-dates )
( check-true ( mod-date-expired? path ) ) ) )
( define+provide/contract ( render-batch . xs )
@ -74,134 +49,137 @@
;; Using reset-mod-dates is sort of like session control:
;; setting a state that persists through the whole operation.
( reset-mod-dates )
( for-each render xs ) )
( for-each render-for-dev-server xs ) )
( define+provide/contract ( render #:force [ force #f ] . xs )
( ( ) ( #:force boolean? ) #:rest ( listof pathish? ) . ->* . void? )
( define ( &render x )
( let ( [ path ( ->complete-path x ) ] )
( cond
[ ( has/is-null-source? path ) ( render-null-source path #:force force ) ]
[ ( has/is-preproc-source? path ) ( render-preproc-source-if-needed path #:force force ) ]
[ ( has/is-markup-source? path ) ( render-markup path #:force force ) ]
[ ( ptree-source? path ) ( let ( [ ptree ( cached-require path world:main-pollen-export ) ] )
( render-files-in-ptree ptree #:force force ) ) ]
[ ( equal? world:fallback-template ( ->string ( file-name-from-path path ) ) )
( message " Render: using fallback template " ) ]
[ ( file-exists? path ) ( message " Serving static file " ( ->string ( file-name-from-path path ) ) ) ] ) ) )
( for-each &render xs ) )
;; todo: write tests
( define+provide/contract ( render-for-dev-server pathish #:force [ force #f ] )
( ( pathish? ) ( #:force boolean? ) . ->* . void? )
( let ( [ path ( ->complete-path pathish ) ] )
( cond
[ ( ormap ( λ ( test ) ( and ( test path ) ( render-to-file path #:force force ) ) )
( list has/is-null-source? has/is-preproc-source? has/is-markup-source? ) ) ]
[ ( ptree-source? path ) ( let ( [ ptree ( cached-require path world:main-pollen-export ) ] )
( for-each ( λ ( pnode ) ( render-for-dev-server pnode #:force force ) ) ( ptree->list ptree ) ) ) ] ) )
( void ) )
( define ( rendering-message path )
( message " Rendering " ( ->string ( file-name-from-path path ) ) ) )
( define ( ->source+output-paths source-or-output-path )
;; file-proc returns two values
( define file-proc ( ormap ( λ ( test file-proc ) ( and ( test source-or-output-path ) file-proc ) )
( list has/is-null-source? has/is-preproc-source? has/is-markup-source? )
( list ->null-source+output-paths ->preproc-source+output-paths ->markup-source+output-paths ) ) )
( file-proc source-or-output-path ) )
( define ( rendered-message path )
( message " Rendered " ( ->string ( file-name-from-path path ) ) ) )
( define ( up-to-date-message path )
( message ( ->string ( file-name-from-path path ) ) " is up to date, using existing copy " ) )
( define ( render-to-file source-or-output-path [ maybe-output-path #f ] #:force [ force #f ] )
( define-values ( source-path output-path ) ( ->source+output-paths source-or-output-path ) )
( when maybe-output-path ( set! output-path maybe-output-path ) )
( display-to-file ( render source-path output-path #:force force ) output-path #:exists ' replace ) )
( define ( render-null-source path #:force force )
;; this op is trivial & fast, so do it every time.
( define-values ( source-path output-path ) ( ->null-source+output-paths path ) )
( message ( format " Copying ~a to ~a "
( file-name-from-path source-path )
( file-name-from-path output-path ) ) )
( copy-file source-path output-path #t ) )
( define ( render-preproc-source source-path output-path )
;; how we render: import world:main-pollen-export from preproc source file,
;; which is rendered during source parsing, and write that to output path
( define-values ( source-dir source-name _ ) ( split-path source-path ) )
( rendering-message ( format " ~a from ~a "
( file-name-from-path output-path )
( file-name-from-path source-path ) ) )
( let ( [ doc ( time ( render-through-eval source-dir ` ( begin ( require pollen/cache ) ( cached-require , source-path ' , world:main-pollen-export ) ) ) ) ] ) ;; todo: how to use world global here? Wants an identifier, not a value
( display-to-file doc output-path #:exists ' replace ) )
( store-render-in-mod-dates source-path ) ; don't store mod date until render has completed!
( rendered-message output-path ) )
( define ( render-preproc-source-if-needed path #:force [ force-render #f ] )
( define-values ( source-path output-path ) ( ->preproc-source+output-paths path ) )
( define ( render source-path [ output-path #f ] #:force [ force #f ] )
( define render-proc
( cond
[ ( ormap ( λ ( test render-proc ) ( and ( test source-path ) render-proc ) )
( list has/is-null-source? has/is-preproc-source? has/is-markup-source? )
( list render-null-source render-preproc-source render-markup-source ) ) ]
[ else ( error ( format " render: no rendering function found for ~a " source-path ) ) ] ) )
( define render-needed?
( or
force-render
( not ( file-exists? output-path ) )
( mod-date-expired? source-path )
( let ( [ source-reloaded? ( handle-source-rerequire source-path ) ] )
source-reloaded? ) ) )
( or force
( not ( file-exists? ( or output-path ( ->output-path source-path ) ) ) )
( mod-date-expired? source-path )
( source-needs-rerequire? source-path ) ) )
( if render-needed?
( render-preproc-source source-path output-path )
( up-to-date-message output-path ) ) )
( let ( [ result ( render-proc source-path ) ] )
( message ( format " Rendered ~a " ( file-name-from-path source-path ) ) )
( store-render-in-mod-dates source-path )
result )
( message ( ->string ( file-name-from-path source-path ) ) " is up to date, using existing copy " ) ) )
;; todo: write tests
( define/contract ( render-null-source source-path )
( pathish? . -> . bytes? )
;; All this does is copy the source. Hence, "null".
;; todo: add test to avoid copying if unnecessary
;; (good idea in case the file is large)
( let ( [ source-path ( ->path source-path ) ] )
( file->bytes source-path ) ) )
( define ( handle-source-rerequire source-path )
( define-values ( source-dir source-name _ ) ( split-path source-path ) )
;; use dynamic-rerequire now to force render for cached-require later,
;; otherwise the source file will get cached by compiler
( define port-for-catching-file-info ( open-output-string ) )
( parameterize ( [ current-directory source-dir ]
[ current-error-port port-for-catching-file-info ] )
( dynamic-rerequire source-path ) )
;; if the file needed to be reloaded, there will be a message in the port
( > ( len ( get-output-string port-for-catching-file-info ) ) 0 ) )
( define ( render-preproc-source source-path )
;; how we render: import world:main-pollen-export from preproc source file,
;; which is rendered during source parsing, and write that to output path
( match-define-values ( source-dir _ _ ) ( split-path source-path ) )
( time ( parameterize ( [ current-directory ( ->complete-path source-dir ) ] )
( render-through-eval ` ( begin ( require pollen/cache ) ( cached-require , source-path ' , world:main-pollen-export ) ) ) ) ) )
( define ( render-markup path [ template-name #f ] #:force [ force-render #f ] )
( define-values ( source-path output-path ) ( ->markup-source+output-paths path ) )
( define ( render-markup-source source-path )
;; todo: this won't work with source files nested down one level
( define-values ( source-dir ignored also-ignored ) ( split-path source-path ) )
( match-define-values ( source-dir _ _ ) ( split-path source-path ) )
;; Then the rest:
;; 1) Set the template.
( define template-path
( or
;; Build the possible paths and use the first one that either exists, or has a preproc source that exists.
( ormap ( λ ( p ) ( if ( ormap file-exists? ( list p ( ->preproc-source-path p ) ) ) p #f ) )
( filter ( λ ( x ) ( ->boolean x ) ) ; if any of the possibilities below are invalid, they return #f
( list
( and template-name ( build-path source-dir template-name ) ) ; path based on template-name
( parameterize ( [ current-directory ( world:current-project-root ) ] )
( let ( [ source-metas ( cached-require source-path ' metas ) ] )
( and ( world:template-meta-key . in? . source-metas )
( build-path source-dir ( get source-metas world:template-meta-key ) ) ) ) ) ; path based on metas
( build-path source-dir
( add-ext ( add-ext world:default-template-prefix ( get-ext ( ->output-path source-path ) ) ) world:template-source-ext ) ) ) ) ) ; path using default template
( let ( [ ft-path ( build-path source-dir world:fallback-template ) ] ) ; if none of these work, make fallback template file
( copy-file ( build-path ( world:current-server-extras-path ) world:fallback-template ) ft-path #t )
ft-path ) ) )
( define template-path ( get-template-for source-path ) )
( render-for-dev-server template-path ) ; because template might have its own preprocessor source
( render template-path #:force force-render ) ; because template might have its own preprocessor source
;; TODO: need to check (mod-date-expired? source-path template-path))
;; 2) Render the source file with template, if needed
( define string-to-eval
` ( begin
( require ( for-syntax racket/base ) )
( require web-server/templates pollen/cache )
( require pollen/lang/inner-lang-helper )
( require-project-require-files )
( let ( [ doc ( cached-require , source-path ' , world:main-pollen-export ) ]
[ metas ( cached-require , source-path ' , world:meta-pollen-export ) ] )
( local-require pollen/debug pollen/ptree pollen/template pollen/top )
( include-template #:command-char , world:template-field-delimiter , ( ->string template-path ) ) ) ) )
;; 2) Render the source file with template, if needed.
;; Render is expensive, so we avoid it when we can. Four conditions where we render:
( if ( or force-render ; a) it's explicitly demanded
( not ( file-exists? output-path ) ) ; b) output file does not exist
( mod-date-expired? source-path template-path ) ; c) mod-dates indicates render is needed
( let ( [ source-reloaded? ( handle-source-rerequire source-path ) ] ) ; d) dynamic-rerequire says refresh needed
source-reloaded? ) )
( begin
( message " Rendering source " ( ->string ( file-name-from-path source-path ) )
" with template " ( ->string ( file-name-from-path template-path ) ) )
( let ( [ page-result ( time ( render-source-with-template source-path template-path ) ) ] )
( display-to-file page-result output-path #:exists ' replace )
( store-render-in-mod-dates source-path template-path )
( rendered-message output-path ) ) )
( up-to-date-message output-path ) )
( define result ( time ( parameterize ( [ current-directory ( ->complete-path source-dir ) ] )
( render-through-eval string-to-eval ) ) ) )
( let ( [ ft-path ( build-path source-dir world:fallback-template ) ] ) ; delete fallback template if needed
( when ( file-exists? ft-path ) ( delete-file ft-path ) ) ) )
( when ( file-exists? ft-path ) ( delete-file ft-path ) ) )
result )
( define ( get-template-for source-path )
( match-define-values ( source-dir _ _ ) ( split-path source-path ) )
;; Build the possible paths and use the first one that either exists, or has a preproc source that exists.
( or
( ormap ( λ ( p ) ( if ( ormap file-exists? ( list p ( ->preproc-source-path p ) ) ) p #f ) )
( filter ( λ ( x ) ( ->boolean x ) ) ; if any of the possibilities below are invalid, they return #f
( list
( parameterize ( [ current-directory ( world:current-project-root ) ] )
( let ( [ source-metas ( cached-require source-path ' metas ) ] )
( and ( world:template-meta-key . in? . source-metas )
( build-path source-dir ( get source-metas world:template-meta-key ) ) ) ) ) ; path based on metas
( build-path source-dir
( add-ext ( add-ext world:default-template-prefix ( get-ext ( ->output-path source-path ) ) ) world:template-source-ext ) ) ) ) ) ; path using default template
( let ( [ ft-path ( build-path source-dir world:fallback-template ) ] ) ; if none of these work, make fallback template file
( copy-file ( build-path ( world:current-server-extras-path ) world:fallback-template ) ft-path #t )
ft-path ) ) )
( define ( source-needs-rerequire? source-path )
( define-values ( source-dir source-name _ ) ( split-path source-path ) )
;; use dynamic-rerequire now to force render for cached-require later,
;; otherwise the source file will get cached by compiler
( define port-for-catching-file-info ( open-output-string ) )
( parameterize ( [ current-directory source-dir ]
[ current-error-port port-for-catching-file-info ] )
( dynamic-rerequire source-path ) )
;; if the file needed to be reloaded, there will be a message in the port
( > ( len ( get-output-string port-for-catching-file-info ) ) 0 ) )
;; cache some modules to speed up eval.
;; Do it in separate module so as not to pollute this one.
@ -237,9 +215,8 @@
( define cache-ns ( namespace-anchor->namespace my-module-cache-ns-anchor ) )
( define ( render-through-eval base-dir eval-string)
( define ( render-through-eval )
( parameterize ( [ current-namespace ( make-base-namespace ) ]
[ current-directory ( ->complete-path base-dir ) ]
[ current-output-port ( current-error-port ) ]
[ current-ptree ( make-project-ptree ( world:current-project-root ) ) ]
[ current-url-context ( world:current-project-root ) ] )
@ -265,44 +242,4 @@
pollen/world
pollen/project-requires
,@ ( get-project-require-files ) ) )
( eval eval-string ( current-namespace ) ) ) )
( define ( render-source-with-template source-path template-path )
( match-define-values ( source-dir source-name _ ) ( split-path source-path ) )
( match-define-values ( _ template-name _ ) ( split-path template-path ) )
( set! source-name ( ->string source-name ) )
( define string-to-eval
` ( begin
( require ( for-syntax racket/base ) )
( require web-server/templates pollen/cache )
( require pollen/lang/inner-lang-helper )
( require-project-require-files )
( let ( [ doc ( cached-require , source-name ' , world:main-pollen-export ) ]
[ metas ( cached-require , source-name ' , world:meta-pollen-export ) ] )
( local-require pollen/debug pollen/ptree pollen/template pollen/top )
( include-template #:command-char , world:template-field-delimiter , ( ->string template-name ) ) ) ) )
( render-through-eval source-dir string-to-eval ) )
#|
( module+ main
( parameterize ( [ current-cache ( make-cache ) ]
[ world:current-project-root ( string->path " /Users/mb/git/bpt " ) ] )
( render
( string->path " /Users/mb/git/bpt/test.html.pm " )
) ) )
| #
( define ( render-files-in-ptree ptree #:force [ force #f ] )
( for-each ( λ ( i ) ( render i #:force force ) )
( ( cached-require " ptree.rkt " ' all-pages ) ptree ) ) )
;; todo: write test
( eval eval-string ( current-namespace ) ) ) )
