@ -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 ] )
( ( ( and/c pathish?
( flat-named-contract ' file-exists
( λ ( 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 output-path ( ->complete-path ( ->output-path x ) ) )
( define source-reloaded? ( handle-source-rerequire source-path ) )
;; Four conditions under which we render preproc sources:
( if ( or
;; 1) explicitly forced render:
force
;; 2) output file doesn't exist (so it definitely won't appear in mod-dates)
;; also, this is convenient for development:
;; you can trigger a render just by deleting the file
( not ( file-exists? output-path ) )
;; 3) file otherwise needs render (e.g., it changed)
( mod-date-expired? source-path )
;; 4) source had to be reloaded (some other change)
source-reloaded? )
;; how we render: import 'main from preproc source file,
;; how we render: import 'main from preproc source file,
;; which is rendered during source parsing,
;; which is rendered during source parsing,
;; and write that to output path
;; and write that to output path
( begin
( define-values ( source-dir source-name _ ) ( split-path source-path ) )
( rendering-message ( format " ~a from ~a "
( rendering-message ( format " ~a from ~a "
( file-name-from-path output-path )
( file-name-from-path output-path )
( file-name-from-path source-path ) ) )
( file-name-from-path source-path ) ) )
( let ( [ main ( time ( render-through-eval source-dir ` ( dynamic-require , source-path ' main ) ) ) ] )
( 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
( display-to-file main output-path #:exists ' replace ) )
( display-to-file main output-path #:exists ' replace ) )
( store-render-in-mod-dates source-path ) ; don't store mod date until render has completed!
( store-render-in-mod-dates source-path ) ; don't store mod date until render has completed!
( rendered-message output-path ) )
( rendered-message output-path ) )
;; otherwise, skip file because there's no trigger for render
( define/contract ( render-preproc-source-if-needed input-path #:force [ force-render #f ] )
( ( pathish? ) ( #:force boolean? ) . ->* . void? )
;; 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 ) )
( mod-date-expired? source-path )
( let ( [ source-reloaded? ( handle-source-rerequire source-path ) ] )
source-reloaded? ) ) )
( if render-needed?
( render-preproc-source source-path output-path )
( 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 )