steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Remove raw-query stuff, its a pain

db4
Slava Pestov 2008-09-29 22:54:10 -05:00
parent 304e069af2
commit 81bd2eb175
2 changed files with 11 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
basis/urls/urls-tests.factor
View File

@ -10,7 +10,6 @@ arrays kernel assocs present accessors ;
{ host "www.apple.com" }
{ port 1234 }
{ path "/a/path" }
{ raw-query "a=b" }
{ query H{ { "a" "b" } } }
{ anchor "foo" }
}
@ -21,7 +20,6 @@ arrays kernel assocs present accessors ;
{ protocol "http" }
{ host "www.apple.com" }
{ path "/a/path" }
{ raw-query "a=b" }
{ query H{ { "a" "b" } } }
{ anchor "foo" }
}
@ -59,7 +57,6 @@ arrays kernel assocs present accessors ;
{
T{ url
{ path "bar" }
{ raw-query "a=b" }
{ query H{ { "a" "b" } } }
}
"bar?a=b"
@ -213,7 +210,6 @@ urls [
T{ url
{ protocol "http" }
{ host "localhost" }
{ raw-query "foo=bar" }
{ query H{ { "foo" "bar" } } }
{ path "/" }
}
@ -224,7 +220,6 @@ urls [
T{ url
{ protocol "http" }
{ host "localhost" }
{ raw-query "foo=bar" }
{ query H{ { "foo" "bar" } } }
{ path "/" }
}

22
basis/urls/urls.factor
View File

@ -8,7 +8,7 @@ strings.parser lexer prettyprint.backend hashtables present
peg.ebnf urls.encoding ;
IN: urls
TUPLE: url protocol username password host port path raw-query query anchor ;
TUPLE: url protocol username password host port path query anchor ;
: <url> ( -- url ) url new ;
@ -47,7 +47,7 @@ protocol = [a-z]+ => [[ url-decode ]]
username = [^/:@#?]+ => [[ url-decode ]]
password = [^/:@#?]+ => [[ url-decode ]]
pathname = [^#?]+ => [[ url-decode ]]
query = [^#]+ => [[ >string ]]
query = [^#]+ => [[ query>assoc ]]
anchor = .+ => [[ url-decode ]]
hostname = [^/#?]+ => [[ url-decode ]]
@ -80,7 +80,7 @@ M: string >url
] [ f f f f f ] if*
]
[ second ] ! pathname
[ third dup query>assoc ] ! query
[ third ] ! query
[ fourth ] ! anchor
} cleave url boa
dup host>> [ [ "/" or ] change-path ] when ;
@ -139,14 +139,14 @@ PRIVATE>
: derive-url ( base url -- url' )
[ clone ] dip over {
[ [ protocol>> ] either? >>protocol ]
[ [ username>> ] either? >>username ]
[ [ password>> ] either? >>password ]
[ [ host>> ] either? >>host ]
[ [ port>> ] either? >>port ]
[ [ path>> ] bi@ swap url-append-path >>path ]
[ [ query>> ] either? >>query ]
[ [ anchor>> ] either? >>anchor ]
[ [ protocol>> ] either? >>protocol ]
[ [ username>> ] either? >>username ]
[ [ password>> ] either? >>password ]
[ [ host>> ] either? >>host ]
[ [ port>> ] either? >>port ]
[ [ path>> ] bi@ swap url-append-path >>path ]
[ [ query>> ] either? >>query ]
[ [ anchor>> ] either? >>anchor ]
} 2cleave ;
: relative-url ( url -- url' )