@ -1,8 +1,5 @@
#lang racket/base
#lang racket/base
( require racket/port racket/file racket/rerequire racket/contract racket/path )
( require racket/port racket/file racket/rerequire racket/contract racket/path )
;(require "world.rkt" )
;;todo: why is pollen/top operating in this file?
( module+ test ( require rackunit ) )
( module+ test ( require rackunit ) )
@ -23,6 +20,8 @@
;; between development sessions (prob a worthless optimization)
;; between development sessions (prob a worthless optimization)
( define mod-dates ( make-hash ) )
( define mod-dates ( make-hash ) )
( define/contract ( make-mod-dates-key paths )
( define/contract ( make-mod-dates-key paths )
( ( listof path? ) . -> . ( listof path? ) )
( ( listof path? ) . -> . ( listof path? ) )
( define project-require-files ( or ( get-project-require-files ) empty ) )
( define project-require-files ( or ( get-project-require-files ) empty ) )
@ -113,7 +112,7 @@
; (message "Dispatching render for" (->string (file-name-from-path path)))
; (message "Dispatching render for" (->string (file-name-from-path path)))
( cond
( cond
;; this will catch preprocessor files
;; this will catch preprocessor files
[ ( needs-preproc? path ) ( render-preproc-source path #:force force ) ]
[ ( needs-preproc? path ) ( render-preproc-source -if-needed path #:force force ) ]
;; this will catch pollen source files,
;; this will catch pollen source files,
;; and files without extension that correspond to p files
;; and files without extension that correspond to p files
[ ( needs-template? path ) ( render-with-template path #:force force ) ]
[ ( needs-template? path ) ( render-with-template path #:force force ) ]
@ -142,45 +141,37 @@
( any/c . -> . void? )
( any/c . -> . void? )
( message ( ->string ( file-name-from-path path ) ) " is up to date, using cached copy " ) )
( message ( ->string ( file-name-from-path path ) ) " is up to date, using cached copy " ) )
( define ( render-preproc-source source-path output-path )
( define/contract ( render-preproc-source x #:force [ force #f ] )
;; how we render: import 'main from preproc source file,
( ( ( and/c pathish?
;; which is rendered during source parsing,
( flat-named-contract ' file-exists
;; and write that to output path
( λ ( x ) ( file-exists? ( ->complete-path ( ->preproc-source-path x ) ) ) ) ) ) ) ( #:force boolean? ) . ->* . void? )
;; x might be either a preproc-source path or preproc-output path
( define source-path ( ->complete-path ( ->preproc-source-path x ) ) )
( define-values ( source-dir source-name _ ) ( split-path source-path ) )
( define-values ( source-dir source-name _ ) ( split-path source-path ) )
( define output-path ( ->complete-path ( ->output-path x ) ) )
( rendering-message ( format " ~a from ~a "
( file-name-from-path output-path )
( define source-reloaded? ( handle-source-rerequire source-path ) )
( file-name-from-path source-path ) ) )
( let ( [ main ( time ( render-through-eval source-dir ` ( dynamic-require , source-path ' main ) ) ) ] ) ;; todo: how to use world global here? Wants an identifier, not a value
;; Four conditions under which we render preproc sources:
( display-to-file main output-path #:exists ' replace ) )
( if ( or
( store-render-in-mod-dates source-path ) ; don't store mod date until render has completed!
;; 1) explicitly forced render:
( rendered-message output-path ) )
force
;; 2) output file doesn't exist (so it definitely won't appear in mod-dates)
( define/contract ( render-preproc-source-if-needed input-path #:force [ force-render #f ] )
;; also, this is convenient for development:
( ( pathish? ) ( #:force boolean? ) . ->* . void? )
;; you can trigger a render just by deleting the file
;; input-path might be either a preproc-source path or preproc-output path
;; But the coercion functions will figure it out.
( define source-path ( ->complete-path ( ->preproc-source-path input-path ) ) )
( define output-path ( ->complete-path ( ->output-path input-path ) ) )
( define render-needed?
( or
force-render
( not ( file-exists? output-path ) )
( not ( file-exists? output-path ) )
;; 3) file otherwise needs render (e.g., it changed)
( mod-date-expired? source-path )
( mod-date-expired? source-path )
;; 4) source had to be reloaded (some other change)
( let ( [ source-reloaded? ( handle-source-rerequire source-path ) ] )
source-reloaded? )
source-reloaded? ) ) )
;; how we render: import 'main from preproc source file,
( if render-needed?
;; which is rendered during source parsing,
( render-preproc-source source-path output-path )
;; and write that to output path
( begin
( rendering-message ( format " ~a from ~a "
( file-name-from-path output-path )
( file-name-from-path source-path ) ) )
( let ( [ main ( time ( render-through-eval source-dir ` ( dynamic-require , source-path ' main ) ) ) ] )
( display-to-file main output-path #:exists ' replace ) )
( store-render-in-mod-dates source-path ) ; don't store mod date until render has completed!
( rendered-message output-path ) )
;; otherwise, skip file because there's no trigger for render
( up-to-date-message output-path ) ) )
( up-to-date-message output-path ) ) )
;; todo: write tests
;; todo: write tests
@ -293,28 +284,29 @@
pollen/debug
pollen/debug
pollen/decode
pollen/decode
pollen/file-tools
pollen/file-tools
pollen/main-imports
;; commented out so we don't get #%top in this file
pollen/main-preproc-imports
; pollen/main-imports
; pollen/main-preproc-imports
pollen/predicates
pollen/predicates
pollen/ptree
pollen/ptree
sugar
sugar
pollen/template
pollen/template
pollen/tools
pollen/tools
pollen/world )
pollen/world
pollen/project-requires )
( define original-ns ( current-namespace ) )
( define original-ns ( current-namespace ) )
( define/contract ( render-through-eval base-dir eval-string )
( define/contract ( render-through-eval base-dir eval-string )
( directory-pathish? list? . -> . string? )
( directory-pathish? list? . -> . string? )
( parameterize ( [ current-namespace ( make-base-empty-namespace ) ]
( parameterize ( [ current-namespace ( make-base-empty-namespace ) ]
[ current-directory ( ->complete-path base-dir ) ]
[ current-directory ( ->complete-path base-dir ) ]
[ current-output-port nowhere-port ] )
[ current-output-port ( current-error-port ) ] )
;; attach already-imported modules
;; attach already-imported modules
;; this is a performance optimization: this way,
;; this is a performance optimization: this way,
;; the eval namespace doesn't have to re-import these
;; the eval namespace doesn't have to re-import these
;; because otherwise, most of its time is spent traversing imports.
;; because otherwise, most of its time is spent traversing imports.
( map ( λ ( mod-name ) ( namespace-attach-module original-ns mod-name ) )
( for-each ( λ ( mod-name ) ( namespace-attach-module original-ns mod-name ) )
' ( racket/base
' ( web-server/templates
web-server/templates
xml/path
xml/path
racket/port
racket/port
racket/file
racket/file
@ -324,8 +316,8 @@
pollen/debug
pollen/debug
pollen/decode
pollen/decode
pollen/file-tools
pollen/file-tools
pollen/main-imports
; pollen/main-imports
pollen/main-preproc-imports
; pollen/main-preproc-imports
pollen/predicates
pollen/predicates
pollen/ptree
pollen/ptree
sugar
sugar
@ -333,7 +325,6 @@
pollen/tools
pollen/tools
pollen/world ) )
pollen/world ) )
( namespace-require ' racket/base ) ; use namespace-require for FIRST require, then eval after
( namespace-require ' racket/base ) ; use namespace-require for FIRST require, then eval after
( eval ' ( require ( for-syntax racket/base ) ) )
( eval eval-string ( current-namespace ) ) ) )
( eval eval-string ( current-namespace ) ) ) )
( define/contract ( render-source-with-template source-path template-path )
( define/contract ( render-source-with-template source-path template-path )
@ -350,16 +341,16 @@
( define string-to-eval
( define string-to-eval
` ( begin
` ( begin
;; for include-template (used below)
;; for include-template (used below)
( require web-server/templates )
( require web-server/templates )
;; for ptree navigation functions, and template commands
;; for ptree navigation functions, and template commands
;; todo: main-helper is here for #%top and bound/c — should they go elsewhere?
;; todo: main-helper is here for #%top and bound/c — should they go elsewhere?
( require pollen/debug pollen/ptree pollen/template pollen/top )
( require pollen/debug pollen/ptree pollen/template pollen/top )
;; import source into eval space. This sets up main & metas
;; import source into eval space. This sets up main & metas
( require , ( ->string source-name ) )
( require , ( ->string source-name ) )
( parameterize ( [ current-ptree ( make-project-ptree , PROJECT_ROOT ) ]
( parameterize ( [ current-ptree ( make-project-ptree , PROJECT_ROOT ) ]
[ current-url-context , PROJECT_ROOT ] )
[ current-url-context , PROJECT_ROOT ] )
( include-template #:command-char , TEMPLATE_FIELD_DELIMITER , ( ->string template-name ) ) ) ) )
( include-template #:command-char , TEMPLATE_FIELD_DELIMITER , ( ->string template-name ) ) ) ) )
( render-through-eval source-dir string-to-eval ) )
( render-through-eval source-dir string-to-eval ) )