updates

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"))
+(require "coerce/value.rkt" "coerce/contract.rkt")
+(provide (all-from-out "coerce/value.rkt" "coerce/contract.rkt"))

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)

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

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)))))
+

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))]))
 

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"

scribble.rkt

@@ -1,6 +1,6 @@
 #lang racket
 (require (for-syntax racket/base))
-(require "coerce/values.rkt")
+(require "coerce/value.rkt")
 
 (provide when/block)