Typed wrappers for file/gif and almost all of net/*.

svn: r12518

collects/typed/file/gif.ss

@@ -0,0 +1,17 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/opaque-type GIF-Stream gif-stream? file/gif)
+
+(require/typed/provide file/gif
+  [gif-start ( Output-Port Number Number Number (U #f (Listof (Vectorof Number))) -> Void )]
+  [gif-add-image ( GIF-Stream Number Number Number Number Boolean (U #f Number) String -> Void )]
+  [gif-add-control ( GIF-Stream Symbol Boolean Number (U #f Number) -> Void)]
+  [gif-add-loop-control ( GIF-Stream Number -> Void )]
+  [gif-add-comment ( GIF-Stream String -> Void )]
+  [gif-end ( GIF-Stream -> Void )]
+  [quantize ( String -> (values String (Listof (Vectorof Number)) (U #f (Vectorof Number))))])
+  
+(provide gif-stream? GIF-Stream)
+  

collects/typed/net/base64.ss

@@ -0,0 +1,13 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/typed/provide net/base64
+  [base64-encode-stream (case-lambda (Input-Port Output-Port -> Void)
+                                     (Input-Port Output-Port Bytes -> Void))]
+  [base64-decode-stream (Input-Port Output-Port -> Void)]
+  [base64-encode (Bytes -> Bytes)]
+  [base64-decode (Bytes -> Bytes)])
+
+(provide base64-encode-stream base64-decode-stream base64-encode base64-decode)
+  

collects/typed/net/cgi.ss

@@ -0,0 +1,27 @@
+#lang typed-scheme
+  
+(require typed/private/utils)
+
+(require-typed-struct cgi-error () net/cgi)
+(require-typed-struct incomplete-%-suffix  ([chars : (Listof Char)]) net/cgi) 
+(require-typed-struct invalid-%-suffix  ([char : Char]) net/cgi)
+  
+(require/typed/provide net/cgi
+  [get-bindings (-> (Listof (cons (U Symbol String) String)))]
+  [get-bindings/post (-> (Listof (Pair (U Symbol String) String)))]
+  [get-bindings/get (-> (Listof (Pair (U Symbol String) String)) )]
+  [output-http-headers (-> Void)]
+  [generate-html-output (case-lambda (String (Listof String) -> Void) 
+				     (String (Listof String) String String String String String -> Void))]
+  [generate-error-output ((Listof String) -> (U))]
+  [bindings-as-html ((Listof (cons (U Symbol String) String)) -> (Listof String))]
+  [extract-bindings ((U Symbol String) (Listof (cons (U Symbol String) String)) -> ( Listof  String))]
+  [extract-binding/single ((U Symbol String) (Listof (Pair (U Symbol String) String)) ->  String)]
+  [get-cgi-method (-> (U "GET" "POST"))]
+  [string->html (String -> String)]
+  [generate-link-text (String String -> String)])
+
+(provide
+ (struct-out cgi-error)
+ (struct-out incomplete-%-suffix)
+ (struct-out invalid-%-suffix))

collects/typed/net/cookie.ss

@@ -0,0 +1,23 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/opaque-type Cookie cookie? net/cookie)
+
+(require/typed/provide net/cookie
+  [set-cookie (String String -> Cookie)]
+  [cookie:add-comment (Cookie String -> Cookie)]
+  [cookie:add-domain (Cookie String -> Cookie)]
+  [cookie:add-max-age (Cookie Number -> Cookie)]
+  [cookie:add-path (Cookie String -> Cookie)]
+  [cookie:secure (Cookie Boolean -> Cookie)]
+  [cookie:version (Cookie Number -> Cookie)]
+  
+  [print-cookie (Cookie -> String)]
+  
+  [get-cookie (String String -> (Listof String))]
+  [get-cookie/single (String String -> (Option String))])
+
+(require-typed-struct  cookie-error () net/cookie)
+
+(provide Cookie cookie? (struct-out cookie-error))

collects/typed/net/dns.ss

@@ -0,0 +1,10 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/typed/provide net/dns
+  [dns-get-address (String String -> String)]
+  [dns-get-name (String String -> String)]
+  [dns-get-mail-exchanger (String String -> String )]
+  [dns-find-nameserver (-> (Option String))])
+

collects/typed/net/ftp.ss

@@ -0,0 +1,16 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/opaque-type FTP-Connection ftp-connection? net/ftp)
+
+(require/typed/provide net/ftp
+  [ftp-cd (FTP-Connection String -> Void)]
+  [ftp-establish-connection (String Number String String -> FTP-Connection)]
+  [ftp-close-connection (FTP-Connection -> Void)]
+  [ftp-directory-list (FTP-Connection -> (Listof (List (U "-" "d" "l") String String)))]
+  [ftp-download-file (FTP-Connection Path String -> Void)]
+  [ftp-make-file-seconds (String -> Number)])
+
+(provide ftp-connection? FTP-Connection)
+

collects/typed/net/gifwrite.ss

@@ -0,0 +1,4 @@
+#lang typed-scheme
+
+(require typed/file/gif)
+(provide (all-from-out typed/file/gif))

collects/typed/net/head.ss

@@ -0,0 +1,31 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/typed/provide net/head
+  [empty-header String]
+  [validate-header (String -> Void)]
+  [extract-field (Bytes (U Bytes String) -> (Option Bytes))]
+  [remove-field (String String -> String)]
+  [insert-field (String String String -> String)]
+  [replace-field (String String String -> String)]
+  [extract-all-fields ((U String Bytes) -> (Listof (cons (U String Bytes) (U Bytes String))))]
+  [append-headers (String String -> String)]
+  [standard-message-header (String (Listof String) (Listof String) (Listof String) String -> String)]
+  [data-lines->data ((Listof String) -> String)]
+  [extract-addresses (String Symbol -> (U (Listof String) (Listof (Listof String))))]
+  [assemble-address-field ((Listof String) -> String)])
+
+(provide
+ empty-header
+ validate-header
+ extract-field
+ remove-field
+ insert-field
+ replace-field
+ extract-all-fields
+ append-headers
+ standard-message-header
+ data-lines->data
+ extract-addresses
+ assemble-address-field)

collects/typed/net/imap.ss

@@ -0,0 +1,55 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/opaque-type IMAP-Connection imap-connection? net/imap)
+
+(define-type-alias bstring (U String Bytes))
+
+(require/typed/provide net/imap
+  [imap-port-number (Number -> Void)]   
+  
+  [imap-connect (String String String String -> (values IMAP-Connection Number Number))] 
+  [imap-connect* (Number Number String String String -> (values IMAP-Connection Number Number))]
+  [imap-disconnect (IMAP-Connection -> Void)]
+  [imap-force-disconnect (IMAP-Connection -> Void)]
+  [imap-reselect (IMAP-Connection String -> (values Number Number))]
+  [imap-examine (IMAP-Connection String -> (values Number Number))]
+  [imap-noop (IMAP-Connection -> (values Number Number))]
+  [imap-status (IMAP-Connection String (Listof Symbol) -> (Listof (Listof Number)))]
+  [imap-poll (IMAP-Connection -> Void)]
+  
+  [imap-new? (IMAP-Connection -> Boolean)]
+  [imap-messages (IMAP-Connection -> Number)]
+  [imap-recent (IMAP-Connection -> Number)]
+  [imap-uidnext (IMAP-Connection -> (Option Number))]
+  [imap-uidvalidity (IMAP-Connection -> (Option Number))]
+  [imap-unseen (IMAP-Connection -> (Option Number))]
+  [imap-reset-new! (IMAP-Connection -> Void)]
+  
+  [imap-get-expunges (IMAP-Connection -> (Listof Number))]
+  [imap-pending-expunges? (IMAP-Connection -> Boolean)]
+  [imap-get-updates (IMAP-Connection -> (Listof (cons Number (Listof (Pair Any Any)))))]
+  [imap-pending-updates? (IMAP-Connection -> Boolean)]
+  
+  [imap-get-messages 
+   (IMAP-Connection (Listof Number) Symbol -> (Listof (Listof (U Number String String (Listof Symbol)))))]
+  [imap-copy  (IMAP-Connection (Listof Number) String -> Void)]
+  [imap-append (IMAP-Connection String String -> Void)] 
+  [imap-store (IMAP-Connection Symbol (Listof Number) Symbol -> Void)]
+  [imap-flag->symbol (Symbol -> Symbol)]
+  [symbol->imap-flag (Symbol -> Symbol)]
+  [imap-expunge (IMAP-Connection -> Void)]
+  
+  [imap-mailbox-exists? (IMAP-Connection String -> Boolean)]
+  [imap-create-mailbox (IMAP-Connection String -> Void)]
+  
+  [imap-list-child-mailboxes 
+   (case-lambda (IMAP-Connection bstring -> (Listof (cons (Listof Symbol) (cons String '()))))
+                (IMAP-Connection bstring (Option bstring) -> (Listof (List (Listof Symbol) String))))]
+  [imap-mailbox-flags (IMAP-Connection String -> (Listof Symbol))]
+  [imap-get-hierarchy-delimiter (IMAP-Connection -> String)])
+
+(provide
+ imap-connection?
+ IMAP-Connection)

collects/typed/net/mime.ss

@@ -0,0 +1,71 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+;; -- basic mime structures --
+(require-typed-struct disposition
+                      ([type : Symbol] 
+                       [filename : String]
+                       [creation : String]
+                       [modification : String]
+                       [read : String]                                       
+                       [size : Number]
+                       [params : Any])
+                      net/mime)
+(require-typed-struct entity  ([type : (U Symbol String)] 
+                               [subtype : (U Symbol String)] 
+                               [charset : (U Symbol String)] 
+                               [encoding : Symbol]
+                               [disposition : disposition ]
+                               [params : (Listof (cons Symbol String))]
+                               [id : String]
+                               [description : String] 
+                               [other : String]
+                               [fields : Any]
+                               [parts : (Listof String) ]
+                               [body : (Output-Port -> Void)])
+                      net/mime)
+(require-typed-struct message 
+                      ([version : String] [entity :  entity] [fields : (Listof Symbol)])
+                      net/mime)
+
+
+;; -- exceptions raised --
+(require/typed mime-error? (Any -> Boolean : (Opaque mime-error?)) net/mime)
+(require/typed unexpected-termination? (Any -> Boolean :(Opaque unexpected-termination?)) net/mime)
+(require/typed unexpected-termination-msg ((Opaque unexpected-termination?) -> message) net/mime)
+(require/typed missing-multipart-boundary-parameter? (Any -> Boolean : (Opaque missing-multipart-boundary-parameter?)) net/mime)
+(require/typed malformed-multipart-entity? (Any -> Boolean : (Opaque malformed-multipart-entity?)) net/mime)
+(require/typed malformed-multipart-entity-msg ((Opaque malformed-multipart-entity?)-> message) net/mime)
+(require/typed empty-mechanism? (Any -> Boolean : (Opaque empty-mechanism?)) net/mime)
+(require/typed empty-type? (Any -> Boolean : (Opaque empty-type?)) net/mime)
+(require/typed empty-subtype? (Any -> Boolean : (Opaque empty-subtype?)) net/mime)
+(require/typed empty-disposition-type? (Any -> Boolean : (Opaque empty-disposition-type?)) net/mime)
+
+
+;; -- mime methods --
+(require/typed/provide net/mime
+  [mime-analyze ((U Bytes Input-Port) Any -> message)])
+
+(provide
+ ;; -- exceptions raised --
+ mime-error? 
+ unexpected-termination? 
+ unexpected-termination-msg
+ missing-multipart-boundary-parameter? 
+ malformed-multipart-entity?
+ malformed-multipart-entity-msg
+ empty-mechanism? 
+ empty-type? 
+ empty-subtype?
+ empty-disposition-type? 
+ 
+ ;; -- basic mime structures --
+ message 
+ entity
+ 
+ disposition
+ 
+ ;; -- mime methods --
+ mime-analyze
+)
+

collects/typed/net/nntp.ss

@@ -0,0 +1,31 @@
+#lang typed-scheme
+  
+(require typed/private/utils)
+
+(require-typed-struct communicator ([sender : Number] [receiver : Number] [server : String] [port : Number])
+		      net/nntp)
+
+(require/typed/provide net/nntp  
+  [connect-to-server (case-lambda (String -> communicator) (String Number -> communicator))]
+  [disconnect-from-server (communicator -> Void)]
+  [authenticate-user  (communicator String String -> Void)]
+  [open-news-group (communicator String -> (values Number Number Number))]
+  [head-of-message  (communicator Number -> (Listof String))]
+  [body-of-message (communicator Number -> (Listof String))]
+  [newnews-since  (communicator Number -> (Listof String))]
+  [generic-message-command (communicator Number -> (Listof String))]
+  [make-desired-header  (String -> String)] ;;-> Regexp
+  [extract-desired-headers ((Listof String) (Listof String) -> (Listof String))]) ;;2nd: Of Regexp
+#|
+;; requires structure inheritance
+(require-typed-struct nntp ()]
+(require-typed-struct unexpected-response ([code : Number] [text : String])]
+(require-typed-struct bad-status-line ([line : String])]
+(require-typed-struct premature-close ([communicator : communicator])]
+(require-typed-struct bad-newsgroup-line ([line : String])]
+(require-typed-struct non-existent-group ([group : String])]
+(require-typed-struct article-not-in-group ([article : Number])]
+(require-typed-struct no-group-selected ()]
+(require-typed-struct article-not-found ([article : Number])]
+(require-typed-struct authentication-rejected ()]
+|#

collects/typed/net/pop3.ss

@@ -0,0 +1,38 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require-typed-struct communicator ([sender : Number] [receiver : Number] [server : String] [port : Number] [state : Symbol])net/pop3)
+
+(require/typed/provide net/pop3
+  [connect-to-server ( case-lambda (String -> (Opaque communicator?)) (String Number -> (Opaque communicator?)) )] 
+
+  [disconnect-from-server ( (Opaque communicator?) -> Void )]
+  [authenticate/plain-text ( String String (Opaque communicator?) -> Void )]
+  [get-mailbox-status ( (Opaque communicator?) -> (values Number Number) )]
+  [get-message/complete  ( (Opaque communicator?) Number -> (values (Listof String)(Listof String)) )]
+  [get-message/headers  ( (Opaque communicator?) Number -> (Listof String) )]
+  [get-message/body ( (Opaque communicator?) Number -> (Listof String) )]
+  [delete-message ( (Opaque communicator?) Number -> Void )]
+  [get-unique-id/single  ( (Opaque communicator?) Number -> String )]
+  [get-unique-id/all ( (Opaque communicator?) -> (Listof (cons Number String)) )]
+  
+  [make-desired-header  ( String -> String )];-> Regexp
+  [extract-desired-headers ( (Listof String)(Listof String)-> (Listof String) )];2nd:of Regexp
+  )
+(provide (struct-out communicator))
+
+#|
+(require-typed-struct pop3 ()]
+(require-typed-struct cannot-connect ()]
+(require-typed-struct username-rejected ()]
+(require-typed-struct password-rejected ()]
+(require-typed-struct not-ready-for-transaction ([ communicator : (Opaque communicator?) ])net/pop3) 
+(require-typed-struct not-given-headers ([ communicator : (Opaque communicator?) ] [message : String])]
+(require-typed-struct illegal-message-number ([communicator : (Opaque communicator?)] [message : String])]
+(require-typed-struct cannot-delete-message ([communicator : (Opaque communicator?)] [message : String])] 
+(require-typed-struct disconnect-not-quiet ([communicator : (Opaque communicator?)])]
+(require-typed-struct malformed-server-response ([communicator : (Opaque communicator?)])net/pop3) 
+|#
+
+  

collects/typed/net/qp.ss

@@ -0,0 +1,10 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/typed/provide net/qp
+  [qp-encode ( String -> String )]
+  [qp-decode ( String -> String )]
+  [qp-encode-stream (case-lambda (Input-Port Output-Port -> Void) (Input-Port Output-Port String -> Void) )]
+  [qp-decode-stream ( Input-Port Output-Port -> Void )])
+  

collects/typed/net/sendmail.ss

@@ -0,0 +1,12 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/typed/provide net/sendmail
+  [send-mail-message/port 
+   (String String (Listof String) (Listof String) (Listof String) String * -> Output-Port)]
+  [send-mail-message
+   (String String (Listof String) (Listof String) (Listof String) (Listof String) String * -> Output-Port)])
+  
+(provide send-mail-message/port send-mail-message #;no-mail-recipients)
+  

collects/typed/net/sendurl.ss

@@ -0,0 +1,9 @@
+#lang typed-scheme
+(require/typed net/sendurl
+	       [send-url (String -> Void)]
+	       [unix-browser-list (Listof Symbol)]
+	       [browser-preference? (String -> Boolean)]
+	       [external-browser  (-> (U Symbol #f (Pair String String)))])
+
+(provide send-url unix-browser-list browser-preference? external-browser)
+  

collects/typed/net/smtp.ss

@@ -0,0 +1,11 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/typed/provide net/smtp
+  [smtp-send-message (String String (Listof String) String (Listof String) -> Void)]
+  [smtp-sending-end-of-message (Parameter (-> Any))])
+  
+(provide smtp-send-message smtp-sending-end-of-message)
+  
+  

collects/typed/net/uri-codec.ss

@@ -0,0 +1,15 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/typed/provide net/uri-codec
+  [uri-encode ( String -> String )]
+  [uri-decode ( String -> String )]
+  
+  [form-urlencoded-encode ( String -> String )]
+  [form-urlencoded-decode ( String -> String )]
+  
+  [alist->form-urlencoded ( (Listof (cons Symbol String)) -> String )]
+  [form-urlencoded->alist ( String -> (Listof (cons Symbol String)) )]
+  [current-alist-separator-mode (Parameter Symbol)])
+    

collects/typed/net/url.ss

@@ -0,0 +1,59 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require-typed-struct path/param ([path : (U String 'up 'same)] [param : (Listof String)]) net/url)
+
+(require-typed-struct url ([scheme : (Option String)]
+                           [user : (Option String)]
+                           [host : (Option String)]
+                           [port : (Option Integer)]
+                           [path-absolute? : Boolean]
+                           [path : (Listof path/param)] 
+                           [query : (Listof (Pair Symbol (Option String)))]
+                           [fragment : (Option String)])
+                      net/url)
+
+(require/opaque-type URL-Exception url-exception? net/url)
+
+(define-type-alias PortT (case-lambda (url -> Input-Port) (url (Listof String)-> Input-Port)))
+(define-type-alias PortT/String (case-lambda (url String -> Input-Port) (url String (Listof String)-> Input-Port)))
+
+(require/typed/provide net/url
+  
+  [path->url (Path -> url)]
+  [url->path (case-lambda (url -> Path) (url (U 'unix 'windows) -> Path))]
+  
+  [file-url-path-convention-type (Parameter (U 'unix 'windows))]
+  
+  [get-pure-port PortT]  
+  [head-pure-port PortT]
+  [delete-pure-port PortT]
+  
+  [get-impure-port PortT]  
+  [head-impure-port PortT]  
+  [delete-impure-port PortT]
+  
+  [post-pure-port PortT/String]
+  [put-pure-port PortT/String]
+  
+  [post-impure-port PortT/String]  
+  [put-impure-port PortT/String]
+  
+  [display-pure-port (Input-Port -> Void)]
+  [purify-port (Input-Port -> String)]
+  
+  [call/input-url (case-lambda [url url (Input-Port -> Any) -> Any])] ;;FIXME - need polymorphism
+  
+  [current-proxy-servers (Parameter (Listof (List String String Integer)))]
+  
+  [netscape/string->url (String -> url)]
+  [string->url (String -> url)]
+  [url->string (url -> String)]
+  [combine-url/relative (url String -> url)])
+
+(provide
+ URL-Exception
+ url-exception?
+ (struct-out url)
+ (struct-out path/param))