suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

union -> or/c

Browse Source 
svn: r2143
This commit is contained in:
Jay McCarthy 2006-02-06 17:35:37 +00:00
parent e3571e1483
commit d97a87bc62
10 changed files with 34 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/web-server/default-web-root/servlets/examples/quiz.ss
View File

@ -118,7 +118,7 @@
csw)))
(list 0 0 0) questions answers))
;; end-quiz: (listof question) (listof (union number false)) -> request
;; end-quiz: (listof question) (listof (or/c number false)) -> request
;; request bindings are not currently used.
(define (end-quiz questions answers)
(send/forward

8
collects/web-server/dispatch-passwords.ss
View File

@ -45,8 +45,8 @@
;; pass-entry = (make-pass-entry str regexp (list sym str))
(define-struct pass-entry (domain pattern users))
;; access-denied? : Method string x-table denied? -> (+ false str)
;; denied?: str sym str -> (U str #f)
;; access-denied? : Method string x-table denied? -> (or/c false str)
;; denied?: str sym str -> (or/c str #f)
;; the return string is the prompt for authentication
(define (access-denied? method uri-str headers denied?)
(let ([user-pass (extract-user-pass headers)])
@ -56,7 +56,7 @@
(define-struct (exn:password-file exn) ())
;; : host -> (str sym str -> (U str #f))
;; : host -> (str sym str -> (or/c str #f))
;; to produce a function that checks if a given url path is accessible by a given user with a given
;; password. If not, the produced function returns a string, prompting for the password.
;; If the password file does not exist, all accesses are allowed. If the file is malformed, an
@ -74,7 +74,7 @@
(map (lambda (x) (make-pass-entry (car x) (regexp (cadr x)) (cddr x)))
raw))])
;; string symbol bytes -> (union #f string)
;; string symbol bytes -> (or/c #f string)
(lambda (request-path user-name password)
(ormap (lambda (x)
(and (regexp-match (pass-entry-pattern x) request-path)

2
collects/web-server/dispatch-servlets.ss
View File

@ -275,7 +275,7 @@
(string->immutable-string (format "Couldn't find ~a" servlet-filename))
(current-continuation-marks) ))]))
;; load-servlet/path path -> (union #f cache-entry)
;; load-servlet/path path -> (or/c #f cache-entry)
;; given a string path to a filename attempt to load a servlet
;; A servlet-file will contain either
;;;; A signed-unit-servlet

15
collects/web-server/request-parsing.ss
View File

@ -16,7 +16,7 @@
(provide/contract
[read-request ((connection? number? ((input-port?) . ->* . (string? string?))) . ->* . (request? boolean?))]
[read-bindings (connection? symbol? url? (listof header?)
. -> . (union (listof binding?) string?))])
. -> . (or/c (listof binding?) string?))])
;; **************************************************
@ -70,13 +70,13 @@
;; **************************************************
;; read-request-line
; Method = (U 'get 'post 'head 'put 'delete 'trace)
; Method = (or/c 'get 'post 'head 'put 'delete 'trace)
(define METHOD:REGEXP
(byte-regexp #"^(GET|HEAD|POST|PUT|DELETE|TRACE) (.+) HTTP/([0-9]+)\\.([0-9]+)$"))
(define (match-method x)
(regexp-match METHOD:REGEXP x))
;:(define match-method (type: (str -> (union false (list str str str str str)))))
;:(define match-method (type: (str -> (or/c false (list str str str str str)))))
; read-request-line : iport -> symbol url number number
@ -106,7 +106,7 @@
(define (match-colon s)
(regexp-match COLON:REGEXP s))
;:(define match-colon (type: (str -> (union false (list str str str)))))
;:(define match-colon (type: (str -> (or/c false (list str str str)))))
; read-headers : iport -> (listof (cons symbol bytes))
@ -143,7 +143,7 @@
(define INPUT-BUFFER-SIZE 4096)
;; read-bindings: connection symboll url (listof header?) -> (union (listof binding?) string?)
;; read-bindings: connection symboll url (listof header?) -> (or/c (listof binding?) string?)
(define (read-bindings conn meth uri headers)
(case meth
[(get) (url-query uri)]
@ -231,7 +231,4 @@
null
(cdr body)))])))
(define CR-NL (format "~a~a" #\return #\newline))
)
(define CR-NL (format "~a~a" #\return #\newline)))

4
collects/web-server/request-structs.ss
View File

@ -15,12 +15,12 @@
;; is this a binding
(define binding?
(cons/c symbol?
(union string?
(or/c string?
bytes?)))
(provide header? binding?)
(provide/contract
[struct request ([method symbol?] [uri url?] [headers (listof header?)]
[bindings/raw (union (listof binding?) string?)]
[bindings/raw (or/c (listof binding?) string?)]
[host-ip string?] [host-port number?]
[client-ip string?])]))

4
collects/web-server/response-structs.ss
View File

@ -54,7 +54,7 @@
[seconds number?]
[mime bytes?]
[extras (listof (cons/c symbol? string?))]
[body (listof (union string?
[body (listof (or/c string?
bytes?))])]
[struct (response/incremental response/basic)
([code number?]
@ -62,6 +62,6 @@
[seconds number?]
[mime bytes?]
[extras (listof (cons/c symbol? string?))]
[generator ((() (listof (union bytes? string?)) . ->* . any) . ->
[generator ((() (listof (or/c bytes? string?)) . ->* . any) . ->
. any)])]
[response? (any/c . -> . boolean?)]))

6
collects/web-server/servlet-helpers.ss
View File

@ -222,9 +222,9 @@
(define AUTHENTICATION-REGEXP (regexp "([^:]*):(.*)"))
(define (match-authentication x) (regexp-match AUTHENTICATION-REGEXP x))
;:(define match-authentication (type: (str -> (union false (list str str str)))))
;:(define match-authentication (type: (str -> (or/c false (list str str str)))))
; extract-user-pass : (listof (cons sym bytes)) -> (U #f (cons str str))
; extract-user-pass : (listof (cons sym bytes)) -> (or/c #f (cons str str))
;; Notes (GregP)
;; 1. This is Basic Authentication (RFC 1945 SECTION 11.1)
;; e.g. an authorization header will look like this:
@ -244,7 +244,7 @@
(cons (cadr user-pass) (caddr user-pass)))]
[else #f])))))
;; basic?: bytes -> (union (listof bytes) #f)
;; basic?: bytes -> (or/c (listof bytes) #f)
;; does the second part of the authorization header start with #"Basic "
(define basic?
(let ([basic-regexp (byte-regexp #"^Basic .*")])

4
collects/web-server/servlet-tables.ss
View File

@ -38,7 +38,7 @@
(provide
match-url-params)
(provide/contract
[continuation-url? (url? . -> . (union boolean? (list/c symbol? number? number?)))]
[continuation-url? (url? . -> . (or/c boolean? (list/c symbol? number? number?)))]
[embed-ids (symbol? number? number? url? . -> . string?)]
[store-continuation! (procedure? procedure? url? servlet-instance? . -> . string?)]
[create-new-instance! (hash-table? custodian? execution-context? semaphore? timer?
@ -130,7 +130,7 @@
in-url
(format "~a*~a*~a" inst-id k-id salt)))
;; continuation-url?: url -> (union (list number number number) #f)
;; continuation-url?: url -> (or/c (list number number number) #f)
;; determine if this url encodes a continuation and extract the instance id and
;; continuation id.
(define (continuation-url? a-url)

8
collects/web-server/tools/send-assertions.ss
View File

@ -20,7 +20,7 @@
#|
(define in?
(union
(or/c
(list-immutable/c (xexpr/callback? . -> . string?)
(listof (cons/c symbol? string?)))
(symbols 'back 'forward)
@ -38,7 +38,7 @@
;; A history is a
;; (make-history string? (listof (cons/p symbol? string?))
;; (union #f (listof (cons/p symbol? string?)))
;; (or/c #f (listof (cons/p symbol? string?)))
(define-struct history (k-url bindings headers))
;; Go over the input list, resuming the servlet on each choice, until the
@ -102,7 +102,7 @@
((l) (resumer (history/list l r)))
((? null?) r))))
;; history/list : (union (list/p (xexpr? . -> . string?)
;; history/list : (or/c (list/p (xexpr? . -> . string?)
;; (listof (cons/p symbol? string?)))
;; (list/p (xexpr? . -> . string?)
;; (listof (cons/p symbol? string?))
@ -150,7 +150,7 @@
(else #f)))
;; Produce the k-url used for the next part of the form
;; (xexpr/callback? . -> . (union false? string?))
;; (xexpr/callback? . -> . (or/c false? string?))
(define-syntax hyperlink->k-url
(syntax-rules ()
((_ str)

18
collects/web-server/util.ss
View File

@ -17,13 +17,13 @@
[valid-port? (any/c . -> . boolean?)]
[decompose-request ((request?) . ->* . (url? symbol? string?))]
[network-error ((symbol? string?) (listof any/c) . ->* . (void))]
[path->list (path? . -> . (cons/c (union path? (symbols 'up 'same))
(listof (union path? (symbols 'up 'same)))))]
[url-path->path ((union (symbols 'up 'same) path?) string? . -> . path?)]
[path->list (path? . -> . (cons/c (or/c path? (symbols 'up 'same))
(listof (or/c path? (symbols 'up 'same)))))]
[url-path->path ((or/c (symbols 'up 'same) path?) string? . -> . path?)]
[directory-part (path? . -> . path?)]
[lowercase-symbol! ((union string? bytes?) . -> . symbol?)]
[exn->string ((union exn? any/c) . -> . string?)]
[build-path-unless-absolute (path? (union string? path?) . -> . path?)])
[lowercase-symbol! ((or/c string? bytes?) . -> . symbol?)]
[exn->string ((or/c exn? any/c) . -> . string?)]
[build-path-unless-absolute (path? (or/c string? path?) . -> . path?)])
;; valid-port? : any/c -> boolean?
(define (valid-port? p)
@ -61,13 +61,13 @@
(apply format (format "~a: ~a" src fmt) args))
(current-continuation-marks))))
;; build-path-unless-absolute : path (union string? path?) -> path?
;; build-path-unless-absolute : path (or/c string? path?) -> path?
(define (build-path-unless-absolute base path)
(if (absolute-path? path)
(build-path path)
(build-path base path)))
;; exn->string : (union exn any) -> string
;; exn->string : (or/c exn any) -> string
(define (exn->string exn)
(if (exn? exn)
(parameterize ([current-error-port (open-output-string)])
@ -75,7 +75,7 @@
(get-output-string (current-error-port)))
(format "~s\n" exn)))
; lowercase-symbol! : (union string bytes) -> symbol
; lowercase-symbol! : (or/c string bytes) -> symbol
(define (lowercase-symbol! s)
(let ([s (if (bytes? s)
(bytes->string/utf-8 s)