diff --git a/basis/urls/encoding/encoding-tests.factor b/basis/urls/encoding/encoding-tests.factor index 87b1812ef8..78e31a764d 100644 --- a/basis/urls/encoding/encoding-tests.factor +++ b/basis/urls/encoding/encoding-tests.factor @@ -26,3 +26,7 @@ USING: urls.encoding tools.test arrays kernel assocs present accessors ; [ H{ { "text" "hello world" } } ] [ "text=hello+world" query>assoc ] unit-test [ "a=3" ] [ { { "a" 3 } } assoc>query ] unit-test + +[ "a" ] [ { { "a" f } } assoc>query ] unit-test + +[ H{ { "a" f } } ] [ "a" query>assoc ] unit-test \ No newline at end of file diff --git a/basis/urls/encoding/encoding.factor b/basis/urls/encoding/encoding.factor index 7fed4b5f58..15b71ac0db 100644 --- a/basis/urls/encoding/encoding.factor +++ b/basis/urls/encoding/encoding.factor @@ -72,6 +72,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 ) @@ -86,11 +95,8 @@ PRIVATE> : 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 ; diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor index f45ad6449e..f2ecd6ec69 100644 --- a/basis/urls/urls-tests.factor +++ b/basis/urls/urls-tests.factor @@ -80,6 +80,15 @@ CONSTANT: urls } "ftp://slava:secret@ftp.kernel.org/" } + { + T{ url + { protocol "http" } + { host "foo.com" } + { path "/" } + { query H{ { "a" f } } } + } + "http://foo.com/?a" + } } urls [