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
(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 "world.rkt" sugar/define sugar/file sugar/string sugar/coerce sugar/test)
@ -46,6 +46,43 @@
(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)
(syntax-case stx ()
[(_ stem)
@ -56,16 +93,18 @@
[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)]
[->stem-source-paths (format-id stx "->~a-source-paths" #'stem)]
[->stem-source+output-paths (format-id stx "->~a-source+output-paths" #'stem)])
#`(begin
;; does file have particular extension
(define+provide (stem-source? x)
(->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)
(and (pathish? x)
(let ([source-path (->stem-source-path (->path x))])
(and source-path (file-exists? source-path) source-path))))
(let ([source-paths (->stem-source-paths (->path x))])
(and source-paths (ormap (λ(sp) (and (file-exists? sp) sp)) source-paths)))))
;; does the source-ified version of the file exist
(define+provide (has-stem-source? x)
@ -75,22 +114,32 @@
(define+provide (has/is-stem-source? x)
(->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)
(pathish? . -> . (or/c #f path?))
(define result (if (stem-source? x)
x
#,(if (equal? stem-datum 'scribble)
#'(if (x . has-ext? . 'html) ; different logic for scribble sources
(add-ext (remove-ext* x) (world:current-stem-source-ext))
#f)
#'(add-ext x (world:current-stem-source-ext)))))
(and result (->path result)))
(define paths (->stem-source-paths x))
(and paths (car paths)))
;; 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
(list (add-ext (remove-ext* x) (world:current-stem-source-ext)))
#f)
#'(list* (add-ext x (world:current-stem-source-ext))
(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
(define+provide/contract (->stem-source+output-paths 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)))))))]))
@ -101,6 +150,10 @@
(check-true (preproc-source? "foo.pp"))
(check-false (preproc-source? "foo.bar"))
(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.html")) (->path "foo.html.pp"))
(check-equal? (->preproc-source-path "foo") (->path "foo.pp"))
@ -121,6 +174,10 @@
(check-true (markup-source? "foo.pm"))
(check-false (markup-source? "foo.p"))
(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.html")) (->path "foo.html.pm"))
(check-equal? (->markup-source-path "foo") (->path "foo.pm"))
@ -145,7 +202,7 @@
(define+provide/contract (->output-path x)
(coerce/path? . -> . coerce/path?)
(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)]
[else x]))
@ -156,7 +213,12 @@
(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")))
(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)
(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}.
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[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))]
[(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))))]
;; 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)])
(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))

@ -79,4 +79,6 @@
(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