1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel ascii combinators combinators.short-circuit
4 sequences splitting fry namespaces make assocs arrays strings
5 io.encodings.string io.encodings.utf8 math math.parser accessors
9 : url-quotable? ( ch -- ? )
17 ! see http://tools.ietf.org/html/rfc3986#section-2.2
18 : gen-delim? ( ch -- ? )
19 ":/?#[]@" member? ; foldable
21 : sub-delim? ( ch -- ? )
22 "!$&'()*+,;=" member? ; foldable
24 : reserved? ( ch -- ? )
25 [ gen-delim? ] [ sub-delim? ] bi or ; foldable
27 ! see http://tools.ietf.org/html/rfc3986#section-2.3
28 : unreserved? ( ch -- ? )
40 [ CHAR: % , >hex 2 CHAR: 0 pad-left % ] each ;
44 : url-encode ( str -- encoded )
46 [ dup url-quotable? [ , ] [ push-utf8 ] if ] each
49 : url-encode-full ( str -- encoded )
51 [ dup unreserved? [ , ] [ push-utf8 ] if ] each
56 : url-decode-hex ( index str -- )
60 [ 1+ dup 2 + ] dip subseq hex> [ , ] when*
63 : url-decode-% ( index str -- index str )
66 : url-decode-iter ( index str -- )
70 2dup nth dup CHAR: % = [
71 drop url-decode-% [ 3 + ] dip
79 : url-decode ( str -- decoded )
80 [ 0 swap url-decode-iter ] "" make utf8 decode ;
82 : query-decode ( str -- decoded )
83 [ dup CHAR: + = [ drop "%20" ] [ 1string ] if ] { } map-as
88 : add-query-param ( value key assoc -- )
92 { [ dup string? ] [ swap 2array ] }
93 { [ dup array? ] [ swap suffix ] }
94 { [ dup not ] [ drop ] }
101 : query>assoc ( query -- assoc )
103 "&;" split H{ } clone [
105 [ "=" split1 [ dup [ query-decode ] when ] bi@ swap ] dip
111 : assoc>query ( assoc -- str )
113 dup array? [ [ present ] map ] [ present 1array ] if
118 [ url-encode "=" swap 3append , ] with each
120 ] { } make "&" join ;