Merge branch 'master' into experimental

Conflicts:
	basis/http/client/client.factor

diff --combined basis/http/client/client.factor
index 22d772d2b679df2a338ae3e02e7bd5a50d3c8310,307fdd50314749880eed2d21aca99c3ac76433ea..f4764ff6f20ec1e6ac13252b6a6f54a1160ee69f
--- 1/basis/http/client/client.factor
--- 2/basis/http/client/client.factor
+++ b/basis/http/client/client.factor
@@@ -1,12 -1,12 +1,12 @@@
  ! Copyright (C) 2005, 2009 Slava Pestov.
  ! See http://factorcode.org/license.txt for BSD license.
 -USING: accessors assocs kernel math math.parser namespaces make
 +USING: accessors assocs debugger kernel math math.parser namespaces make
  sequences strings splitting calendar continuations accessors vectors
  math.order hashtables byte-arrays destructors
  io io.sockets io.streams.string io.files io.timeouts
  io.pathnames io.encodings io.encodings.string io.encodings.ascii
  io.encodings.utf8 io.encodings.8-bit io.encodings.binary io.crlf
- io.streams.duplex fry ascii urls urls.encoding present prettyprint 
+ io.streams.duplex fry ascii urls urls.encoding present locals
  http http.parsers http.client.post-data ;
  IN: http.client
  
@@@ -77,12 -77,13 +77,13 @@@ SYMBOL: redirect
  : redirect? ( response -- ? )
      code>> 300 399 between? ;
  
- : do-redirect ( quot: ( chunk -- ) response -- response )
+ :: do-redirect ( quot: ( chunk -- ) response -- response )
      redirects inc
      redirects get max-redirects < [
          request get clone
-         swap "location" header redirect-url
-         "GET" >>method swap (with-http-request)
+         response "location" header redirect-url
+         response code>> 307 = [ "GET" >>method ] unless
+         quot (with-http-request)
      ] [ too-many-redirects ] if ; inline recursive
  
  : read-chunk-size ( -- n )
@@@ -127,26 -128,19 +128,26 @@@
          [ do-redirect ] [ nip ] if
      ] with-variable ; inline recursive
  
 +PRIVATE>
 +
  : <client-request> ( url method -- request )
      <request>
          swap >>method
          swap >url ensure-port >>url ; inline
  
 -PRIVATE>
 -
  : success? ( code -- ? ) 200 299 between? ;
  
 +! ERROR: download-failed response data ;
 +
 +! M: download-failed error.
 +!     "HTTP request failed:" print nl
 +!    [ response>> . ] [ data>> . ] bi ;
  ERROR: download-failed response ;
  
  : check-response ( response -- response )
      dup code>> success? [ download-failed ] unless ;
 +! : check-response ( response data -- response data )
 +    ! over code>> success? [ download-failed ] unless ;
  
  : check-response-with-body ( response body -- response body )
      [ >>body check-response ] keep ;
@@@ -165,25 -159,13 +166,25 @@@
      <get-request> http-request ;
  
  : with-http-get ( url quot -- response )
 -    [ <get-request> ] dip with-http-request ; inline
 +    [ <get-request> ] dip with-http-request check-response ; inline
 +
 +! : <delete-request> ( url -- request )
 +!     "DELETE" <client-request> ;
 +
 +! : http-delete ( url -- response )
 +!     <delete-request> http-request ;
 +
 +! : <trace-request> ( url -- request )
 +!     <client-request> "TRACE" >>method ;
 +
 +! : http-trace ( url -- response )
 +!     <trace-request> http-request ;
  
  : download-name ( url -- name )
      present file-name "?" split1 drop "/" ?tail drop ;
  
  : download-to ( url file -- )
-     binary [ [ write ] with-http-get drop ] with-file-writer ;
+     binary [ [ write ] with-http-get check-response drop ] with-file-writer ;
  
  : download ( url -- )
      dup download-name download-to ;

diff --combined basis/urls/encoding/encoding.factor
index f9dc64485d20c4574986c1d9c4c383fb6aedbc13,15b71ac0dbc37b617bad000b810d7acba3d0c3c3..a5f5d62bfc885984865546e49157788f12cf6165
--- 1/basis/urls/encoding/encoding.factor
--- 2/basis/urls/encoding/encoding.factor
+++ b/basis/urls/encoding/encoding.factor
@@@ -14,25 -14,6 +14,25 @@@ IN: urls.encodin
          [ "/_-.:" member? ]
      } 1|| ; foldable
  
 +! see http://tools.ietf.org/html/rfc3986#section-2.2
 +: gen-delim? ( ch -- ? )
 +    ":/?#[]@" member? ; foldable
 +
 +: sub-delim? ( ch -- ? )
 +    "!$&'()*+,;=" member? ; foldable
 +
 +: reserved? ( ch -- ? )
 +    [ gen-delim? ] [ sub-delim? ] bi or ; foldable
 +
 +! see http://tools.ietf.org/html/rfc3986#section-2.3
 +: unreserved? ( ch -- ? )
 +    {
 +        [ letter? ]
 +        [ LETTER? ]
 +        [ digit? ]
 +        [ "-._~" member? ]
 +    } 1|| ; foldable
 +
  <PRIVATE
  
  : push-utf8 ( ch -- )
@@@ -46,11 -27,6 +46,11 @@@ PRIVATE
          [ dup url-quotable? [ , ] [ push-utf8 ] if ] each
      ] "" make ;
  
 +: url-encode-full ( str -- encoded )
 +    [
 +        [ dup unreserved? [ , ] [ push-utf8 ] if ] each
 +    ] "" make ;
 +
  <PRIVATE
  
  : url-decode-hex ( index str -- )
@@@ -96,6 -72,15 +96,15 @@@ PRIVATE
          ] when*
      ] 2keep set-at ;
  
+ : assoc-strings ( assoc -- assoc' )
+     [
+         {
+             { [ dup not ] [ ] }
+             { [ dup array? ] [ [ present ] map ] }
+             [ present 1array ]
+         } cond
+     ] assoc-map ;
+ 
  PRIVATE>
  
  : query>assoc ( query -- assoc )
@@@ -110,11 -95,8 +119,8 @@@
  
  : assoc>query ( assoc -- str )
      [
-         dup array? [ [ present ] map ] [ present 1array ] if
-     ] assoc-map
-     [
-         [
+         assoc-strings [
              [ url-encode ] dip
-             [ url-encode "=" glue , ] with each
+             [ [ url-encode "=" glue , ] with each ] [ , ] if*
          ] assoc-each
      ] { } make "&" join ;