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/typed/sugar/coerce.rkt

109 lines
3.7 KiB
Racket

This file contains ambiguous Unicode characters!

This file contains ambiguous Unicode characters that may be confused with others in your current locale. If your use case is intentional and legitimate, you can safely ignore this warning. Use the Escape button to highlight these characters.

#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 "Cant 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))