From 0f396471e9c7b0ad03eafd11563b4a726eecb494 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 27 Jun 2015 22:12:20 -0700 Subject: [PATCH] add runtime overrides to pollen/world (closes #60) --- cache.rkt | 10 +- command.rkt | 9 +- convert.rkt | 2 +- decode.rkt | 8 +- file.rkt | 14 +- info.rkt | 2 +- main-base.rkt | 105 ++++++++------- metas.rkt | 9 +- pagetree.rkt | 6 +- raco.rkt | 1 + reader-base.rkt | 16 +-- render.rkt | 28 ++-- scribblings/cache.scrbl | 2 +- scribblings/mb-tools.rkt | 14 +- scribblings/raco.scrbl | 3 +- scribblings/tutorial-second.scrbl | 2 +- scribblings/world.scrbl | 126 ++++++++++-------- server-routes.rkt | 14 +- server.rkt | 4 +- template.rkt | 8 +- test/data/override/directory-require.rkt | 18 +++ test/data/override/test-cmd.html.ppover | 2 + test/data/override/test-exports.html.ppover | 3 + test/data/override/test-require.html.pmover | 2 + .../data/override}/test.html.pm | 0 .../data/override}/test.html.pmd | 0 .../data/override/test.html.pmdover | 0 .../data/override/test.html.pmover | 0 .../data/override/test.html.pp | 0 test/data/override/test.html.ppover | 4 + test/data/override/test.no-ext | 4 + test/data/override/test.ptree | 4 + test/data/override/test.ptreeover | 4 + .../data}/samples/sample-01.html.pm | 0 .../data}/samples/sample-02.txt.pp | 0 .../data}/samples/sample-03.txt.p | 0 test/data/test-import.html.pm | 6 + test/data/test.html.pm | 4 + test/data/test.html.pmd | 4 + test/data/test.html.pp | 4 + test/data/test.no-ext | 4 + test/data/test.ptree | 4 + {tests => test}/test-langs.rkt | 18 +-- test/test-override.rkt | 45 +++++++ world.rkt | 85 +++++++----- 45 files changed, 384 insertions(+), 214 deletions(-) create mode 100644 test/data/override/directory-require.rkt create mode 100644 test/data/override/test-cmd.html.ppover create mode 100644 test/data/override/test-exports.html.ppover create mode 100644 test/data/override/test-require.html.pmover rename {test-support => test/data/override}/test.html.pm (100%) rename {test-support => test/data/override}/test.html.pmd (100%) rename test-support/test.html.pp => test/data/override/test.html.pmdover (100%) rename test-support/test.no-ext => test/data/override/test.html.pmover (100%) rename test-support/test.ptree => test/data/override/test.html.pp (100%) create mode 100644 test/data/override/test.html.ppover create mode 100644 test/data/override/test.no-ext create mode 100644 test/data/override/test.ptree create mode 100644 test/data/override/test.ptreeover rename {test-support => test/data}/samples/sample-01.html.pm (100%) rename {test-support => test/data}/samples/sample-02.txt.pp (100%) rename {test-support => test/data}/samples/sample-03.txt.p (100%) create mode 100644 test/data/test-import.html.pm create mode 100644 test/data/test.html.pm create mode 100644 test/data/test.html.pmd create mode 100644 test/data/test.html.pp create mode 100644 test/data/test.no-ext create mode 100644 test/data/test.ptree rename {tests => test}/test-langs.rkt (67%) create mode 100644 test/test-override.rkt diff --git a/cache.rkt b/cache.rkt index 8c04dd8..075a18c 100644 --- a/cache.rkt +++ b/cache.rkt @@ -7,7 +7,7 @@ (provide reset-cache current-cache make-cache cached-require cache-ref) (define (get-cache-file-path) - (build-path (world:current-project-root) world:cache-filename)) + (build-path (world:current-project-root) (world:get-cache-filename))) (define (make-cache) (define cache-file-path (get-cache-file-path)) @@ -37,16 +37,16 @@ (hash-set! (current-cache) path (make-hash)) (define cache-hash (cache-ref path)) (hash-set! cache-hash 'mod-time (file-or-directory-modify-seconds path)) - (hash-set! cache-hash world:main-pollen-export (dynamic-require path world:main-pollen-export)) - (hash-set! cache-hash world:meta-pollen-export (dynamic-require path world:meta-pollen-export)) + (hash-set! cache-hash (world:get-main-export) (dynamic-require path (world:get-main-export))) + (hash-set! cache-hash (world:get-meta-export) (dynamic-require path (world:get-meta-export))) (write-to-file (serialize (current-cache)) (get-cache-file-path) #:exists 'replace) (void)) (define (cached-require path-string key) - (when (not (current-cache)) (error "cached-require: No cache set up.")) + (when (not (current-cache)) (error 'cached-require "No cache set up.")) (define path - (with-handlers ([exn:fail? (λ(exn) (error (format "cached-require: ~a is not a valid path" path-string)))]) + (with-handlers ([exn:fail? (λ(exn) (error 'cached-require (format "~a is not a valid path" path-string)))]) (->complete-path path-string))) (when (not (file-exists? path)) (error (format "cached-require: ~a does not exist" (path->string path)))) diff --git a/command.rkt b/command.rkt index e220254..08e0bf2 100644 --- a/command.rkt +++ b/command.rkt @@ -18,7 +18,12 @@ render [dir] [dest] render project in dir (default is current dir) render filename render filename only (can be source or output name) publish copy project to desktop without source files publish [dir] [dest] copy project in dir to dest without source files - (warning: overwrites existing dest dir)" ,(world:current-server-port)))) + (warning: overwrites existing dest dir) +version print the version (~a)" ,(world:current-server-port) ,(world:get-pollen-version)))) + + +(define (handle-version) + `(displayln ,(world:get-pollen-version))) (define (handle-render path-args) @@ -64,7 +69,7 @@ publish [dir] [dest] copy project in dir to dest without source files (define (handle-publish directory rest-args arg-command-name) (define target-path (or (and rest-args (not (null? rest-args)) (path->complete-path (string->path (car rest-args)))) - (build-path (find-system-path 'desk-dir) (string->path (if (equal? arg-command-name "clone") "clone" world:publish-directory-name))))) + (build-path (find-system-path 'desk-dir) (string->path (if (equal? arg-command-name "clone") "clone" (world:get-publish-directory-name)))))) `(begin (require racket/file pollen/file racket/list) diff --git a/convert.rkt b/convert.rkt index ba7dd8a..f72a905 100644 --- a/convert.rkt +++ b/convert.rkt @@ -12,7 +12,7 @@ (cond [(and p-breaks (txexpr? x) (equal? (car x) 'p) (apply string-append `("\n" ,@(map ->string (map loop (get-elements x))) "\n")))] [(txexpr? x) (apply string-append - (map ->string `(,world:command-marker ,(get-tag x) + (map ->string `(,(world:get-command-char) ,(get-tag x) ,@(if (not (null? (get-attrs x))) `("[" ,(attrs->pollen (get-attrs x)) "]") null) ,@(if (not (null? (get-elements x))) `("{" ,@(map loop (get-elements x)) "}" ) null))))] [(symbol? x) (loop (entity->integer x))] diff --git a/decode.rkt b/decode.rkt index 9fd5f10..eca584e 100644 --- a/decode.rkt +++ b/decode.rkt @@ -280,7 +280,7 @@ ;; turn the right items into
tags (define+provide/contract (detect-linebreaks xc - #:separator [newline world:linebreak-separator] + #:separator [newline (world:get-linebreak-separator)] #:insert [linebreak '(br)]) ((txexpr-elements?) (#:separator string? #:insert xexpr?) . ->* . txexpr-elements?) ;; todo: should this test be not block + not whitespace? @@ -334,7 +334,7 @@ ;; is x a paragraph break? -(define+provide/contract (paragraph-break? x #:separator [sep world:paragraph-separator]) +(define+provide/contract (paragraph-break? x #:separator [sep (world:get-paragraph-separator)]) ((any/c) (#:separator pregexp?) . ->* . coerce/boolean?) (define paragraph-pattern (pregexp (format "^~a+$" sep))) (and (string? x) (regexp-match paragraph-pattern x))) @@ -342,7 +342,7 @@ (define (newline? x) - (and (string? x) (equal? world:newline x))) + (and (string? x) (equal? (world:get-newline) x))) (define (not-newline? x) (not (newline? x))) @@ -379,7 +379,7 @@ ;; detect paragraphs ;; todo: unit tests (define+provide/contract (detect-paragraphs elements #:tag [tag 'p] - #:separator [sep world:paragraph-separator] + #:separator [sep (world:get-paragraph-separator)] #:linebreak-proc [linebreak-proc detect-linebreaks] #:force? [force-paragraph #f]) ((txexpr-elements?) (#:tag symbol? #:separator string? #:linebreak-proc (txexpr-elements? . -> . txexpr-elements?) #:force? boolean?) diff --git a/file.rkt b/file.rkt index 4a550e4..91d7597 100644 --- a/file.rkt +++ b/file.rkt @@ -50,7 +50,7 @@ (syntax-case stx () [(_ stem) (let ([stem-datum (syntax->datum #'stem)]) - (with-syntax ([file-ext (format-id stx "world:~a-source-ext" #'stem)] + (with-syntax ([world:get-stem-source-ext (format-id stx "world:get-~a-source-ext" #'stem)] [stem-source? (format-id stx "~a-source?" #'stem)] [get-stem-source (format-id stx "get-~a-source" #'stem)] [has-stem-source? (format-id stx "has-~a-source?" #'stem)] @@ -60,7 +60,7 @@ #`(begin ;; does file have particular extension (define+provide (stem-source? x) - (->boolean (and (pathish? x) (has-ext? (->path x) file-ext)))) + (->boolean (and (pathish? x) (has-ext? (->path x) (world:get-stem-source-ext))))) (define+provide (get-stem-source x) (and (pathish? x) @@ -82,9 +82,9 @@ x #,(if (equal? stem-datum 'scribble) #'(if (x . has-ext? . 'html) ; different logic for scribble sources - (add-ext (remove-ext* x) file-ext) + (add-ext (remove-ext* x) (world:get-stem-source-ext)) #f) - #'(add-ext x file-ext)))) + #'(add-ext x (world:get-stem-source-ext))))) (and result (->path result))) ;; coerce either a source or output file to both @@ -111,8 +111,8 @@ (make-source-utility-functions pagetree) (module-test-external (require pollen/world) - (check-true (pagetree-source? (format "foo.~a" world:pagetree-source-ext))) - (check-false (pagetree-source? (format "~a.foo" world:pagetree-source-ext))) + (check-true (pagetree-source? (format "foo.~a" (world:get-pagetree-source-ext)))) + (check-false (pagetree-source? (format "~a.foo" (world:get-pagetree-source-ext)))) (check-false (pagetree-source? #f))) (make-source-utility-functions markup) @@ -177,7 +177,7 @@ (or (ends-with? (path->string path) "compiled")))) (define+provide (cache-file? path) - (or (ends-with? (path->string path) world:cache-filename))) + (or (ends-with? (path->string path) (world:get-cache-filename)))) (define+provide (pollen-related-file? file) diff --git a/info.rkt b/info.rkt index 9723902..602b602 100644 --- a/info.rkt +++ b/info.rkt @@ -7,4 +7,4 @@ (define scribblings '(("scribblings/pollen.scrbl" (multi-page)))) (define raco-commands '(("pollen" (submod pollen/raco main) "issue Pollen command" #f))) (define compile-omit-paths '("tests" "raco.rkt")) -(define test-omit-paths '("test-support")) +(define test-omit-paths '("tests/data")) diff --git a/main-base.rkt b/main-base.rkt index 2454143..0190f69 100644 --- a/main-base.rkt +++ b/main-base.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require (for-syntax racket/base racket/syntax) pollen/world) +(require (for-syntax racket/base racket/syntax pollen/world) pollen/world) (provide (all-defined-out) (all-from-out pollen/world)) @@ -13,54 +13,59 @@ (define-syntax (new-module-begin stx-arg) (syntax-case stx-arg () [(_ body-exprs (... ...)) - (syntax-protect - #'(#%module-begin - (module inner pollen/doclang-raw - ;; doclang_raw is a version of scribble/doclang with the decoder disabled - ;; first three lines are positional arguments for doclang-raw - doc-raw ; id of export - (λ(x) x) ; post-process function - () ; prepended exprs + (with-syntax ([local-meta-tag-name (format-id stx-arg (symbol->string (world:get-meta-tag-name)))] + [local-doc-export-name (format-id stx-arg (symbol->string (world:get-main-export)))] + [local-metas-export-name (format-id stx-arg (symbol->string (world:get-meta-export)))]) + (syntax-protect + #'(#%module-begin + (module inner pollen/doclang-raw + ;; doclang_raw is a version of scribble/doclang with the decoder disabled + ;; first three lines are positional arguments for doclang-raw + doc-raw ; id of export + (λ(x) x) ; post-process function + () ; prepended exprs + + ;; Change behavior of undefined identifiers with #%top + ;; Get project values from world + (require pollen/top pollen/world) + (provide (all-defined-out) (all-from-out pollen/top pollen/world)) + + body-exprs (... ...)) - ;; Change behavior of undefined identifiers with #%top - ;; Get project values from world - (require pollen/top pollen/world) - (provide (all-defined-out) (all-from-out pollen/top pollen/world)) + (require 'inner racket/list pollen/metas) - body-exprs (... ...)) - - (require 'inner racket/list pollen/metas) - - ;; in an inline module, reader-here-path and parser-mode are undefined - ;; (because there's no reader) - ;; but they'll become tag functions courtesy of #%top - ;; so that's how we can detect if they are undefined - (define here-path (if (procedure? inner:reader-here-path) - "anonymous-module" - inner:reader-here-path)) - (define parser-mode (if (procedure? inner:parser-mode) - mode-arg - inner:parser-mode)) - - (define doc-with-metas - `(placeholder-root - ,@(cons (meta 'here-path: here-path) - (if (list? doc-raw) - (dropf doc-raw (λ(i) (equal? i "\n"))) ; discard all newlines at front of file - doc-raw)))) - (define-values (doc-without-metas metas) (split-metas-to-hash doc-with-metas)) ; split out the metas - - ;; set up the 'doc export - (require pollen/decode) - (define doc (apply (cond - [(equal? parser-mode world:mode-pagetree) (λ xs ((dynamic-require 'pollen/pagetree 'decode-pagetree) xs))] - ;; 'root is the hook for the decoder function. - ;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...) - [(equal? parser-mode world:mode-markup) root] - [(equal? parser-mode world:mode-markdown) (λ xs (apply root (apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) (map to-string xs))))] - ;; for preprocessor output, just make a string. - [else (λ xs (apply string-append (map to-string xs)))]) ; default mode is preprocish - (cdr doc-without-metas))) ;; cdr strips placeholder-root tag - - ;; hide the exports that were only for internal use. - (provide metas doc (except-out (all-from-out 'inner) doc-raw #%top))))]))))])) + ;; in an inline module, reader-here-path and parser-mode are undefined + ;; (because there's no reader) + ;; but they'll become tag functions courtesy of #%top + ;; so that's how we can detect if they are undefined + (define here-path (if (procedure? inner:reader-here-path) + "anonymous-module" + inner:reader-here-path)) + (define parser-mode (if (procedure? inner:parser-mode) + mode-arg + inner:parser-mode)) + + (define doc-with-metas + `(placeholder-root + ,@(cons `(local-meta-tag-name (here-path ,here-path)) + (if (list? doc-raw) + (dropf doc-raw (λ(i) (equal? i "\n"))) ; discard all newlines at front of file + doc-raw)))) + (define-values (doc-without-metas metas) (split-metas-to-hash doc-with-metas)) ; split out the metas + + ;; set up the 'doc export + (require pollen/decode) + (define doc (apply (cond + [(equal? parser-mode world:mode-pagetree) (λ xs ((dynamic-require 'pollen/pagetree 'decode-pagetree) xs))] + ;; 'root is the hook for the decoder function. + ;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...) + [(equal? parser-mode world:mode-markup) root] + [(equal? parser-mode world:mode-markdown) (λ xs (apply root (apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) (map to-string xs))))] + ;; for preprocessor output, just make a string. + [else (λ xs (apply string-append (map to-string xs)))]) ; default mode is preprocish + (cdr doc-without-metas))) ;; cdr strips placeholder-root tag + + ;; hide the exports that were only for internal use. + (provide (rename-out [metas local-metas-export-name]) + (rename-out [doc local-doc-export-name]) + (except-out (all-from-out 'inner) doc-raw #%top)))))]))))])) diff --git a/metas.rkt b/metas.rkt index d9c5b36..ed8c3d2 100644 --- a/metas.rkt +++ b/metas.rkt @@ -9,7 +9,7 @@ (define (possible-meta-element? x) - (and (txexpr? x) (equal? world:meta-tag-name (get-tag x)))) + (and (txexpr? x) (equal? (world:get-meta-tag-name) (get-tag x)))) (define (trivial-meta-element? x) @@ -47,10 +47,11 @@ (or (and (list? x) (symbol? (first x)) (string? (second x))) (error 'is-meta-element? "error: meta must be a symbol / string pair, instead got: ~v" x))) + ;; all metas are converted into "atomic meta" format ;; which is '(meta (key value ...)) (define (make-atomic-meta key . values) - `(meta (,key ,@values))) + `(,(world:get-meta-tag-name) (,key ,@values))) (define (explode-meta-element me) @@ -62,10 +63,10 @@ (cond [(has-meta-attrs me) ; might have txexpr elements, so preserve them (define attrs (get-attrs me)) - (loop (make-txexpr 'meta (cdr attrs) (get-elements me)) (cons (apply make-atomic-meta (car attrs)) acc))] + (loop (make-txexpr (world:get-meta-tag-name) (cdr attrs) (get-elements me)) (cons (apply make-atomic-meta (car attrs)) acc))] [else ; has txexpr elements, but not meta-attrs (define txexpr-elements (get-elements me)) ; elements were filtered for txexpr at loop entry - (loop (make-txexpr 'meta null (cdr txexpr-elements)) (cons (apply make-atomic-meta (car txexpr-elements)) acc))])] + (loop (make-txexpr (world:get-meta-tag-name) null (cdr txexpr-elements)) (cons (apply make-atomic-meta (car txexpr-elements)) acc))])] [else (reverse acc)]))) diff --git a/pagetree.rkt b/pagetree.rkt index b011e3f..841836c 100644 --- a/pagetree.rkt +++ b/pagetree.rkt @@ -38,7 +38,7 @@ (define+provide/contract (decode-pagetree xs) (txexpr-elements? . -> . any/c) ; because pagetree is being explicitly validated (validate-pagetree - (decode (cons world:pagetree-root-node xs) + (decode (cons (world:get-pagetree-root-node) xs) #:txexpr-elements-proc (λ(xs) (filter (compose1 not whitespace?) xs)) #:string-proc string->symbol))) ; because faster than ->pagenode @@ -85,8 +85,8 @@ (define+provide/contract (make-project-pagetree project-dir) (pathish? . -> . pagetree?) (with-handlers ([exn:fail? (λ(exn) (directory->pagetree project-dir))]) - (define pagetree-source (build-path project-dir world:default-pagetree)) - (cached-require pagetree-source world:main-pollen-export))) + (define pagetree-source (build-path project-dir (world:get-default-pagetree))) + (cached-require pagetree-source (world:get-main-export)))) (define+provide/contract (parent pnish [pt (current-pagetree)]) (((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?)) diff --git a/raco.rkt b/raco.rkt index 054f2f9..a996cbd 100644 --- a/raco.rkt +++ b/raco.rkt @@ -35,6 +35,7 @@ [(#f "help") (handle-help)] [("start") (handle-start (path->directory-path first-arg-or-current-dir) port-arg)] [("render") (handle-render (cons first-arg-or-current-dir (map very-nice-path (cdr (vector->list (current-command-line-arguments))))))] + [("version") (handle-version)] [("clone" "publish") (handle-publish first-arg-or-current-dir rest-args arg-command-name)] [else (handle-else arg-command-name)])))) diff --git a/reader-base.rkt b/reader-base.rkt index a84688e..327dc70 100644 --- a/reader-base.rkt +++ b/reader-base.rkt @@ -14,9 +14,9 @@ (λ (path-string p) (define read-inner (make-at-reader #:command-char (if (or (equal? reader-mode world:mode-template) - (and (string? path-string) (regexp-match (pregexp (format "\\.~a$" world:template-source-ext)) path-string))) - world:template-command-marker - world:command-marker) + (and (string? path-string) (regexp-match (pregexp (format "\\.~a$" (world:get-template-source-ext))) path-string))) + (world:get-template-command-char) + (world:get-command-char)) #:syntax? #t #:inside? #t)) (define file-contents (read-inner path-string p)) @@ -33,9 +33,9 @@ (let* ([file-ext-pattern (pregexp "\\w+$")] [here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))]) (cond - [(equal? here-ext world:pagetree-source-ext) world:mode-pagetree] - [(equal? here-ext world:markup-source-ext) world:mode-markup] - [(equal? here-ext world:markdown-source-ext) world:mode-markdown] + [(equal? here-ext (world:get-pagetree-source-ext)) world:mode-pagetree] + [(equal? here-ext (world:get-markup-source-ext)) world:mode-markup] + [(equal? here-ext (world:get-markdown-source-ext)) world:mode-markdown] [else world:mode-preproc])) reader-mode)) ;; change names of exports for local use @@ -52,9 +52,9 @@ (module+ main (require txexpr racket/string) (if (or (equal? inner:parser-mode world:mode-preproc) (equal? inner:parser-mode world:mode-template)) - (display doc) + (display ,(world:get-main-export)) (print (with-handlers ([exn:fail? (λ(exn) ((error '|pollen markup error| (string-join (cdr (string-split (exn-message exn) ": ")) ": "))))]) - (validate-txexpr doc)))))) + (validate-txexpr ,(world:get-main-export))))))) file-contents))) diff --git a/render.rkt b/render.rkt index 95f7513..9bfb700 100644 --- a/render.rkt +++ b/render.rkt @@ -34,7 +34,7 @@ (module-test-internal (require racket/runtime-path) - (define-runtime-path sample-dir "test-support/samples") + (define-runtime-path sample-dir "test/data/samples") (define samples (parameterize ([current-directory sample-dir]) (map path->complete-path (directory-list ".")))) (define-values (sample-01 sample-02 sample-03) (apply values samples)) @@ -89,7 +89,7 @@ ((or/c pagetree? pathish?) . -> . void?) (define pagetree (if (pagetree? pagetree-or-path) pagetree-or-path - (cached-require pagetree-or-path world:main-pollen-export))) + (cached-require pagetree-or-path (world:get-main-export)))) (parameterize ([current-directory (world:current-project-root)]) (for-each render-from-source-or-output-path (map ->complete-path (pagetree->list pagetree))))) @@ -177,7 +177,7 @@ (file-needed-rerequire? source-path) ; called for its reqrequire side effect only, so dynamic-require below isn't cached (time (parameterize ([current-directory (->complete-path source-dir)]) ;; BTW this next action has side effects: scribble will copy in its core files if they don't exist. - ((dynamic-require 'scribble/render 'render) (list (dynamic-require source-path world:main-pollen-export)) (list source-path)))) + ((dynamic-require 'scribble/render 'render) (list (dynamic-require source-path (world:get-main-export))) (list source-path)))) (define result (file->string (->output-path source-path))) (delete-file (->output-path source-path)) ; because render promises the data, not the side effect result) @@ -187,7 +187,7 @@ (complete-path? . -> . (or/c string? bytes?)) (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)))))) + (render-through-eval `(begin (require pollen/cache)(cached-require ,source-path ',(world:get-main-export))))))) (define/contract (render-markup-or-markdown-source source-path [maybe-template-path #f]) @@ -200,14 +200,14 @@ (require (for-syntax racket/base)) (require pollen/include-template pollen/cache pollen/debug) ,(require-directory-require-files source-path) - (let ([doc (cached-require ,(path->string source-path) ',world:main-pollen-export)] - [metas (cached-require ,(path->string source-path) ',world:meta-pollen-export)]) + (let ([,(world:get-main-export) (cached-require ,(path->string source-path) ',(world:get-main-export))] + [,(world:get-meta-export) (cached-require ,(path->string source-path) ',(world:get-meta-export))]) (local-require pollen/pagetree pollen/template pollen/top) - (define here (metas->here metas)) + (define here (metas->here ,(world:get-meta-export))) (cond - [(bytes? doc) doc] ; if doc is binary, just pass it through + [(bytes? ,(world:get-main-export)) ,(world:get-main-export)] ; if main export is binary, just pass it through [else - (include-template #:command-char ,world:command-marker (file ,(->string (find-relative-path source-dir template-path))))])))) + (include-template #:command-char ,(world:get-command-char) (file ,(->string (find-relative-path source-dir template-path))))])))) (time (parameterize ([current-directory source-dir]) ; because include-template wants to work relative to source location (render-through-eval expr-to-eval)))) @@ -227,12 +227,12 @@ (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 ((->symbol world:template-meta-key) . in? . source-metas) - (build-path source-dir (select-from-metas (->string world:template-meta-key) source-metas))))) ; path based on metas + (let ([source-metas (cached-require source-path (world:get-meta-export))]) + (and ((->symbol (world:get-template-meta-key)) . in? . source-metas) + (build-path source-dir (select-from-metas (->string (world:get-template-meta-key)) source-metas))))) ; path based on metas (and (filename-extension output-path) (build-path (world:current-project-root) - (add-ext world:default-template-prefix (get-ext output-path))))))) ; path to default template - (and (filename-extension output-path) (build-path (world:current-server-extras-path) (add-ext world:fallback-template-prefix (get-ext output-path)))))))) ; fallback template + (add-ext (world:get-default-template-prefix) (get-ext output-path))))))) ; path to default template + (and (filename-extension output-path) (build-path (world:current-server-extras-path) (add-ext (world:get-fallback-template-prefix) (get-ext output-path)))))))) ; fallback template (define/contract (file-needed-rerequire? source-path) diff --git a/scribblings/cache.scrbl b/scribblings/cache.scrbl index c07604e..9e4784b 100644 --- a/scribblings/cache.scrbl +++ b/scribblings/cache.scrbl @@ -9,7 +9,7 @@ @defmodule[pollen/cache] -The slowest part of a @racket[render] is parsing and decoding the source file. Often, previewing a single source file necessarily means decoding others (for instance templates, or other source files that are linked into the main source file). But usually, only one source file is changing at a time. Therefore, Pollen stores copies of the exports of source files — namely, whatever is stored in @code[(format "~a" world:main-pollen-export)] and @code[(format "~a" world:meta-pollen-export)] — in the cache so they can be reused. +The slowest part of a @racket[render] is parsing and decoding the source file. Often, previewing a single source file necessarily means decoding others (for instance templates, or other source files that are linked into the main source file). But usually, only one source file is changing at a time. Therefore, Pollen stores copies of the exports of source files — namely, whatever is stored in @code[(format "~a" world:main-export)] and @code[(format "~a" world:meta-export)] — in the cache so they can be reused. @defparam[current-cache hash hash?]{A parameter that refers to the current cache. It is initialized with @racket[make-cache]. diff --git a/scribblings/mb-tools.rkt b/scribblings/mb-tools.rkt index ce673eb..0a2b1dd 100644 --- a/scribblings/mb-tools.rkt +++ b/scribblings/mb-tools.rkt @@ -55,4 +55,16 @@ (with-syntax ([id (generate-temporary)]) #'(begin (define-runtime-path id name) - (image id xs ...)))])) \ No newline at end of file + (image id xs ...)))])) + + +(require (for-syntax racket/syntax)) +(define-syntax (defoverridable stx) + (syntax-case stx () + [(_ name predicate? desc ...) + (with-syntax ([world:name (format-id stx "world:~a" #'name)] + [world:get-name (format-id stx "world:get-~a" #'name)] + [local:name (format-id stx "local:~a" #'name)]) + #'(deftogether ((defthing world:name predicate?) + (defproc (world:get-name) predicate?)) + desc ...))])) \ No newline at end of file diff --git a/scribblings/raco.scrbl b/scribblings/raco.scrbl index 9915f88..f6eb777 100644 --- a/scribblings/raco.scrbl +++ b/scribblings/raco.scrbl @@ -93,6 +93,7 @@ Make a copy of the project directory on the desktop, but without any source file If you're already in your project directory and want to publish somewhere other than the desktop, use @racket[raco pollen publish _. _dest-dir]. +@section{@racket[raco pollen version]} - +Would you believe this prints the Pollen version number. diff --git a/scribblings/tutorial-second.scrbl b/scribblings/tutorial-second.scrbl index 52f4c6f..e83fe5d 100644 --- a/scribblings/tutorial-second.scrbl +++ b/scribblings/tutorial-second.scrbl @@ -331,7 +331,7 @@ But within a template, we need to tell Pollen how we want to convert the X-expre Third, we need to include the content from our source file. By convention, every Pollen source file makes its output available through an exported variable named @code{doc}. A source file in preprocessor mode puts its text result in @code{doc}. And a source file in authoring mode puts its X-expression result in @code{doc}. So we put the variable @code{doc} inside the @code{body} tag. -@margin-note{You can change the name to something other than @code{doc} by changing @racket[world:main-pollen-export].} +@margin-note{You can change the name to something other than @code{doc} by changing @racket[world:main-export].} @codeblock[#:keep-lang-line? #f]{ #lang pollen diff --git a/scribblings/world.scrbl b/scribblings/world.scrbl index c9c7d55..38d05d8 100644 --- a/scribblings/world.scrbl +++ b/scribblings/world.scrbl @@ -1,5 +1,5 @@ #lang scribble/manual - +@(require "mb-tools.rkt") @(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/render)) @(define my-eval (make-base-eval)) @@ -9,43 +9,76 @@ @defmodule[pollen/world] -A set of global values and parameters that are used throughout the Pollen system. If you don't like the defaults I've picked, change them. +Global values that are used throughout the Pollen system. -All identifiers are exported with the prefix @racket[world:], and are so documented below. +@section{Parameters} +I mean @italic{parameters} in the Racket sense, i.e. values that can be fed to @racket[parameterize]. -@defthing[world:default-port integer?] @defparam[world:current-server-port port integer?]{ -A parameter that sets the HTTP port for the project server. Initialized to @racket[world:default-port], which defaults to 8080.} +A parameter that sets the HTTP port for the project server. Initialized to @racket[world:default-port].} -@deftogether[( -@defthing[world:main-pollen-export symbol?] -@defthing[world:meta-pollen-export symbol?] -)] -The two exports from a compiled Pollen source file. Initialized to @racket['doc] and @racket['metas], respectively. +@defparam[world:current-project-root port path?]{ +A parameter that holds the root directory of the current project (e.g., the directory where you launched @code{raco pollen start}).} + +@defparam[world:current-server-extras-path dir path?]{ +A parameter that reports the path to the directory of support files for the project server. Initialized to @racket[#f], but set to a proper value when the server runs.} -@(defthing world:directory-require string?) -File implicitly required into every Pollen source file from its directory. Initialized to @filepath{directory-require.rkt}. @defparam[world:check-directory-requires-in-render? check? boolean?]{ A parameter that determines whether the @racket[world:directory-require] file is checked for changes on every pass through @racket[render]. (Can be faster to turn this off if you don't need it.) Initialized to @racket[#t].} -@defthing[world:server-extras-dir string?] -Name of directory where server support files live. Initialized to @tt{server-extras}. -@defparam[world:current-server-extras-path dir path?]{ -A parameter that reports the path to the directory of support files for the project server. Initialized to @racket[#f], but set to a proper value when the server runs.} + + +@section{Values that can be overwritten with @racket[local:]} + +These values can be changed by overriding them in your @racket["directory-require.rkt"] source file. Use @racket[define] to make a variable with the same name as the one in @racket[pollen/world], but with the prefix @racket[local:] instead of @racket[world:]. Assign it whatever value you like. When Pollen runs, these definitions will supersede those in @racket[pollen/world]. + +For instance, suppose you wanted the main export of every Pollen source file to be called @racket[van-halen] rather than @racket[doc], the extension of Pollen markup files to be @racket[rock] rather than @racket[pm], and the command character to be @litchar{🎸} instead of @litchar{◊}. Your @racket["directory-require.rkt"] would include these defintions: + +@fileblock["directory-require.rkt" +@codeblock{ +#lang racket/base +(provide (all-defined-out)) +(define local:main-export 'van-halen) +(define local:markup-source-ext 'rock) +(define local:command-char #\🎸) +}] + +Though any of the values below can be overridden, it may not always be wise to do so. For instance, if you redefined @racket[world:fallback-template-prefix], you would simply break the fallback-template mechanism, because it would look for files that don't exist. But we don't live in a nanny state, so you are entrusted to say what you mean and accept the consequences. + +Of course, you can restore the defaults simply by deleting these defined values from @racket["directory-require.rkt"]. + +These overridable values also come with a corresponding @racket[get-] function that will return the @racket[local:] value if it exists, otherwise the @racket[world:] value. In the example above, @racket[world:command-char] would be @litchar{◊} no matter what, but @racket[world:get-command-char] would return @litchar{🎸}. + + +@defoverridable[default-port integer?]{ +Determines the default HTTP port for the project server. Initialized to @racket[8080].} + + +@defoverridable[main-export symbol?]{The main X-expression exported from a compiled Pollen source file. Initialized to @racket[doc].} + +@defoverridable[meta-export symbol?]{The meta hashtable exported from a compiled Pollen source file. Initialized to @racket[metas].} + +@defoverridable[world:meta-tag-name symbol?]{Name of the tag used to mark metas within Pollen source.} + +@defoverridable[world:directory-require string?]{File implicitly required into every Pollen source file from its directory. Initialized to @filepath{directory-require.rkt}.} + +@defoverridable[world:server-extras-dir string?]{Name of directory where server support files live. Initialized to @tt{server-extras}.} + + @deftogether[( -@defthing[world:preproc-source-ext symbol?] -@defthing[world:markup-source-ext symbol?] -@defthing[world:markdown-source-ext symbol?] -@defthing[world:null-source-ext symbol?] -@defthing[world:pagetree-source-ext symbol?] -@defthing[world:template-source-ext symbol?] -@defthing[world:scribble-source-ext symbol?] +@defoverridable[preproc-source-ext symbol?] +@defoverridable[markup-source-ext symbol?] +@defoverridable[markdown-source-ext symbol?] +@defoverridable[null-source-ext symbol?] +@defoverridable[pagetree-source-ext symbol?] +@defoverridable[template-source-ext symbol?] +@defoverridable[scribble-source-ext symbol?] )] File extensions for Pollen source files, initialized to the following values: @@ -58,53 +91,32 @@ File extensions for Pollen source files, initialized to the following values: @(linebreak)@racket[world:scribble-source-ext] = @code[(format "'~a" world:scribble-source-ext)] -@defthing[world:decodable-extensions (listof symbol?)] -File extensions that are eligible for decoding. +@defoverridable[decodable-extensions (listof symbol?)]{File extensions that are eligible for decoding.} -@deftogether[( -@(defthing world:mode-auto symbol?) -@(defthing world:mode-preproc symbol?) -@(defthing world:mode-markup symbol?) -@(defthing world:mode-markdown symbol?) -@(defthing world:mode-pagetree symbol?) -)] -Mode indicators for the Pollen reader and parser. Initialized to the following values: +@defoverridable[default-pagetree string?]{Pagetree that Pollen dashboard loads by default in each directory. Initialized to @filepath{index.ptree}.} + -@racket[world:mode-auto] = @code[(format "'~a" world:mode-auto)] -@(linebreak)@racket[world:mode-preproc] = @code[(format "'~a" world:mode-preproc)] -@(linebreak)@racket[world:mode-markup] = @code[(format "'~a" world:mode-markup)] -@(linebreak)@racket[world:mode-markdown] = @code[(format "'~a" world:mode-markdown)] -@(linebreak)@racket[world:mode-pagetree] = @code[(format "'~a" world:mode-pagetree)] +@defoverridable[pagetree-root-node symbol?]{Name of the root node in a decoded pagetree. It's ignored by the code, so its only role is to clue you in that you're looking at something that came out of the pagetree decoder. Initialized to @code{'pagetree-root}.} -@defthing[world:default-pagetree string?] -Pagetree that Pollen dashboard loads by default in each directory. Initialized to @filepath{index.ptree}. -@defthing[world:pagetree-root-node symbol?] -Name of the root node in a decoded pagetree. It's ignored by the code, so its only role is to clue you in that you're looking at something that came out of the pagetree decoder. Initialized to @code{'pagetree-root}. +@defoverridable[command-char char?]{The magic character that indicates a Pollen command, function, or variable. Initialized to @racket[#\◊].} +@defoverridable[default-template-prefix string?]{Prefix of the default template. Initialized to @code{"template"}.} -@defthing[world:command-marker char?] -The magic character that indicates a Pollen command, function, or variable. Initialized to @racket[#\◊]. -@defthing[world:default-template-prefix string?] -Prefix of the default template. Initialized to @code{"template"}. +@defoverridable[fallback-template-prefix string?]{Used to generate the name of the fallback template (i.e., the template used to render a Pollen markup file when no other template can be found). Prefix is combined with the output suffix of the source file. Initialized to @code{"fallback"}.} -@defthing[world:fallback-template-prefix string?] -Used to generate the name of the fallback template (i.e., the template used to render a Pollen markup file when no other template can be found). Prefix is combined with the output suffix of the source file. Initialized to @code{"fallback"}. -@defthing[world:template-meta-key symbol?] -Meta key used to store a template name for that particular source file. Initialized to @racket['template]. +@defoverridable[template-meta-key symbol?]{Meta key used to store a template name for that particular source file. Initialized to @racket['template].} @deftogether[( -@(defthing world:newline string?) -@(defthing world:linebreak-separator string?) -@(defthing world:paragraph-separator string?) +@(defoverridable world:newline string?) +@(defoverridable world:linebreak-separator string?) +@(defoverridable world:paragraph-separator string?) )] Default separators used in decoding. The first two are initialized to @racket["\n"]; the third to @racket["\n\n"]. -@(defthing world:dashboard-css string?) -CSS file used for the dashboard. Initialized to @filepath{poldash.css}. +@defoverridable[dashboard-css string?]{CSS file used for the dashboard. Initialized to @filepath{poldash.css}.} -@(defthing world:paths-excluded-from-dashboard (listof path?)) -Paths not shown in the Pollen dashboard. +@defoverridable[paths-excluded-from-dashboard (listof path?)]{Paths not shown in the Pollen dashboard.} \ No newline at end of file diff --git a/server-routes.rkt b/server-routes.rkt index d20f0ff..87d5849 100644 --- a/server-routes.rkt +++ b/server-routes.rkt @@ -25,7 +25,7 @@ (meta ([charset "UTF-8"])) (link ([rel "stylesheet"] [type "text/css"] - [href ,(format "/~a" world:dashboard-css)]))) + [href ,(format "/~a" (world:get-dashboard-css))]))) (body ,content-xexpr (div ((id "pollen-logo")))))) @@ -41,7 +41,7 @@ (define client (request-client-ip req)) (define localhost-client "::1") (define url-string (url->string (request-uri req))) - (message "request:" (string-replace url-string world:default-pagetree " dashboard") + (message "request:" (string-replace url-string (world:get-default-pagetree) " dashboard") (if (not (equal? client localhost-client)) (format "from ~a" client) ""))) ;; pass string args to route, then @@ -61,7 +61,7 @@ ((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:main-pollen-export)) + (dynamic-require path (world:get-main-export))) ;; todo: rewrite this test, obsolete since filename convention changed ;;(module+ test @@ -160,7 +160,7 @@ (define dirlinks (cons "/" (map (λ(ps) (format "/~a/" (apply build-path ps))) (for/list ([i (in-range (length (cdr dirs)))]) (take (cdr dirs) (add1 i)))))) - `(tr (th ((colspan "3")) ,@(add-between (map (λ(dir dirlink) `(a ((href ,(format "~a~a" dirlink world:default-pagetree))) ,(->string dir))) dirs dirlinks) "/")))) + `(tr (th ((colspan "3")) ,@(add-between (map (λ(dir dirlink) `(a ((href ,(format "~a~a" dirlink (world:get-default-pagetree)))) ,(->string dir))) dirs dirlinks) "/")))) (define (make-path-row filename-path) (define filename (->string filename-path)) @@ -170,7 +170,7 @@ (append (list (cond ; main cell [(directory-exists? (build-path dashboard-dir filename)) ; links subdir to its dashboard - (cons (format "~a/~a" filename world:default-pagetree) (format "~a/" filename))] + (cons (format "~a/~a" filename (world:get-default-pagetree)) (format "~a/" filename))] [(and source (equal? (get-ext source) "scrbl")) (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) " (from " ,(->string (find-relative-path dashboard-dir source)) ")")))] [source (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) "." ,(get-ext source))))] @@ -186,12 +186,12 @@ [(pagetree-source? filename) empty-cell] [else (cons (format "out/~a" filename) "out")])))))) - (define (ineligible-path? x) (member x world:paths-excluded-from-dashboard)) + (define (ineligible-path? x) (member x (world:get-paths-excluded-from-dashboard))) (define project-paths (filter-not ineligible-path? (map ->path (pagetree->list (if (file-exists? dashboard-ptree) - (cached-require (->path dashboard-ptree) world:main-pollen-export) + (cached-require (->path dashboard-ptree) (world:get-main-export)) (directory->pagetree dashboard-dir)))))) (body-wrapper #:title (format "~a" dashboard-dir) diff --git a/server.rkt b/server.rkt index a1e9ac0..9e0fd14 100755 --- a/server.rkt +++ b/server.rkt @@ -20,12 +20,12 @@ [((string-arg) ... "xexpr" (string-arg)) route-xexpr] [else route-default])) - (message (format "Welcome to Pollen ~a" world:pollen-version) (format "(Racket ~a)" (version))) + (message (format "Welcome to Pollen ~a" (world:get-pollen-version)) (format "(Racket ~a)" (version))) (message (format "Project root is ~a" (world:current-project-root))) (define server-name (format "http://localhost:~a" (world:current-server-port))) (message (format "Project server is ~a" server-name) "(Ctrl-C to exit)") - (message (format "Project dashboard is ~a/~a" server-name world:default-pagetree)) + (message (format "Project dashboard is ~a/~a" server-name (world:get-default-pagetree))) (message "Ready to rock") (parameterize ([error-print-width 1000] diff --git a/template.rkt b/template.rkt index 792df99..95dd30e 100644 --- a/template.rkt +++ b/template.rkt @@ -24,8 +24,8 @@ (define doc-result (select-from-doc key value-source)) (and doc-result (car doc-result))) (cond - [(or (hash? value-source) (equal? value-source world:meta-pollen-export)) (select-from-metas key value-source)] - [(equal? value-source world:main-pollen-export) (do-doc-result)] + [(or (hash? value-source) (equal? value-source (world:get-meta-export))) (select-from-metas key value-source)] + [(equal? value-source (world:get-main-export)) (do-doc-result)] [else (define metas-result (and (not (txexpr? value-source)) (select-from-metas key value-source))) (or metas-result (do-doc-result))])) @@ -86,7 +86,7 @@ [(pagenode? pagenode-or-path) (pagenode->path pagenode-or-path)] [else pagenode-or-path]))) (if source-path - (cached-require source-path world:meta-pollen-export) + (cached-require source-path (world:get-meta-export)) (error (format "get-metas: no source found for '~a' in directory ~a" pagenode-or-path (current-directory))))) @@ -96,7 +96,7 @@ [(pagenode? pagenode-or-path) (pagenode->path pagenode-or-path)] [else pagenode-or-path]))) (if source-path - (cached-require source-path world:main-pollen-export) + (cached-require source-path (world:get-main-export)) (error (format "get-doc: no source found for '~a' in directory ~a" pagenode-or-path (current-directory))))) diff --git a/test/data/override/directory-require.rkt b/test/data/override/directory-require.rkt new file mode 100644 index 0000000..734b0f0 --- /dev/null +++ b/test/data/override/directory-require.rkt @@ -0,0 +1,18 @@ +#lang racket/base +(provide (all-defined-out)) + +(define (root . xs) + `(rootover ,@xs)) + +(define local:pollen-version "42") + +(define local:preproc-source-ext 'ppover) +(define local:markup-source-ext 'pmover) +(define local:markdown-source-ext 'pmdover) +(define local:null-source-ext 'p) +(define local:pagetree-source-ext 'ptreeover) + +(define local:command-char #\∆) +(define local:main-export 'docover) +(define local:meta-export 'metasover) +(define local:meta-tag-name 'metaover) \ No newline at end of file diff --git a/test/data/override/test-cmd.html.ppover b/test/data/override/test-cmd.html.ppover new file mode 100644 index 0000000..926afcf --- /dev/null +++ b/test/data/override/test-cmd.html.ppover @@ -0,0 +1,2 @@ +#lang pollen +∆(number->string (+ 1 1)) \ No newline at end of file diff --git a/test/data/override/test-exports.html.ppover b/test/data/override/test-exports.html.ppover new file mode 100644 index 0000000..cda7b58 --- /dev/null +++ b/test/data/override/test-exports.html.ppover @@ -0,0 +1,3 @@ +#lang pollen +∆metaover{∆dog{Roxy}} +∆(number->string (+ 1 1)) \ No newline at end of file diff --git a/test/data/override/test-require.html.pmover b/test/data/override/test-require.html.pmover new file mode 100644 index 0000000..c5ead49 --- /dev/null +++ b/test/data/override/test-require.html.pmover @@ -0,0 +1,2 @@ +#lang pollen +foobar \ No newline at end of file diff --git a/test-support/test.html.pm b/test/data/override/test.html.pm similarity index 100% rename from test-support/test.html.pm rename to test/data/override/test.html.pm diff --git a/test-support/test.html.pmd b/test/data/override/test.html.pmd similarity index 100% rename from test-support/test.html.pmd rename to test/data/override/test.html.pmd diff --git a/test-support/test.html.pp b/test/data/override/test.html.pmdover similarity index 100% rename from test-support/test.html.pp rename to test/data/override/test.html.pmdover diff --git a/test-support/test.no-ext b/test/data/override/test.html.pmover similarity index 100% rename from test-support/test.no-ext rename to test/data/override/test.html.pmover diff --git a/test-support/test.ptree b/test/data/override/test.html.pp similarity index 100% rename from test-support/test.ptree rename to test/data/override/test.html.pp diff --git a/test/data/override/test.html.ppover b/test/data/override/test.html.ppover new file mode 100644 index 0000000..4cec105 --- /dev/null +++ b/test/data/override/test.html.ppover @@ -0,0 +1,4 @@ +#lang pollen + +test +==== \ No newline at end of file diff --git a/test/data/override/test.no-ext b/test/data/override/test.no-ext new file mode 100644 index 0000000..4cec105 --- /dev/null +++ b/test/data/override/test.no-ext @@ -0,0 +1,4 @@ +#lang pollen + +test +==== \ No newline at end of file diff --git a/test/data/override/test.ptree b/test/data/override/test.ptree new file mode 100644 index 0000000..4cec105 --- /dev/null +++ b/test/data/override/test.ptree @@ -0,0 +1,4 @@ +#lang pollen + +test +==== \ No newline at end of file diff --git a/test/data/override/test.ptreeover b/test/data/override/test.ptreeover new file mode 100644 index 0000000..4cec105 --- /dev/null +++ b/test/data/override/test.ptreeover @@ -0,0 +1,4 @@ +#lang pollen + +test +==== \ No newline at end of file diff --git a/test-support/samples/sample-01.html.pm b/test/data/samples/sample-01.html.pm similarity index 100% rename from test-support/samples/sample-01.html.pm rename to test/data/samples/sample-01.html.pm diff --git a/test-support/samples/sample-02.txt.pp b/test/data/samples/sample-02.txt.pp similarity index 100% rename from test-support/samples/sample-02.txt.pp rename to test/data/samples/sample-02.txt.pp diff --git a/test-support/samples/sample-03.txt.p b/test/data/samples/sample-03.txt.p similarity index 100% rename from test-support/samples/sample-03.txt.p rename to test/data/samples/sample-03.txt.p diff --git a/test/data/test-import.html.pm b/test/data/test-import.html.pm new file mode 100644 index 0000000..9012507 --- /dev/null +++ b/test/data/test-import.html.pm @@ -0,0 +1,6 @@ +#lang pollen +◊(require (prefix-in foo: "samples/sample-01.html.pm")) + +test +==== +◊|foo:doc| \ No newline at end of file diff --git a/test/data/test.html.pm b/test/data/test.html.pm new file mode 100644 index 0000000..4cec105 --- /dev/null +++ b/test/data/test.html.pm @@ -0,0 +1,4 @@ +#lang pollen + +test +==== \ No newline at end of file diff --git a/test/data/test.html.pmd b/test/data/test.html.pmd new file mode 100644 index 0000000..4cec105 --- /dev/null +++ b/test/data/test.html.pmd @@ -0,0 +1,4 @@ +#lang pollen + +test +==== \ No newline at end of file diff --git a/test/data/test.html.pp b/test/data/test.html.pp new file mode 100644 index 0000000..4cec105 --- /dev/null +++ b/test/data/test.html.pp @@ -0,0 +1,4 @@ +#lang pollen + +test +==== \ No newline at end of file diff --git a/test/data/test.no-ext b/test/data/test.no-ext new file mode 100644 index 0000000..4cec105 --- /dev/null +++ b/test/data/test.no-ext @@ -0,0 +1,4 @@ +#lang pollen + +test +==== \ No newline at end of file diff --git a/test/data/test.ptree b/test/data/test.ptree new file mode 100644 index 0000000..4cec105 --- /dev/null +++ b/test/data/test.ptree @@ -0,0 +1,4 @@ +#lang pollen + +test +==== \ No newline at end of file diff --git a/tests/test-langs.rkt b/test/test-langs.rkt similarity index 67% rename from tests/test-langs.rkt rename to test/test-langs.rkt index 2419149..25c8064 100644 --- a/tests/test-langs.rkt +++ b/test/test-langs.rkt @@ -1,4 +1,4 @@ -#lang racket/base +#lang at-exp racket/base (require rackunit racket/port racket/system racket/runtime-path compiler/find-exe) (module test-default pollen @@ -32,21 +32,23 @@ ;; define-runtime-path only allowed at top level -(define-runtime-path test.ptree "../test-support/test.ptree") -(define-runtime-path test.html.pm "../test-support/test.html.pm") -(define-runtime-path test.html.pmd "../test-support/test.html.pmd") -(define-runtime-path test.html.pp "../test-support/test.html.pp") -(define-runtime-path test.no-ext "../test-support/test.no-ext") +(define-runtime-path test.ptree "data/test.ptree") +(define-runtime-path test.html.pm "data/test.html.pm") +(define-runtime-path test-import.html.pm "data/test-import.html.pm") +(define-runtime-path test.html.pmd "data/test.html.pmd") +(define-runtime-path test.html.pp "data/test.html.pp") +(define-runtime-path test.no-ext "data/test.no-ext") ;; `find-exe` avoids reliance on $PATH of the host system (define racket-path (find-exe)) (when racket-path (define (run path) - (define cmd-string (format "~a ~a" racket-path path)) + (define cmd-string (format "'~a' ~a" racket-path path)) (with-output-to-string (λ() (system cmd-string)))) (check-equal? (run test.ptree) "'(pagetree-root test ====)") - (check-equal? (run test.html.pm) "'(root \"test\" \"\\n\" \"====\")") + (check-equal? (run test.html.pm) @string-append{'(root "test" "\n" "====")}) + (check-equal? (run test-import.html.pm) @string-append{'(root "test" "\n" "====" "\n" (root "This is sample 01."))}) (check-equal? (run test.html.pmd) "'(root (h1 ((id \"test\")) \"test\"))") (check-equal? (run test.html.pp) "test\n====") (check-equal? (run test.no-ext) "test\n====")) diff --git a/test/test-override.rkt b/test/test-override.rkt new file mode 100644 index 0000000..34afd6a --- /dev/null +++ b/test/test-override.rkt @@ -0,0 +1,45 @@ +#lang at-exp racket/base +(require rackunit racket/port racket/system racket/runtime-path compiler/find-exe pollen/world) + +;; define-runtime-path only allowed at top level +(define-runtime-path override-dir "data/override") +(define-runtime-path test.ptree "data/override/test.ptree") +(define-runtime-path test.html.pm "data/override/test.html.pm") +(define-runtime-path test.html.pmd "data/override/test.html.pmd") +(define-runtime-path test.html.pp "data/override/test.html.pp") + +(define-runtime-path test.ptreeover "data/override/test.ptreeover") +(define-runtime-path test.html.pmover "data/override/test.html.pmover") +(define-runtime-path test.html.pmdover "data/override/test.html.pmdover") +(define-runtime-path test.html.ppover "data/override/test.html.ppover") +(define-runtime-path test-cmd.html.ppover "data/override/test-cmd.html.ppover") +(define-runtime-path test-exports.html.ppover "data/override/test-exports.html.ppover") +(define-runtime-path test-require.html.pmover "data/override/test-require.html.pmover") + + +;; `find-exe` avoids reliance on $PATH of the host system +(define racket-path (find-exe)) +;; parameterize needed to pick up override file +(parameterize ([current-directory override-dir] + [world:current-project-root override-dir]) + (when racket-path + (define (run path) + (define cmd-string (format "'~a' ~a" racket-path path)) + (with-output-to-string (λ() (system cmd-string)))) + ;; raco is in same dir as racket + (define path-to-raco (path->string (simplify-path (build-path (find-exe) 'up "raco")))) + ;; files with ordinary extensions will not be recognized in override dir, and thus behave like preproc + (check-equal? (run test.ptree) "test\n====") + (check-equal? (run test.html.pm) "test\n====") + (check-equal? (run test.html.pmd) "test\n====") + (check-equal? (run test.html.pp) "test\n====") + + (check-equal? (run test.ptreeover) "'(pagetree-root test ====)") + (check-equal? (run test.html.pmover) "'(rootover \"test\" \"\\n\" \"====\")") + (check-equal? (run test.html.pmdover) "'(rootover (h1 ((id \"test\")) \"test\"))") + (check-equal? (run test.html.ppover) "test\n====") +(check-equal? (run test-cmd.html.ppover) "2") + (check-equal? (dynamic-require test-exports.html.ppover 'docover) "\n2") + (check-equal? (hash-ref (dynamic-require test-exports.html.ppover 'metasover) 'dog) "Roxy") + (check-equal? (dynamic-require test-require.html.pmover 'docover) '(rootover "foobar")) + (check-equal? (with-output-to-string (λ _ (system (format "'~a' pollen version" path-to-raco)))) "42\n"))) diff --git a/world.rkt b/world.rkt index fc438f8..721323c 100644 --- a/world.rkt +++ b/world.rkt @@ -1,18 +1,41 @@ #lang racket/base +(require (for-syntax racket/base racket/syntax)) (require racket/runtime-path) (provide (prefix-out world: (all-defined-out))) -(define pollen-version "0.001") - -(define preproc-source-ext 'pp) -(define markup-source-ext 'pm) -(define markdown-source-ext 'pmd) -(define null-source-ext 'p) -(define pagetree-source-ext 'ptree) -(define template-source-ext 'pt) -(define scribble-source-ext 'scrbl) +(define current-project-root (make-parameter (current-directory))) +(define directory-require "directory-require.rkt") +(define (get-path-to-override) + (build-path (current-project-root) directory-require)) + +;; parameters should not be made settable. +(define-syntax (define-settable stx) + (syntax-case stx () + [(_ name default-value) + (with-syntax ([base-name (format-id stx "~a" #'name)] + [local:name (format-id stx "local:~a" #'name)] + [get-name (format-id stx "get-~a" #'name)] + [fail-thunk-name (format-id stx "fail-thunk-~a" #'name)] ) + #'(begin + (define base-name default-value) + (define fail-thunk-name (λ _ base-name)) + (define get-name (λ _ (with-handlers ([exn:fail? fail-thunk-name]) + (dynamic-require (get-path-to-override) 'local:name fail-thunk-name))))))])) + + +(define-settable pollen-version "0.001") + +(define-settable preproc-source-ext 'pp) +(define-settable markup-source-ext 'pm) +(define-settable markdown-source-ext 'pmd) +(define-settable null-source-ext 'p) +(define-settable pagetree-source-ext 'ptree) +(define-settable template-source-ext 'pt) +(define-settable scribble-source-ext 'scrbl) + +;; these are deliberately not settable because they're just internal signalers, no effect on external interface (define mode-auto 'auto) (define mode-preproc 'pre) (define mode-markup 'markup) @@ -20,44 +43,40 @@ (define mode-pagetree 'ptree) (define mode-template 'template) -(define cache-filename "pollen.cache") +(define-settable cache-filename "pollen.cache") -(define decodable-extensions (list markup-source-ext pagetree-source-ext)) +(define-settable decodable-extensions (list (get-markup-source-ext) (get-pagetree-source-ext))) -(define default-pagetree "index.ptree") -(define pagetree-root-node 'pagetree-root) +(define-settable default-pagetree (format "index.~a" (get-pagetree-source-ext))) +(define-settable pagetree-root-node 'pagetree-root) -(define command-marker #\◊) -(define template-command-marker #\∂) +(define-settable command-char #\◊) +(define-settable template-command-char #\∂) -(define default-template-prefix "template") -(define fallback-template-prefix "fallback") -(define template-meta-key "template") +(define-settable default-template-prefix "template") +(define-settable fallback-template-prefix "fallback") +(define-settable template-meta-key "template") -(define main-pollen-export 'doc) ; don't forget to change fallback template too -(define meta-pollen-export 'metas) -(define meta-tag-name 'meta) +(define-settable main-export 'doc) ; don't forget to change fallback template too +(define-settable meta-export 'metas) +(define-settable meta-tag-name 'meta) -(define directory-require "directory-require.rkt") - -(define newline "\n") -(define linebreak-separator newline) -(define paragraph-separator "\n\n") +(define-settable newline "\n") +(define-settable linebreak-separator (get-newline)) +(define-settable paragraph-separator "\n\n") -(define paths-excluded-from-dashboard - (map string->path (list "poldash.css" "compiled"))) +(define-settable paths-excluded-from-dashboard (map string->path (list "poldash.css" "compiled"))) -(define current-project-root (make-parameter (current-directory))) +(define-settable default-port 8080) -(define default-port 8080) -(define current-server-port (make-parameter default-port)) +(define current-server-port (make-parameter (get-default-port))) -(define dashboard-css "poldash.css") +(define-settable dashboard-css "poldash.css") (define-runtime-path server-extras-dir "server-extras") (define current-server-extras-path (make-parameter server-extras-dir)) (define check-directory-requires-in-render? (make-parameter #t)) -(define publish-directory-name "publish") +(define-settable publish-directory-name "publish") \ No newline at end of file