From 67349713627615cb5f34da90cf67d8b12e2d4016 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 26 Feb 2014 12:41:28 -0800 Subject: [PATCH] auto-generate source file utilities --- command.rkt | 2 +- file-tools.rkt | 115 ++++++++++++-------------------------- render.rkt | 22 ++++---- server-routes.rkt | 2 +- template.rkt | 14 ++--- tests/test-file-tools.rkt | 23 ++++---- world.rkt | 2 +- 7 files changed, 68 insertions(+), 112 deletions(-) diff --git a/command.rkt b/command.rkt index 92b9755..572ad16 100644 --- a/command.rkt +++ b/command.rkt @@ -33,7 +33,7 @@ polcom [filename] (renders individual file)")] (define (pollen-related-file? file) (ormap (λ(proc) (proc file)) (list - decoder-source? + markup-source? preproc-source? template-source? ptree-source? diff --git a/file-tools.rkt b/file-tools.rkt index f6a6a47..5241d57 100644 --- a/file-tools.rkt +++ b/file-tools.rkt @@ -1,4 +1,5 @@ #lang racket/base +(require (for-syntax racket/base racket/syntax)) (require racket/contract racket/path) (require (only-in racket/path filename-extension)) (require "world.rkt" sugar) @@ -110,94 +111,50 @@ -;; todo: tests for these predicates - -(define+provide/contract (preproc-source? x) - (any/c . -> . coerce/boolean?) - (and (pathish? x) (has-ext? (->path x) world:preproc-source-ext))) - -(define+provide/contract (has-null-source? x) - (any/c . -> . coerce/boolean?) - (and (pathish? x) (file-exists? (->null-source-path (->path x))))) - -(define+provide/contract (has-preproc-source? x) - (any/c . -> . coerce/boolean?) - (and (pathish? x) (file-exists? (->preproc-source-path (->path x))))) - -(define+provide/contract (has-decoder-source? x) - (any/c . -> . coerce/boolean?) - (and (pathish? x) (file-exists? (->decoder-source-path (->path x))))) - -(define+provide/contract (needs-preproc? x) - (any/c . -> . coerce/boolean?) - ; it's a preproc source file, or a file that's the result of a preproc source - (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list preproc-source? has-preproc-source?)))) - -(define+provide/contract (needs-template? x) - (any/c . -> . coerce/boolean?) - ; it's a pollen source file - ; or a file (e.g., html) that has a pollen source file - (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list decoder-source? has-decoder-source?)))) - -(define+provide/contract (needs-null? x) - (any/c . -> . coerce/boolean?) - ; it's a null source file, or a file that's the result of a null source - (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list null-source? has-null-source?)))) - - -(define+provide/contract (ptree-source? x) - (any/c . -> . coerce/boolean?) - (and (pathish? x) ((->path x) . has-ext? . world:ptree-source-ext))) +(define-syntax (make-source-utility-functions stx) + (syntax-case stx () + [(_ stem file-ext) + (with-syntax ([stem-source? (format-id stx "~a-source?" #'stem)] + [has-stem-source? (format-id stx "has-~a-source?" #'stem)] + [has/is-stem-source? (format-id stx "has/is-~a-source?" #'stem)] + [->stem-source-path (format-id stx "->~a-source-path" #'stem)]) + #'(begin + ;; does file have particular extension + (define+provide/contract (stem-source? x) + (any/c . -> . boolean?) + (->boolean (and (pathish? x) (has-ext? (->path x) file-ext)))) + + ;; does the source-ified version of the file exist + (define+provide/contract (has-stem-source? x) + (any/c . -> . boolean?) + (->boolean (and (pathish? x) (file-exists? (->stem-source-path (->path x)))))) + + ;; it's a file-ext source file, or a file that's the result of a file-ext source + (define+provide/contract (has/is-stem-source? x) + (any/c . -> . boolean?) + (->boolean (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list stem-source? has-stem-source?))))) + + ;; add the file extension if it's not there + (define+provide/contract (->stem-source-path x) + (pathish? . -> . path?) + (->path (if (stem-source? x) x (add-ext x file-ext))))))])) + + +(make-source-utility-functions preproc world:preproc-source-ext) +(make-source-utility-functions null world:null-source-ext) +(make-source-utility-functions ptree world:ptree-source-ext) +(make-source-utility-functions markup world:markup-source-ext) +(make-source-utility-functions template world:template-source-ext) -(define+provide/contract (decoder-source? x) - (any/c . -> . coerce/boolean?) - (and (pathish? x) ((->path x) . has-ext? . world:markup-source-ext))) - -(define+provide/contract (null-source? x) - (any/c . -> . coerce/boolean?) - (and (pathish? x) ((->path x) . has-ext? . world:null-source-ext))) - - -(define+provide/contract (template-source? x) - (any/c . -> . coerce/boolean?) - (and (pathish? x) - (let-values ([(dir name ignore) (split-path x)]) - (equal? (get (->string name) 0) world:template-source-prefix)))) - - - -;; todo: tighten these input contracts -;; so that, say, a source-path cannot be input for make-preproc-source-path -(define+provide/contract (->preproc-source-path x) - (coerce/path? . -> . coerce/path?) - (if (preproc-source? x) - x - (add-ext x world:preproc-source-ext))) - -(define+provide/contract (->null-source-path x) - (coerce/path? . -> . coerce/path?) - (if (decoder-source? x) - x - (add-ext x world:null-source-ext))) (define+provide/contract (->output-path x) (coerce/path? . -> . coerce/path?) - (if (or (decoder-source? x) (preproc-source? x) (null-source? x)) + (if (or (markup-source? x) (preproc-source? x) (null-source? x)) (remove-ext x) x)) -;; turns input into corresponding pollen source path -;; does not, however, validate that new path exists -;; todo: should it? I don't think so, sometimes handy to make the name for later use -;; OK to use pollen source as input (comes out the same way) -(define+provide/contract (->decoder-source-path x) - (coerce/path? . -> . coerce/path?) - (if (decoder-source? x) - x - (add-ext x world:markup-source-ext))) - (define+provide/contract (project-files-with-ext ext) (coerce/symbol? . -> . (listof complete-path?)) diff --git a/render.rkt b/render.rkt index 11dfe79..de0587c 100644 --- a/render.rkt +++ b/render.rkt @@ -98,9 +98,9 @@ (define (&render x) (let ([path (->complete-path x)]) (cond - [(needs-null? path) (render-null-source path #:force force)] - [(needs-preproc? path) (render-preproc-source-if-needed path #:force force)] - [(needs-template? path) (render-with-template path #:force force)] + [(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 'main)]) (render-files-in-ptree ptree #:force force))] [(equal? world:fallback-template (->string (file-name-from-path path))) @@ -175,12 +175,12 @@ (->boolean (> (len (get-output-string port-for-catching-file-info)) 0))) -(define (complete-decoder-source-path x) - (->complete-path (->decoder-source-path (->path x)))) +(define (complete-markup-source-path x) + (->complete-path (->markup-source-path (->path x)))) -(define (render-with-template x [template-name #f] #:force [force-render #f]) - (define source-path (complete-decoder-source-path x)) +(define (render-markup x [template-name #f] #:force [force-render #f]) + (define source-path (complete-markup-source-path x)) ;; todo: this won't work with source files nested down one level (define-values (source-dir ignored also-ignored) (split-path source-path)) @@ -198,7 +198,7 @@ (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-ext))))) ; path using default template + (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))) @@ -310,11 +310,11 @@ (module+ main (parameterize ([current-cache (make-cache)] [world:current-project-root (string->path "/Users/mb/git/bpt")]) - (render-source-with-template + (render (string->path "/Users/mb/git/bpt/test.html.pm") - (string->path "/Users/mb/git/bpt/-test.html")))) -|# + ))) +|# (define (render-files-in-ptree ptree #:force [force #f]) diff --git a/server-routes.rkt b/server-routes.rkt index 3fa1433..cc73173 100644 --- a/server-routes.rkt +++ b/server-routes.rkt @@ -163,7 +163,7 @@ (define possible-sources (if (directory-exists? fn) empty ;; folders don't have source files - (filter file-in-dir? (list (->preproc-source-path filename) (->decoder-source-path filename) (->null-source-path filename))))) + (filter file-in-dir? (list (->preproc-source-path filename) (->markup-source-path filename) (->null-source-path filename))))) (define source (and (not (empty? possible-sources)) (->string (car possible-sources)))) `(tr ,@(map make-link-cell (append (list diff --git a/template.rkt b/template.rkt index 55edc61..a8b0e08 100644 --- a/template.rkt +++ b/template.rkt @@ -15,8 +15,8 @@ (define/contract (puttable-item? x) (any/c . -> . boolean?) (or (txexpr? x) - (has-decoder-source? x) - (and (pnode? x) (pnode->url x) (has-decoder-source? (pnode->url x))))) + (has-markup-source? x) + (and (pnode? x) (pnode->url x) (has-markup-source? (pnode->url x))))) (module+ test (check-false (puttable-item? #t)) @@ -31,8 +31,8 @@ (cond ;; Using put has no effect on txexprs. It's here to make the idiom smooth. [(txexpr? x) x] - [(has-decoder-source? x) (cached-require (->decoder-source-path x) 'main)] - [(has-decoder-source? (pnode->url x)) (cached-require (->decoder-source-path (pnode->url x)) 'main)])) + [(has-markup-source? x) (cached-require (->markup-source-path x) 'main)] + [(has-markup-source? (pnode->url x)) (cached-require (->markup-source-path (pnode->url x)) 'main)])) #|(module+ test (check-equal? (put '(foo "bar")) '(foo "bar")) @@ -57,15 +57,15 @@ (define/contract (find-in-metas px key) (puttable-item? query-key? . -> . (or/c #f txexpr-elements?)) - (and (has-decoder-source? px) - (let ([metas (cached-require (->decoder-source-path px) 'metas)] + (and (has-markup-source? px) + (let ([metas (cached-require (->markup-source-path px) 'metas)] [key (->string key)]) (and (key . in? . metas ) (->list (get metas key)))))) #|(module+ test (parameterize ([current-directory "tests/template"]) (check-equal? (find-in-metas "put" "foo") (list "bar")) - (let* ([metas (cached-require (->decoder-source-path 'put) 'metas)] + (let* ([metas (cached-require (->markup-source-path 'put) 'metas)] [here (find-in-metas 'put 'here)]) (check-equal? here (list "tests/template/put"))))) |# diff --git a/tests/test-file-tools.rkt b/tests/test-file-tools.rkt index 2e17d79..12deba5 100644 --- a/tests/test-file-tools.rkt +++ b/tests/test-file-tools.rkt @@ -76,21 +76,20 @@ (check-false (preproc-source? #f))) (module+ test - (check-true (ptree-source? (format "foo.~a" PTREE_SOURCE_EXT))) - (check-false (ptree-source? (format "~a.foo" PTREE_SOURCE_EXT))) + (check-true (ptree-source? (format "foo.~a" world:ptree-source-ext))) + (check-false (ptree-source? (format "~a.foo" world:ptree-source-ext))) (check-false (ptree-source? #f))) (module+ test - (check-true (decoder-source? "foo.pd")) - (check-false (decoder-source? "foo.p")) - (check-false (decoder-source? #f))) + (check-true (markup-source? "foo.pm")) + (check-false (markup-source? "foo.p")) + (check-false (markup-source? #f))) (module+ test (check-true (template-source? "-foo.html")) (check-false (template-source? "foo.html")) (check-false (template-source? #f))) -(module+ test - (check-true (project-require-file? "foo.rkt")) - (check-false (project-require-file? "foo.html"))) + + (module+ test (check-equal? (->preproc-source-path (->path "foo.p")) (->path "foo.p")) (check-equal? (->preproc-source-path (->path "foo.html")) (->path "foo.html.p")) @@ -104,7 +103,7 @@ (check-equal? (->output-path "foo.xml.p") (->path "foo.xml")) (check-equal? (->output-path 'foo.barml.p) (->path "foo.barml"))) (module+ test - (check-equal? (->decoder-source-path (->path "foo.pd")) (->path "foo.pd")) - (check-equal? (->decoder-source-path (->path "foo.html")) (->path "foo.html.pd")) - (check-equal? (->decoder-source-path "foo") (->path "foo.pd")) - (check-equal? (->decoder-source-path 'foo) (->path "foo.pd"))) \ No newline at end of file + (check-equal? (->markup-source-path (->path "foo.pm")) (->path "foo.pm")) + (check-equal? (->markup-source-path (->path "foo.html")) (->path "foo.html.pm")) + (check-equal? (->markup-source-path "foo") (->path "foo.pm")) + (check-equal? (->markup-source-path 'foo) (->path "foo.pm"))) \ No newline at end of file diff --git a/world.rkt b/world.rkt index 367cc29..7fea89b 100644 --- a/world.rkt +++ b/world.rkt @@ -8,6 +8,7 @@ (define markup-source-ext 'pm) (define null-source-ext 'px) (define ptree-source-ext 'ptree) +(define template-source-ext 'pt) (define reader-mode-auto 'auto) (define reader-mode-preproc 'pre) @@ -24,7 +25,6 @@ (define template-field-delimiter expression-delimiter) (define default-template-prefix "main") -(define template-ext 'pt) (define fallback-template "fallback.html.pt") (define template-meta-key "template")