Skip to content
Permalink
Browse files

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

  • Loading branch information
mrjbq7 committed Jan 9, 2020
1 parent c2270fb commit b3582dd323e5db3cd19efaae3a071578086d244b
@@ -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?
@@ -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
@@ -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 ;

0 comments on commit b3582dd

Please sign in to comment.
You can’t perform that action at this time.