You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
sugar/file.rkt

58 lines
1.9 KiB
Racket

9 years ago
#lang racket/base
(require "define.rkt" racket/set "coerce.rkt" racket/path "unstable/string.rkt")
10 years ago
9 years ago
10 years ago
;; does path have a certain extension
9 years ago
(define+provide+safe (has-ext? x ext)
(coerce/path? coerce/string? . -> . coerce/boolean?)
10 years ago
(define ext-of-path (filename-extension (->path x)))
(->boolean (and ext-of-path (equal? (string-downcase (bytes->string/utf-8 ext-of-path)) (string-downcase (->string ext))))))
9 years ago
10 years ago
;; get file extension as a string, or return #f
;; (consistent with filename-extension behavior)
9 years ago
(define+provide+safe (get-ext x)
(coerce/path? . -> . (or/c #f string?))
10 years ago
(let ([fe-result (filename-extension (->path x))])
(and fe-result (bytes->string/utf-8 fe-result))))
;; todo: add extensions
9 years ago
(provide+safe binary-extensions)
(define binary-extensions
10 years ago
(map symbol->string '(gif jpg jpeg mp3 png zip pdf ico tar ai eps exe)))
9 years ago
(define+provide+safe (has-binary-ext? x)
(coerce/path? . -> . coerce/boolean?)
10 years ago
(let ([x (->path x)])
9 years ago
(ormap (λ(ext) (has-ext? x ext)) binary-extensions)))
10 years ago
;; put extension on path
;; use local contract here because this function is used within module
9 years ago
(define+provide+safe (add-ext x ext)
(coerce/string? coerce/string? . -> . coerce/path?)
10 years ago
(->path (string-append (->string x) "." (->string ext))))
;; take one extension off path
9 years ago
(define+provide+safe (remove-ext x)
(coerce/path? . -> . path?)
10 years ago
;; pass through hidden files (those starting with a dot)
(let ([x (->path x)])
(if ((->string x) . starts-with? . ".")
10 years ago
x
(path-replace-suffix x ""))))
;; take all extensions off path
9 years ago
(define+provide+safe (remove-ext* x)
(coerce/path? . -> . path?)
10 years ago
;; pass through hidden files (those starting with a dot)
(let ([x (->path x)])
(if ((->string x) . starts-with? . ".")
10 years ago
x
(let ([path-with-removed-ext (remove-ext x)])
(if (equal? x path-with-removed-ext)
x
9 years ago
(remove-ext* path-with-removed-ext))))))