auto-generate source file utilities

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?

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?))

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])    

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                          

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")))))
 |#

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")))
+  (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")))

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")