Merge branch 'experimental' into couchdb

diff --cc basis/http/client/client.factor
index d684d5af9212eae2e9143f38ba7755a28584f697,aa1e0771ba76db6b0e4f504cc3724b4bce78de5b..7fdc9bf5c9c95034510a6054271139b43d798288
--- 1/basis/http/client/client.factor
--- 2/basis/http/client/client.factor
+++ b/basis/http/client/client.factor
@@@ -116,44 -112,68 +112,68 @@@ SYMBOL: redirect
      read-crlf ";" split1 drop [ blank? ] trim-right
      hex> [ "Bad chunk size" throw ] unless* ;
  
- : read-chunks ( -- )
+ : read-chunked ( quot: ( chunk -- ) -- )
      read-chunk-size dup zero?
-     [ drop ] [ read % read-crlf B{ } assert= read-chunks ] if ;
- 
- : read-response-body ( response -- response data )
-     dup "transfer-encoding" header "chunked" = [
-         binary decode-input
-         [ read-chunks ] B{ } make
-         over content-charset>> decode
-     ] [
-         dup content-charset>> decode-input
-         input-stream get contents
-     ] if ;
- 
- : (http-request) ( request -- response data )
-     dup request [
-         dup url>> url-addr ascii [
-             1 minutes timeouts
-             write-request
-             read-response
-             read-response-body
-         ] with-client
-         do-redirect
-     ] with-variable ;
+     [ 2drop ] [
+         read [ swap call ] [ drop ] 2bi
+         read-crlf B{ } assert= read-chunked
+     ] if ; inline recursive
+ 
+ : read-unchunked ( quot: ( chunk -- ) -- )
+     8192 read dup [
+         [ swap call ] [ drop read-unchunked ] 2bi
+     ] [ 2drop ] if ; inline recursive
+ 
+ : read-response-body ( quot response -- )
+     binary decode-input
+     "transfer-encoding" header "chunked" =
+     [ read-chunked ] [ read-unchunked ] if ; inline
+ 
+ : <request-socket> ( -- stream )
+     request get url>> url-addr ascii <client> drop
+     1 minutes over set-timeout ;
+ 
+ : (with-http-request) ( request quot: ( chunk -- ) -- response )
+     swap
+     request [
+         <request-socket> [
+             [
+                 out>>
+                 [ request get write-request ]
+                 with-output-stream*
+             ] [
+                 in>> [
+                     read-response dup redirect? [ t ] [
+                         [ nip response set ]
+                         [ read-response-body ]
+                         [ ]
+                         2tri f
+                     ] if
+                 ] with-input-stream*
+             ] bi
+         ] with-disposal
+         [ do-redirect ] [ nip ] if
+     ] with-variable ; inline recursive
+ 
+ PRIVATE>
  
 -: success? ( code -- ? ) 200 = ;
 +: success? ( code -- ? ) 200 299 between? ;
  
- ERROR: download-failed response body ;
+ ERROR: download-failed response ;
  
  M: download-failed error.
-     "HTTP download failed:" print nl
-     [ response>> . nl ] [ body>> write ] bi ;
+     "HTTP request failed:" print nl
+     response>> . ;
+ 
+ : check-response ( response -- response )
+     dup code>> success? [ download-failed ] unless ;
  
- : check-response ( response data -- response data )
-     over code>> success? [ download-failed ] unless ;
+ : with-http-request ( request quot -- response )
+     (with-http-request) check-response ; inline
  
  : http-request ( request -- response data )
-     (http-request) check-response ;
+     [ [ % ] with-http-request ] B{ } make
+     over content-charset>> decode ;
  
  : <get-request> ( url -- request )
      <request>