urls.encoding: support byte-array values for encoding.

basis/urls/encoding/encoding-docs.factor

@@ -6,11 +6,11 @@ HELP: url-decode
 { $description "Decodes a URL-encoded string." } ;
 
 HELP: url-encode
-{ $values { "str" string } { "encoded" string } }
+{ $values { "obj" object } { "encoded" string } }
 { $description "URL-encodes a string, excluding certain characters, such as \"/\"." } ;
 
 HELP: url-encode-full
-{ $values { "str" string } { "encoded" string } }
+{ $values { "obj" object } { "encoded" string } }
 { $description "URL-encodes a string, including all reserved characters, such as \"/\"." } ;
 
 HELP: url-quotable?

basis/urls/encoding/encoding-tests.factor

@@ -17,6 +17,9 @@ accessors linked-assocs ;
 { ":foo" } [ ":foo" url-encode ] unit-test
 { "%3Afoo" } [ ":foo" url-encode-full ] unit-test
 
+{ "%01%02%03ABC" } [ B{ 1 2 3 65 66 67 } url-encode ] unit-test
+{ "%01%02%03ABC" } [ B{ 1 2 3 65 66 67 } url-encode-full ] unit-test
+
 { "hello world" } [ "hello+world" query-decode ] unit-test
 
 { "\u001234hi\u002045" } [ "\u001234hi\u002045" url-encode url-decode ] unit-test

basis/urls/encoding/encoding.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays ascii assocs combinators combinators.short-circuit
-fry io.encodings.string io.encodings.utf8 kernel linked-assocs
-make math math.parser present sequences splitting strings ;
+USING: arrays ascii assocs byte-arrays combinators
+combinators.short-circuit fry io.encodings.string
+io.encodings.utf8 kernel linked-assocs make math math.parser
+present sequences splitting strings ;
 IN: urls.encoding
 
 : url-quotable? ( ch -- ? )
@@ -34,19 +35,28 @@ IN: urls.encoding
 
 <PRIVATE
 
+: hex% ( n -- )
+    CHAR: % , >hex >upper 2 CHAR: 0 pad-head % ;
+
 : push-utf8 ( ch -- )
-    1string utf8 encode
-    [ CHAR: % , >hex >upper 2 CHAR: 0 pad-head % ] each ;
+    1string utf8 encode [ hex% ] each ;
 
 : (url-encode) ( str quot: ( ch -- ? ) -- encoded )
-    '[ [ dup @ [ , ] [ push-utf8 ] if ] each ] "" make ; inline
+    [
+        over byte-array? [
+            '[ dup @ [ , ] [ hex% ] if ] each
+        ] [
+            [ present ] dip
+            '[ dup @ [ , ] [ push-utf8 ] if ] each
+        ] if
+    ] "" make ; inline
 
 PRIVATE>
 
-: url-encode ( str -- encoded )
+: url-encode ( obj -- encoded )
     [ url-quotable? ] (url-encode) ;
 
-: url-encode-full ( str -- encoded )
+: url-encode-full ( obj -- encoded )
     [ unreserved? ] (url-encode) ;
 
 <PRIVATE
@@ -105,7 +115,7 @@ PRIVATE>
         [
             [ url-encode-full ] dip [
                 dup array? [ 1array ] unless
-                [ present url-encode-full "=" glue , ] with each
+                [ url-encode-full "=" glue , ] with each
             ] [ , ] if*
         ] assoc-each
     ] { } make "&" join ;