From 3cb9a37195aa1402f4e23b358b5218e3c6021358 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 13 Mar 2014 21:15:29 -0700 Subject: [PATCH] updates --- file.rkt | 9 +++++++++ project-requires.rkt | 11 ++++++++--- render.rkt | 9 +++------ server-routes.rkt | 7 +------ template.rkt | 24 +++++++++++++++--------- 5 files changed, 36 insertions(+), 24 deletions(-) diff --git a/file.rkt b/file.rkt index 4529b45..71581bf 100644 --- a/file.rkt +++ b/file.rkt @@ -84,6 +84,15 @@ (make-source-utility-functions scribble) +(define/contract+provide (->source-path path) + (coerce/path? . -> . path?) + (define possible-sources + (if (directory-exists? path) + null + (filter file-exists? (map (λ(proc) (proc path)) (list ->preproc-source-path ->markup-source-path ->null-source-path ->scribble-source-path))))) + (if (null? possible-sources) path (car possible-sources))) + + (define+provide/contract (->output-path x) (coerce/path? . -> . coerce/path?) (cond diff --git a/project-requires.rkt b/project-requires.rkt index 2802352..29e2a9d 100644 --- a/project-requires.rkt +++ b/project-requires.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require "world.rkt" sugar/define/contract sugar/coerce/contract) +(require "world.rkt" sugar/define sugar/coerce/contract) (define/contract+provide (get-project-require-files source-path) ; keep contract local to ensure coercion @@ -8,7 +8,7 @@ (and (andmap file-exists? possible-requires) possible-requires)) -(define+provide/contract (require+provide-project-require-files here-path) +(define+provide/contract (require+provide-project-require-files here-path #:provide [provide #t]) (coerce/path? . -> . list?) (define (put-file-in-require-form file) `(file ,(path->string file))) @@ -18,6 +18,11 @@ (let ([files-in-require-form (map put-file-in-require-form project-require-files)]) `(begin (require ,@files-in-require-form) - ,@(list `(provide (all-from-out ,@files-in-require-form))))) + ,@(if provide + (list `(provide (all-from-out ,@files-in-require-form))) + '()))) (void))) + +(define+provide (require-project-require-files here-path) + (require+provide-project-require-files here-path #:provide #f)) diff --git a/render.rkt b/render.rkt index 5cd5e93..eb97358 100644 --- a/render.rkt +++ b/render.rkt @@ -159,12 +159,11 @@ (define expr-to-eval `(begin (require (for-syntax racket/base)) - (require web-server/templates pollen/cache) - (require pollen/lang/inner-lang-helper) - (require-project-require-files) + (require web-server/templates pollen/cache pollen/debug) + ,(require-project-require-files source-path) (let ([doc (cached-require ,source-path ',world:main-pollen-export)] [metas (cached-require ,source-path ',world:meta-pollen-export)]) - (local-require pollen/debug pollen/pagemap pollen/template pollen/top) + (local-require pollen/pagemap pollen/template pollen/top) (include-template #:command-char ,world:template-field-delimiter ,(->string (find-relative-path source-dir template-path)))))) (time (parameterize ([current-directory source-dir]) @@ -224,7 +223,6 @@ pollen/decode pollen/file pollen/main - pollen/lang/inner-lang-helper pollen/pagemap pollen/cache sugar @@ -258,7 +256,6 @@ pollen/debug pollen/decode pollen/file - pollen/lang/inner-lang-helper pollen/pagemap pollen/cache sugar diff --git a/server-routes.rkt b/server-routes.rkt index 8aced7c..a3eaa81 100644 --- a/server-routes.rkt +++ b/server-routes.rkt @@ -159,12 +159,7 @@ (define (make-path-row fn) (define filename (->string fn)) - (define (file-in-dir? fn) (file-exists? (build-path dir fn))) - (define possible-sources - (if (directory-exists? fn) - empty ;; folders don't have source files - (filter file-in-dir? (list (->preproc-source-path filename) (->markup-source-path filename) (->null-source-path filename) (->scribble-source-path filename))))) - (define source (and (not (empty? possible-sources)) (->string (car possible-sources)))) + (define source (->string (->source-path fn))) `(tr ,@(map make-link-cell (append (list (cond ; main cell diff --git a/template.rkt b/template.rkt index 9044bc0..5b9d78b 100644 --- a/template.rkt +++ b/template.rkt @@ -8,14 +8,14 @@ (provide (all-from-out sugar/coerce/value)) -(define/contract+provide (doc x) +(define/contract+provide (get-doc x) (coerce/path? . -> . txexpr?) - (cached-require x world:main-pollen-export)) + (cached-require (->source-path x) world:main-pollen-export)) -(define/contract+provide (metas x) +(define/contract+provide (get-metas x) (coerce/path? . -> . hash?) - (cached-require x world:meta-pollen-export)) + (cached-require (->source-path x) world:meta-pollen-export)) (define/contract+provide (find query . xs) @@ -25,12 +25,12 @@ (define/contract+provide (find* query . pxs) - ((coerce/symbol?) #:rest (listof (or/c #f hash? txexpr? pathish?)) . ->* . (or/c #f txexpr-element?)) + ((coerce/symbol?) #:rest (listof (or/c #f hash? txexpr? pathish?)) . ->* . (or/c #f txexpr-elements?)) (define (finder x) (cond [(hash? x) (find-in-metas query x)] [(txexpr? x) (find-in-doc query x)] - [(pathish? x) (find* query (doc x) (metas x))] + [(pathish? x) (find* query (get-doc x) (get-metas x))] [else null])) (append-map finder pxs)) @@ -38,7 +38,7 @@ (define/contract+provide (find-in-metas query hash-or-path) (coerce/symbol? (or/c hash? pathish?) . -> . (or/c #f txexpr-elements?)) (let ([metas (or (and (hash? hash-or-path) hash-or-path) - (metas (->path hash-or-path)))]) + (get-metas (->path hash-or-path)))]) (with-handlers ([exn:fail? (λ(e) null)]) (list (hash-ref metas query))))) @@ -46,9 +46,9 @@ (define/contract+provide (find-in-doc query doc-or-path) (coerce/symbol? (or/c txexpr? pathish?) . -> . (or/c #f txexpr-elements?)) (let ([doc (or (and (txexpr? doc-or-path) doc-or-path) - (doc (->path doc-or-path)))]) + (get-doc (->path doc-or-path)))]) (with-handlers ([exn:fail? (λ(e) null)]) - (se-path*/list query doc)))) + (se-path*/list (list query) doc)))) ;; turns input into xexpr-elements so they can be spliced into template @@ -77,3 +77,9 @@ (with-handlers ([exn:fail? (λ(exn) (error (format "when/block: ~a" (exn-message exn))))]) (map ->string (list body ...)))) "")])) + + +(module+ main + + +(when/block #t (find 'topic "/Users/mb/git/bpt/introduction.html"))) \ No newline at end of file