! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays ascii assocs byte-arrays combinators
-combinators.short-circuit fry io.encodings.string
+combinators.short-circuit io.encodings io.encodings.string
io.encodings.utf8 kernel linked-assocs make math math.parser
-present sequences splitting strings ;
+namespaces present sequences sequences.private splitting strings ;
IN: urls.encoding
: url-quotable? ( ch -- ? )
: hex% ( n -- )
CHAR: % , >hex >upper 2 CHAR: 0 pad-head % ;
-: push-utf8 ( ch -- )
+: hex-utf8% ( ch -- )
1string utf8 encode [ hex% ] each ;
: (url-encode) ( str quot: ( ch -- ? ) -- encoded )
'[ dup @ [ , ] [ hex% ] if ] each
] [
[ present ] dip
- '[ dup @ [ , ] [ push-utf8 ] if ] each
+ '[ dup @ [ , ] [ hex-utf8% ] if ] each
] if
] "" make ; inline
<PRIVATE
+: utf8% ( ch -- )
+ building get utf8 encode-char ;
+
: url-decode-hex ( index str -- )
2dup length 2 - >= [
2drop
2dup length >= [
2drop
] [
- 2dup nth dup CHAR: % = [
+ 2dup nth-unsafe dup CHAR: % = [
drop 2dup url-decode-hex [ 3 + ] dip
] [
- 1string utf8 encode % [ 1 + ] dip
+ utf8% [ 1 + ] dip
] if url-decode-iter
- ] if ;
+ ] if ; inline recursive
PRIVATE>
: encode-uri-component ( str -- str' )
[
- [ dup escape-uri-component-char? [ push-utf8 ] [ , ] if ] each
+ [ dup escape-uri-component-char? [ hex-utf8% ] [ , ] if ] each
] "" make ;
: escape-uri-char? ( ch -- ? )
: encode-uri ( str -- str' )
[
- [ dup escape-uri-char? [ push-utf8 ] [ , ] if ] each
+ [ dup escape-uri-char? [ hex-utf8% ] [ , ] if ] each
] "" make ;
<PRIVATE
2dup length >= [
2drop
] [
- 2dup nth dup CHAR: % = [
+ 2dup nth-unsafe dup CHAR: % = [
drop 2dup _ decode-uri-hex [ 3 + ] dip
] [
- 1string utf8 encode % [ 1 + ] dip
+ utf8% [ 1 + ] dip
] if _ decode-uri-iter
] if
] call ; inline recursive