#lang racket/base (require racket/contract racket/path) (require (only-in racket/path filename-extension)) (require "world.rkt" sugar) ;; for files like svg that are not source in pollen terms, ;; but have a textual representation separate from their display. (define+provide/contract (sourceish? x) (any/c . -> . coerce/boolean?) (define sourceish-extensions (list "svg")) (try ((get-ext x) . in? . sourceish-extensions) (except [exn:fail? (λ(e) #f)]))) ;; if something can be successfully coerced to a url, ;; it's urlish. (define+provide/contract (urlish? x) (any/c . -> . coerce/boolean?) (try (->url x) (except [exn:fail? (λ(e) #f)]))) ;; if something can be successfully coerced to a path, ;; it's pathish. (define+provide/contract (pathish? x) (any/c . -> . coerce/boolean?) (try (->path x) (except [exn:fail? (λ(e) #f)]))) ;; like pathish, but for directories ;; todo: is this contract too restrictive? ;; pathish doesn't require the path to exist, ;; but this one does. (define+provide/contract (directory-pathish? x) (any/c . -> . coerce/boolean?) (and (pathish? x) (directory-exists? (->path x)))) ;; compare directories by their exploded path elements, ;; not by equal?, which will give wrong result if no slash on the end (define+provide/contract (directories-equal? dirx diry) (coerce/path? coerce/path? . -> . coerce/boolean?) (equal? (explode-path dirx) (explode-path diry))) (define+provide/contract (get-enclosing-dir p) (coerce/path? . -> . path?) (simplify-path (build-path p 'up))) ;; helper function for ptree ;; make paths absolute to test whether files exist, ;; then convert back to relative (define+provide/contract (visible? path) (coerce/path? . -> . coerce/boolean?) (not ((->string path) . starts-with? . "."))) (define+provide/contract (visible-files dir) (directory-pathish? . -> . (listof path?)) (filter visible? (map (λ(p) (find-relative-path dir p)) (filter file-exists? (directory-list dir #:build? #t))))) ;; does path have a certain extension (define+provide/contract (has-ext? x ext) (coerce/path? coerce/symbol? . -> . coerce/boolean?) (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))))) ;; todo: add extensions (define binary-extensions '(gif jpg jpeg mp3 png zip pdf ico tar ai eps)) (define+provide/contract (has-binary-ext? x) (coerce/path? . -> . coerce/boolean?) (ormap (λ(ext) (has-ext? x ext)) binary-extensions)) ;; get file extension as a string, or return #f ;; (consistent with filename-extension behavior) (define+provide/contract (get-ext x) (coerce/path? . -> . (or/c string? #f)) (let ([fe-result (filename-extension x)]) (and fe-result (bytes->string/utf-8 fe-result)))) ;; put extension on path ;; use local contract here because this function is used within module (define/contract+provide (add-ext x ext) (coerce/string? coerce/string? . -> . coerce/path?) (string-append x "." ext)) ;; take one extension off path (define+provide/contract (remove-ext x) (coerce/path? . -> . path?) ;; pass through hidden files (those starting with a dot) (if (x . starts-with? . ".") x (path-replace-suffix x ""))) ;; take all extensions off path (define+provide/contract (remove-all-ext x) (coerce/path? . -> . path?) ;; pass through hidden files (those starting with a dot) (if (x . starts-with? . ".") x (let ([path-with-removed-ext (remove-ext x)]) (if (equal? x path-with-removed-ext) x (remove-all-ext path-with-removed-ext))))) ;; todo: tests for these predicates (define+provide/contract (preproc-source? x) (any/c . -> . coerce/boolean?) (and (pathish? x) (has-ext? (->path x) 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? . PTREE_SOURCE_EXT))) (define+provide/contract (decoder-source? x) (any/c . -> . coerce/boolean?) (and (pathish? x) ((->path x) . has-ext? . MARKUP_SOURCE_EXT))) (define+provide/contract (null-source? x) (any/c . -> . coerce/boolean?) (and (pathish? x) ((->path x) . has-ext? . 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) 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 PREPROC_SOURCE_EXT))) (define+provide/contract (->null-source-path x) (coerce/path? . -> . coerce/path?) (if (decoder-source? x) x (add-ext x NULL_SOURCE_EXT))) (define+provide/contract (->output-path x) (coerce/path? . -> . coerce/path?) (if (or (decoder-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 MARKUP_SOURCE_EXT))) (define+provide/contract (project-files-with-ext ext) (coerce/symbol? . -> . (listof complete-path?)) (map ->complete-path (filter (λ(i) (has-ext? i ext)) (directory-list (CURRENT_PROJECT_ROOT))))) ;; to identify unsaved sources in DrRacket (define (unsaved-source? path-string) ((substring (->string path-string) 0 7) . equal? . "unsaved")) ;; todo: write tests for project-files-with-ext