From ef19672eeb65c7f52a6d4fff73e748ff0a4a93f9 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 11 Mar 2014 23:39:36 -0700 Subject: [PATCH] updates --- coerce.rkt | 4 +- coerce/{contracts.rkt => contract.rkt} | 2 +- coerce/{values.rkt => value.rkt} | 17 ++++++++ file.rkt | 59 ++++++++++++++++++++++++++ list.rkt | 4 +- main.rkt | 2 + scribble.rkt | 2 +- 7 files changed, 84 insertions(+), 6 deletions(-) rename coerce/{contracts.rkt => contract.rkt} (94%) rename coerce/{values.rkt => value.rkt} (77%) create mode 100644 file.rkt diff --git a/coerce.rkt b/coerce.rkt index cc3e524..cba6bb6 100644 --- a/coerce.rkt +++ b/coerce.rkt @@ -1,4 +1,4 @@ #lang racket/base -(require "coerce/values.rkt" "coerce/contracts.rkt") -(provide (all-from-out "coerce/values.rkt" "coerce/contracts.rkt")) \ No newline at end of file +(require "coerce/value.rkt" "coerce/contract.rkt") +(provide (all-from-out "coerce/value.rkt" "coerce/contract.rkt")) \ No newline at end of file diff --git a/coerce/contracts.rkt b/coerce/contract.rkt similarity index 94% rename from coerce/contracts.rkt rename to coerce/contract.rkt index dd5dd27..d147972 100644 --- a/coerce/contracts.rkt +++ b/coerce/contract.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/contract "../define/provide.rkt" "values.rkt") +(require racket/contract "../define/provide.rkt" "value.rkt") (define-syntax-rule (make-blame-handler try-proc expected-sym) diff --git a/coerce/values.rkt b/coerce/value.rkt similarity index 77% rename from coerce/values.rkt rename to coerce/value.rkt index c747a22..620ade7 100644 --- a/coerce/values.rkt +++ b/coerce/value.rkt @@ -1,4 +1,5 @@ #lang racket/base +(require (for-syntax racket/base racket/syntax)) (require net/url xml racket/set) (require "../len.rkt" "../define/provide.rkt") @@ -77,3 +78,19 @@ (and x #t)) +(define-syntax (make-*ish-predicate stx) + (syntax-case stx () + [(_ stem) + (with-syntax ([stemish? (format-id stx "~aish?" #'stem)] + [->stem (format-id stx "->~a" #'stem)]) + #`(begin + (define+provide (stemish? x) + (with-handlers ([exn:fail? (λ(e) #f)]) (and (->stem x) #t)))))])) + +(make-*ish-predicate int) +(make-*ish-predicate string) +(make-*ish-predicate symbol) +(make-*ish-predicate url) +(make-*ish-predicate complete-path) +(make-*ish-predicate path) +;; no point to having list and vector here; they work with everything diff --git a/file.rkt b/file.rkt new file mode 100644 index 0000000..4e0d160 --- /dev/null +++ b/file.rkt @@ -0,0 +1,59 @@ +#lang racket/base +(require sugar/define/contract sugar/coerce/contract sugar/string racket/path) + + + +(define+provide/contract (get-enclosing-dir p) + (coerce/path? . -> . path?) + (simplify-path (build-path p 'up))) + +;; 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))))) + +;; get file extension as a string, or return #f +;; (consistent with filename-extension behavior) +(define+provide/contract (get-ext x) + (coerce/path? . -> . (or/c #f string?)) + (let ([fe-result (filename-extension x)]) + (and fe-result (bytes->string/utf-8 fe-result)))) + + +;; todo: add extensions +(define binary-extensions + '(gif jpg jpeg mp3 png zip pdf ico tar ai eps exe)) + +(define+provide/contract (has-binary-ext? x) + (coerce/path? . -> . coerce/boolean?) + (ormap (λ(ext) (has-ext? x ext)) binary-extensions)) + + + +;; 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))))) + diff --git a/list.rkt b/list.rkt index 06a9ca1..e2c7c2d 100644 --- a/list.rkt +++ b/list.rkt @@ -1,6 +1,6 @@ #lang racket/base (require racket/list) -(require "define/contract.rkt" "len.rkt" "coerce/values.rkt") +(require "define/contract.rkt" "len.rkt" "coerce/value.rkt") (define+provide/contract (trim items test-proc) (list? procedure? . -> . list?) @@ -40,7 +40,7 @@ (any/c . -> . boolean?) (cond [(list? x) (= (len (remove-duplicates x)) (len x))] - [(vector? x) (members-unique? (->list x))] + [(vector? x) (members-unique? (vector->list x))] [(string? x) (members-unique? (string->list x))] [else (error (format "members-unique cannot be determined for ~a" x))])) diff --git a/main.rkt b/main.rkt index 0cc9359..e035fad 100644 --- a/main.rkt +++ b/main.rkt @@ -5,6 +5,7 @@ "container.rkt" "debug.rkt" "define.rkt" + "file.rkt" "list.rkt" "misc.rkt" "string.rkt" @@ -20,6 +21,7 @@ "container.rkt" "debug.rkt" "define.rkt" + "file.rkt" "list.rkt" "misc.rkt" "string.rkt" diff --git a/scribble.rkt b/scribble.rkt index eb1757b..bd3b473 100644 --- a/scribble.rkt +++ b/scribble.rkt @@ -1,6 +1,6 @@ #lang racket (require (for-syntax racket/base)) -(require "coerce/values.rkt") +(require "coerce/value.rkt") (provide when/block)