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.
109 lines
3.7 KiB
Racket
109 lines
3.7 KiB
Racket
#lang typed/racket/base
|
|
(require (for-syntax typed/racket/base racket/syntax) sugar/include)
|
|
(include-without-lang-line "coerce-helper.rkt")
|
|
(require typed/sugar/define racket/set racket/sequence "len.rkt") ; want relative path-spec for bilingual conversion
|
|
|
|
(define-syntax-rule (make-coercion-error-handler target-format x)
|
|
(λ(e) (error (string->symbol (format "->~a" target-format)) (format "Can't convert ~s to ~a" x target-format))))
|
|
|
|
|
|
(define-type Intable (U Number String Symbol Char Path Lengthable))
|
|
(define/typed+provide (->int x)
|
|
(Intable -> Integer)
|
|
(with-handlers ([exn:fail? (make-coercion-error-handler 'int x)])
|
|
(cond
|
|
[(or (integer? x) (real? x)) (assert (inexact->exact (floor x)) integer?)]
|
|
[(complex? x) (->int (real-part x))]
|
|
[(string? x) (let ([strnum (string->number x)])
|
|
(if (real? strnum) (->int strnum) (error 'ineligible-string)))]
|
|
[(or (symbol? x) (path? x)) (->int (->string x))]
|
|
[(char? x) (char->integer x)]
|
|
[else (len x)]))) ; covers Lengthable types
|
|
|
|
|
|
(provide Stringish)
|
|
(define-type Stringish (U String Symbol Number Path Char Null Void SugarURL))
|
|
|
|
|
|
(define/typed+provide (->string x)
|
|
(Stringish -> String)
|
|
(if (string? x)
|
|
x ; fast exit for strings
|
|
(with-handlers ([exn:fail? (make-coercion-error-handler 'string x)])
|
|
(cond
|
|
[(or (equal? '() x) (void? x)) ""]
|
|
[(symbol? x) (symbol->string x)]
|
|
[(number? x) (number->string x)]
|
|
[(path? x) (path->string x)]
|
|
[(char? x) (format "~a" x)]
|
|
[(url? x) (url->string x)]
|
|
[else (error 'bad-type)]))))
|
|
|
|
|
|
;; ->symbol, ->path, and ->url are just variants on ->string
|
|
;; two advantages: return correct type, and more accurate error
|
|
|
|
;; no need for "Symbolable" type - same as Stringable
|
|
(define/typed+provide (->symbol x)
|
|
(Stringish -> Symbol)
|
|
(if (symbol? x)
|
|
x
|
|
(with-handlers ([exn:fail? (make-coercion-error-handler 'symbol x)])
|
|
(string->symbol (->string x)))))
|
|
|
|
|
|
(define-type Pathish (U Stringish url))
|
|
(provide Pathish)
|
|
(define/typed+provide (->path x)
|
|
(Pathish -> Path)
|
|
(if (path? x)
|
|
x
|
|
(with-handlers ([exn:fail? (make-coercion-error-handler 'path x)])
|
|
(cond
|
|
[(url? x) (apply build-path (cast (map path/param-path (url-path x)) (List* Path-String (Listof Path-String))))]
|
|
[else (string->path (->string x))]))))
|
|
|
|
|
|
;; Use private name here because 'URL' identifier has been added since 6.0
|
|
(define-type SugarURL url)
|
|
(define/typed+provide (->url x)
|
|
(Stringish -> SugarURL)
|
|
(with-handlers ([exn:fail? (make-coercion-error-handler 'url x)])
|
|
(string->url (->string x))))
|
|
|
|
|
|
(define/typed+provide (->complete-path x)
|
|
(Stringish -> Path)
|
|
(with-handlers ([exn:fail? (make-coercion-error-handler 'complete-path x)])
|
|
(path->complete-path (->path x))))
|
|
|
|
|
|
(define/typed+provide (->list x)
|
|
(Any -> (Listof Any))
|
|
(if (list? x)
|
|
x
|
|
(with-handlers ([exn:fail? (make-coercion-error-handler 'list x)])
|
|
(cond
|
|
[(string? x) (list x)]
|
|
[(vector? x) (for/list ([i (in-vector x)])
|
|
i)]
|
|
[(set? x) (set->list x)]
|
|
;; conditional sequencing relevant because hash also tests true for `sequence?`
|
|
[(hash? x) (hash->list x)]
|
|
[(integer? x) (list x)] ; because an integer tests #t for sequence?
|
|
[(sequence? x) (sequence->list x)]
|
|
;[(stream? x) (stream->list x)] ;; no support for streams in TR
|
|
[else (list x)]))))
|
|
|
|
|
|
(define/typed+provide (->vector x)
|
|
(Any -> VectorTop)
|
|
(if (vector? x)
|
|
x
|
|
(with-handlers ([exn:fail? (make-coercion-error-handler 'vector x)])
|
|
(list->vector (->list x)))))
|
|
|
|
|
|
(define/typed+provide (->boolean x)
|
|
(Any -> Boolean)
|
|
(and x #t)) |