support escaped output-file extensions within source filenames

pull/84/head
Matthew Butterick 10 years ago
parent a1591897df
commit 7bfd403023

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base racket/syntax)) (require (for-syntax racket/base racket/syntax))
(require racket/contract racket/path) (require racket/contract racket/path racket/match)
(require (only-in racket/path filename-extension)) (require (only-in racket/path filename-extension))
(require "world.rkt" sugar/define sugar/file sugar/string sugar/coerce sugar/test) (require "world.rkt" sugar/define sugar/file sugar/string sugar/coerce sugar/test)
@ -46,6 +46,43 @@
(directory-list dir #:build? #t))))) (directory-list dir #:build? #t)))))
(define+provide/contract (escape-last-ext x [escape-char (world:current-extension-escape-char)])
((pathish?) (char?) . ->* . coerce/path?)
;; if x has a file extension, reattach it with the escape char
(define current-ext (get-ext x))
(if current-ext
(format "~a~a~a" (->string (remove-ext x)) escape-char current-ext)
x))
(module-test-external
(require sugar/coerce)
(check-equal? (escape-last-ext "foo") (->path "foo"))
(check-equal? (escape-last-ext "foo.html") (->path "foo!html"))
(check-equal? (escape-last-ext "foo.html" #\$) (->path "foo$html")))
(define+provide/contract (unescape-ext x [escape-char (world:current-extension-escape-char)])
((pathish?) (char?) . ->* . coerce/path?)
;; if x has an escaped extension, unescape it.
(define xstr (->string x))
(define pat (regexp (format "(.*)[~a](.*)$" escape-char)))
(define results (regexp-match pat xstr))
(if results
(match-let ([(list _ filename ext) results])
(add-ext filename ext))
x))
(module-test-external
(require sugar/coerce)
(check-equal? (unescape-ext "foo") (->path "foo"))
(check-equal? (unescape-ext "foo.html") (->path "foo.html"))
(check-equal? (unescape-ext "foo!html") (->path "foo.html"))
(check-equal? (unescape-ext "foo$html" #\$) (->path "foo.html"))
(check-equal? (unescape-ext "foo!bar!!html") (->path "foo!bar!.html"))
(check-equal? (unescape-ext "foo$bar$$html" #\$) (->path "foo$bar$.html")))
(define-syntax (make-source-utility-functions stx) (define-syntax (make-source-utility-functions stx)
(syntax-case stx () (syntax-case stx ()
[(_ stem) [(_ stem)
@ -56,16 +93,18 @@
[has-stem-source? (format-id stx "has-~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)] [has/is-stem-source? (format-id stx "has/is-~a-source?" #'stem)]
[->stem-source-path (format-id stx "->~a-source-path" #'stem)] [->stem-source-path (format-id stx "->~a-source-path" #'stem)]
[->stem-source-paths (format-id stx "->~a-source-paths" #'stem)]
[->stem-source+output-paths (format-id stx "->~a-source+output-paths" #'stem)]) [->stem-source+output-paths (format-id stx "->~a-source+output-paths" #'stem)])
#`(begin #`(begin
;; does file have particular extension ;; does file have particular extension
(define+provide (stem-source? x) (define+provide (stem-source? x)
(->boolean (and (pathish? x) (has-ext? (->path x) (world:current-stem-source-ext))))) (->boolean (and (pathish? x) (has-ext? (->path x) (world:current-stem-source-ext)))))
;; non-theoretical: want the first possible source that exists in the filesystem
(define+provide (get-stem-source x) (define+provide (get-stem-source x)
(and (pathish? x) (and (pathish? x)
(let ([source-path (->stem-source-path (->path x))]) (let ([source-paths (->stem-source-paths (->path x))])
(and source-path (file-exists? source-path) source-path)))) (and source-paths (ormap (λ(sp) (and (file-exists? sp) sp)) source-paths)))))
;; does the source-ified version of the file exist ;; does the source-ified version of the file exist
(define+provide (has-stem-source? x) (define+provide (has-stem-source? x)
@ -75,22 +114,32 @@
(define+provide (has/is-stem-source? x) (define+provide (has/is-stem-source? x)
(->boolean (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list stem-source? has-stem-source?))))) (->boolean (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list stem-source? has-stem-source?)))))
;; add the file extension if it's not there ;; get first possible source path (does not check filesystem)
(define+provide/contract (->stem-source-path x) (define+provide/contract (->stem-source-path x)
(pathish? . -> . (or/c #f path?)) (pathish? . -> . (or/c #f path?))
(define result (if (stem-source? x) (define paths (->stem-source-paths x))
x (and paths (car paths)))
#,(if (equal? stem-datum 'scribble)
;; get all possible source paths (does not check filesystem)
(define+provide/contract (->stem-source-paths x)
(pathish? . -> . (or/c #f (non-empty-listof path?)))
(define results (if (stem-source? x)
(list x) ; already has the source extension
#,(if (eq? stem-datum 'scribble)
#'(if (x . has-ext? . 'html) ; different logic for scribble sources #'(if (x . has-ext? . 'html) ; different logic for scribble sources
(add-ext (remove-ext* x) (world:current-stem-source-ext)) (list (add-ext (remove-ext* x) (world:current-stem-source-ext)))
#f) #f)
#'(add-ext x (world:current-stem-source-ext))))) #'(list* (add-ext x (world:current-stem-source-ext))
(and result (->path result))) (if (get-ext x)
(list (add-ext (escape-last-ext x) (world:current-stem-source-ext)))
null)))))
(and results (map ->path results)))
;; coerce either a source or output file to both ;; coerce either a source or output file to both
(define+provide/contract (->stem-source+output-paths path) (define+provide/contract (->stem-source+output-paths path)
(pathish? . -> . (values path? path?)) (pathish? . -> . (values path? path?))
(values (->complete-path (->stem-source-path path)) ;; get the real source path if available, otherwise a theoretical path
(values (->complete-path (or (get-stem-source path) (->stem-source-path path)))
(->complete-path (->output-path path)))))))])) (->complete-path (->output-path path)))))))]))
@ -101,6 +150,10 @@
(check-true (preproc-source? "foo.pp")) (check-true (preproc-source? "foo.pp"))
(check-false (preproc-source? "foo.bar")) (check-false (preproc-source? "foo.bar"))
(check-false (preproc-source? #f)) (check-false (preproc-source? #f))
(check-equal? (->preproc-source-paths (->path "foo.pp")) (list (->path "foo.pp")))
(check-equal? (->preproc-source-paths (->path "foo.html")) (list (->path "foo.html.pp") (->path "foo!html.pp")))
(check-equal? (->preproc-source-paths "foo") (list (->path "foo.pp")))
(check-equal? (->preproc-source-paths 'foo) (list (->path "foo.pp")))
(check-equal? (->preproc-source-path (->path "foo.pp")) (->path "foo.pp")) (check-equal? (->preproc-source-path (->path "foo.pp")) (->path "foo.pp"))
(check-equal? (->preproc-source-path (->path "foo.html")) (->path "foo.html.pp")) (check-equal? (->preproc-source-path (->path "foo.html")) (->path "foo.html.pp"))
(check-equal? (->preproc-source-path "foo") (->path "foo.pp")) (check-equal? (->preproc-source-path "foo") (->path "foo.pp"))
@ -121,6 +174,10 @@
(check-true (markup-source? "foo.pm")) (check-true (markup-source? "foo.pm"))
(check-false (markup-source? "foo.p")) (check-false (markup-source? "foo.p"))
(check-false (markup-source? #f)) (check-false (markup-source? #f))
(check-equal? (->markup-source-paths (->path "foo.pm")) (list (->path "foo.pm")))
(check-equal? (->markup-source-paths (->path "foo.html")) (list (->path "foo.html.pm") (->path "foo!html.pm")))
(check-equal? (->markup-source-paths "foo") (list (->path "foo.pm")))
(check-equal? (->markup-source-paths 'foo) (list (->path "foo.pm")))
(check-equal? (->markup-source-path (->path "foo.pm")) (->path "foo.pm")) (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 (->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"))
@ -145,7 +202,7 @@
(define+provide/contract (->output-path x) (define+provide/contract (->output-path x)
(coerce/path? . -> . coerce/path?) (coerce/path? . -> . coerce/path?)
(cond (cond
[(or (markup-source? x) (preproc-source? x) (null-source? x) (markdown-source? x) (template-source? x)) (remove-ext x)] [(or (markup-source? x) (preproc-source? x) (null-source? x) (markdown-source? x) (template-source? x)) (unescape-ext (remove-ext x))]
[(scribble-source? x) (add-ext (remove-ext x) 'html)] [(scribble-source? x) (add-ext (remove-ext x) 'html)]
[else x])) [else x]))
@ -156,7 +213,12 @@
(check-equal? (->output-path 'foo.html.p) (->path "foo.html")) (check-equal? (->output-path 'foo.html.p) (->path "foo.html"))
(check-equal? (->output-path (->path "/Users/mb/git/foo.html.p")) (->path "/Users/mb/git/foo.html")) (check-equal? (->output-path (->path "/Users/mb/git/foo.html.p")) (->path "/Users/mb/git/foo.html"))
(check-equal? (->output-path "foo.xml.p") (->path "foo.xml")) (check-equal? (->output-path "foo.xml.p") (->path "foo.xml"))
(check-equal? (->output-path 'foo.barml.p) (->path "foo.barml"))) (check-equal? (->output-path 'foo.barml.p) (->path "foo.barml"))
(check-equal? (->output-path 'foo!html.p) (->path "foo.html"))
(check-equal? (->output-path (->path "/Users/mb/git/foo!html.p")) (->path "/Users/mb/git/foo.html"))
(check-equal? (->output-path "foo!xml.p") (->path "foo.xml"))
(check-equal? (->output-path 'foo!barml.p) (->path "foo.barml")))
(define+provide/contract (project-files-with-ext ext) (define+provide/contract (project-files-with-ext ext)
(coerce/symbol? . -> . complete-paths?) (coerce/symbol? . -> . complete-paths?)

@ -154,3 +154,15 @@ Scribble files are recognized by the project server and can be compiled and prev
Files with the null extension are simply rendered as a copy of the file without the extension, so @filepath{index.html.p} becomes @filepath{index.html}. Files with the null extension are simply rendered as a copy of the file without the extension, so @filepath{index.html.p} becomes @filepath{index.html}.
This can be useful you're managing your project with git. Most likely you'll want to ignore @filepath{*.html} and other file types that are frequently regenerated by the project server. But if you have isolated static files — for instance, a @filepath{index.html} that doesn't have source associated with it — they'll be ignored too. You can cure this problem by appending the null extension to these static files, so they'll be tracked in your source system without actually being source files. This can be useful you're managing your project with git. Most likely you'll want to ignore @filepath{*.html} and other file types that are frequently regenerated by the project server. But if you have isolated static files — for instance, a @filepath{index.html} that doesn't have source associated with it — they'll be ignored too. You can cure this problem by appending the null extension to these static files, so they'll be tracked in your source system without actually being source files.
@section{Escaping output-file extensions within source-file names}
Pollen relies extensively on the convention of naming source files by adding a source extension to an output-file name. So the Pollen markup source for @filepath{index.html} would be @filepath{index.html.pm}.
This convention occasionally flummoxes other programs that assume a file can only have one extension. If you run into such a situation, you can @italic{escape} the output-file extension using the @racket[world:extension-escape-char], which defaults to @litchar{!}.
So instead of @filepath{index.html.pm}, your source-file name would be @filepath{index!html.pm}. When this source file is rendered, it will automatically be converted into @filepath{index.html} (meaning, the escaped extension will be converted into a normal file extension).
This alternative-naming scheme is automatically enabled in every project. You can also set the escape character on a per-project basis (see @racket[world:current-extension-escape-char]). Pollen will let you choose any character, but of course it would be unwise to pick one with special meaning in your filesystem (for instance, @litchar{/}).

@ -72,6 +72,8 @@ Determines the default HTTP port for the project server. Initialized to @racket[
@defoverridable[server-extras-dir string?]{Name of directory where server support files live. Initialized to @tt{server-extras}.} @defoverridable[server-extras-dir string?]{Name of directory where server support files live. Initialized to @tt{server-extras}.}
@defoverridable[extension-escape-char char?]{Character for escaping output-file extensions within source-file names. Initialized to @racket[#\!].}

@ -173,7 +173,8 @@
(cons (format "~a/~a" filename (world:current-default-pagetree)) (format "~a/" filename))] (cons (format "~a/~a" filename (world:current-default-pagetree)) (format "~a/" filename))]
[(and source (equal? (get-ext source) "scrbl")) [(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)) ")")))] (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))))] ;; use remove-ext because source may have escaped extension in it
[source (cons #f `(a ((href ,filename)) ,(->string (remove-ext source)) (span ((class "file-ext")) "." ,(get-ext source))))]
[else (cons filename filename)]) [else (cons filename filename)])
(cond ; in cell (cond ; in cell

@ -0,0 +1,6 @@
#lang racket/base
(provide (all-defined-out))
(module config racket/base
(provide (all-defined-out))
(define extension-escape-char #\$))

@ -0,0 +1,2 @@
#lang pollen
test

@ -0,0 +1,22 @@
#lang at-exp racket/base
(require rackunit racket/port racket/system racket/runtime-path compiler/find-exe racket/file)
;; define-runtime-path only allowed at top level
(define-runtime-path test-dir "data/escape-ext")
(define-runtime-path test-file "data/escape-ext/test$html.pp")
;; `find-exe` avoids reliance on $PATH of the host system
(define racket-path (find-exe))
(define-values (raco-dir file _) (split-path racket-path))
(when racket-path
(define raco-path (build-path raco-dir "raco"))
(define (render path)
;; need to cd first to pick up directory require correctly
(define cmd-string (format "cd '~a' ; '~a' pollen render '~a'" test-dir raco-path path))
(with-output-to-string (λ() (system cmd-string))))
(define result-file (build-path test-dir "test.html"))
(when (file-exists? result-file) (delete-file result-file))
(render test-file)
(check-true (file-exists? result-file))
(check-equal? (file->string result-file) "test")
(delete-file result-file))

@ -80,3 +80,5 @@
(define check-directory-requires-in-render? (make-parameter #t)) (define check-directory-requires-in-render? (make-parameter #t))
(define-settable publish-directory-name "publish") (define-settable publish-directory-name "publish")
(define-settable extension-escape-char #\!)
Loading…
Cancel
Save