mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

update

Browse Source
pull/9/head
Matthew Butterick 11 years ago
parent d02bec5ef9
commit 50ca995c42
1 changed files with 27 additions and 27 deletions
Show Stats Download Patch File Download Diff File

54
file-tools.rkt
Unescape Escape View File

@ -7,7 +7,7 @@
;; for files like svg that are not source in pollen terms, ;; for files like svg that are not source in pollen terms,
;; but have a textual representation separate from their display. ;; but have a textual representation separate from their display.
(define/provide/contract (sourceish? x) (define+provide/contract (sourceish? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(define sourceish-extensions (list "svg")) (define sourceish-extensions (list "svg"))
(try ((get-ext x) . in? . sourceish-extensions) (try ((get-ext x) . in? . sourceish-extensions)
@ -16,14 +16,14 @@
;; if something can be successfully coerced to a url, ;; if something can be successfully coerced to a url,
;; it's urlish. ;; it's urlish.
(define/provide/contract (urlish? x) (define+provide/contract (urlish? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(try (->url x) (except [exn:fail? (λ(e) #f)]))) (try (->url x) (except [exn:fail? (λ(e) #f)])))
;; if something can be successfully coerced to a path, ;; if something can be successfully coerced to a path,
;; it's pathish. ;; it's pathish.
(define/provide/contract (pathish? x) (define+provide/contract (pathish? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(try (->path x) (except [exn:fail? (λ(e) #f)]))) (try (->path x) (except [exn:fail? (λ(e) #f)])))
@ -32,28 +32,28 @@
;; todo: is this contract too restrictive? ;; todo: is this contract too restrictive?
;; pathish doesn't require the path to exist, ;; pathish doesn't require the path to exist,
;; but this one does. ;; but this one does.
(define/provide/contract (directory-pathish? x) (define+provide/contract (directory-pathish? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(and (pathish? x) (directory-exists? (->path x)))) (and (pathish? x) (directory-exists? (->path x))))
;; compare directories by their exploded path elements, ;; compare directories by their exploded path elements,
;; not by equal?, which will give wrong result if no slash on the end ;; not by equal?, which will give wrong result if no slash on the end
(define/provide/contract (directories-equal? dirx diry) (define+provide/contract (directories-equal? dirx diry)
(coerce/path? coerce/path? . -> . coerce/boolean?) (coerce/path? coerce/path? . -> . coerce/boolean?)
(equal? (explode-path dirx) (explode-path diry))) (equal? (explode-path dirx) (explode-path diry)))
(define/provide/contract (get-enclosing-dir p) (define+provide/contract (get-enclosing-dir p)
(coerce/path? . -> . path?) (coerce/path? . -> . path?)
(simplify-path (build-path p 'up))) (simplify-path (build-path p 'up)))
;; helper function for ptree ;; helper function for ptree
;; make paths absolute to test whether files exist, ;; make paths absolute to test whether files exist,
;; then convert back to relative ;; then convert back to relative
(define/provide/contract (visible? path) (define+provide/contract (visible? path)
(coerce/path? . -> . coerce/boolean?) (coerce/path? . -> . coerce/boolean?)
(not ((->string path) . starts-with? . "."))) (not ((->string path) . starts-with? . ".")))
(define/provide/contract (visible-files dir) (define+provide/contract (visible-files dir)
(directory-pathish? . -> . (listof path?)) (directory-pathish? . -> . (listof path?))
(filter visible? (filter visible?
(map (λ(p) (find-relative-path dir p)) (map (λ(p) (find-relative-path dir p))
@ -61,7 +61,7 @@
(directory-list dir #:build? #t))))) (directory-list dir #:build? #t)))))
;; does path have a certain extension ;; does path have a certain extension
(define/provide/contract (has-ext? x ext) (define+provide/contract (has-ext? x ext)
(coerce/path? coerce/symbol? . -> . coerce/boolean?) (coerce/path? coerce/symbol? . -> . coerce/boolean?)
(define ext-of-path (filename-extension x)) (define ext-of-path (filename-extension x))
(and ext-of-path (equal? (string-downcase (bytes->string/utf-8 ext-of-path)) (string-downcase (symbol->string ext))))) (and ext-of-path (equal? (string-downcase (bytes->string/utf-8 ext-of-path)) (string-downcase (symbol->string ext)))))
@ -71,14 +71,14 @@
(define binary-extensions (define binary-extensions
'(gif jpg jpeg mp3 png zip pdf ico tar ai eps)) '(gif jpg jpeg mp3 png zip pdf ico tar ai eps))
(define/provide/contract (has-binary-ext? x) (define+provide/contract (has-binary-ext? x)
(coerce/path? . -> . coerce/boolean?) (coerce/path? . -> . coerce/boolean?)
(ormap (λ(ext) (has-ext? x ext)) binary-extensions)) (ormap (λ(ext) (has-ext? x ext)) binary-extensions))
;; get file extension as a string, or return #f ;; get file extension as a string, or return #f
;; (consistent with filename-extension behavior) ;; (consistent with filename-extension behavior)
(define/provide/contract (get-ext x) (define+provide/contract (get-ext x)
(coerce/path? . -> . (or/c string? #f)) (coerce/path? . -> . (or/c string? #f))
(let ([fe-result (filename-extension x)]) (let ([fe-result (filename-extension x)])
(and fe-result (bytes->string/utf-8 fe-result)))) (and fe-result (bytes->string/utf-8 fe-result))))
@ -86,12 +86,12 @@
;; put extension on path ;; put extension on path
;; use local contract here because this function is used within module ;; use local contract here because this function is used within module
(define/contract/provide (add-ext x ext) (define/contract+provide (add-ext x ext)
(coerce/string? coerce/string? . -> . coerce/path?) (coerce/string? coerce/string? . -> . coerce/path?)
(string-append x "." ext)) (string-append x "." ext))
;; take one extension off path ;; take one extension off path
(define/provide/contract (remove-ext x) (define+provide/contract (remove-ext x)
(coerce/path? . -> . path?) (coerce/path? . -> . path?)
;; pass through hidden files (those starting with a dot) ;; pass through hidden files (those starting with a dot)
(if (x . starts-with? . ".") (if (x . starts-with? . ".")
@ -100,7 +100,7 @@
;; take all extensions off path ;; take all extensions off path
(define/provide/contract (remove-all-ext x) (define+provide/contract (remove-all-ext x)
(coerce/path? . -> . path?) (coerce/path? . -> . path?)
;; pass through hidden files (those starting with a dot) ;; pass through hidden files (those starting with a dot)
(if (x . starts-with? . ".") (if (x . starts-with? . ".")
@ -114,42 +114,42 @@
;; todo: tests for these predicates ;; todo: tests for these predicates
(define/provide/contract (preproc-source? x) (define+provide/contract (preproc-source? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(and (pathish? x) (has-ext? (->path x) PREPROC_SOURCE_EXT))) (and (pathish? x) (has-ext? (->path x) PREPROC_SOURCE_EXT)))
(define/provide/contract (has-preproc-source? x) (define+provide/contract (has-preproc-source? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(and (pathish? x) (file-exists? (->preproc-source-path (->path x))))) (and (pathish? x) (file-exists? (->preproc-source-path (->path x)))))
(define/provide/contract (has-decoder-source? x) (define+provide/contract (has-decoder-source? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(and (pathish? x) (file-exists? (->decoder-source-path (->path x))))) (and (pathish? x) (file-exists? (->decoder-source-path (->path x)))))
(define/provide/contract (needs-preproc? x) (define+provide/contract (needs-preproc? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
; it's a preproc source file, or a file that's the result of a preproc source ; 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?)))) (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list preproc-source? has-preproc-source?))))
(define/provide/contract (needs-template? x) (define+provide/contract (needs-template? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
; it's a pollen source file ; it's a pollen source file
; or a file (e.g., html) that has 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?)))) (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list decoder-source? has-decoder-source?))))
(define/provide/contract (ptree-source? x) (define+provide/contract (ptree-source? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(and (pathish? x) ((->path x) . has-ext? . PTREE_SOURCE_EXT))) (and (pathish? x) ((->path x) . has-ext? . PTREE_SOURCE_EXT)))
(define/provide/contract (decoder-source? x) (define+provide/contract (decoder-source? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(and (pathish? x) (has-ext? x DECODER_SOURCE_EXT))) (and (pathish? x) (has-ext? x DECODER_SOURCE_EXT)))
(define/provide/contract (template-source? x) (define+provide/contract (template-source? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(and (pathish? x) (and (pathish? x)
(let-values ([(dir name ignore) (split-path x)]) (let-values ([(dir name ignore) (split-path x)])
@ -158,7 +158,7 @@
;; predicate for files that are eligible to be required ;; predicate for files that are eligible to be required
;; from the project/require directory ;; from the project/require directory
;; todo: extend this beyond just racket files? ;; todo: extend this beyond just racket files?
(define/provide/contract (project-require-file? x) (define+provide/contract (project-require-file? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(and (pathish? x) (has-ext? x 'rkt))) (and (pathish? x) (has-ext? x 'rkt)))
@ -166,13 +166,13 @@
;; todo: tighten these input contracts ;; todo: tighten these input contracts
;; so that, say, a source-path cannot be input for make-preproc-source-path ;; so that, say, a source-path cannot be input for make-preproc-source-path
(define/provide/contract (->preproc-source-path x) (define+provide/contract (->preproc-source-path x)
(coerce/path? . -> . coerce/path?) (coerce/path? . -> . coerce/path?)
(if (preproc-source? x) (if (preproc-source? x)
x x
(add-ext x PREPROC_SOURCE_EXT))) (add-ext x PREPROC_SOURCE_EXT)))
(define/provide/contract (->output-path x) (define+provide/contract (->output-path x)
(coerce/path? . -> . coerce/path?) (coerce/path? . -> . coerce/path?)
(if (or (decoder-source? x) (preproc-source? x)) (if (or (decoder-source? x) (preproc-source? x))
(remove-ext x) (remove-ext x)
@ -182,14 +182,14 @@
;; does not, however, validate that new path exists ;; 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 ;; 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) ;; OK to use pollen source as input (comes out the same way)
(define/provide/contract (->decoder-source-path x) (define+provide/contract (->decoder-source-path x)
(coerce/path? . -> . coerce/path?) (coerce/path? . -> . coerce/path?)
(if (decoder-source? x) (if (decoder-source? x)
x x
(add-ext x DECODER_SOURCE_EXT))) (add-ext x DECODER_SOURCE_EXT)))
(define/provide/contract (project-files-with-ext ext) (define+provide/contract (project-files-with-ext ext)
(coerce/symbol? . -> . (listof complete-path?)) (coerce/symbol? . -> . (listof complete-path?))
(map ->complete-path (filter (λ(i) (has-ext? i ext)) (directory-list PROJECT_ROOT)))) (map ->complete-path (filter (λ(i) (has-ext? i ext)) (directory-list PROJECT_ROOT))))

Write Preview
Loading…
Cancel
Save