derive-url
] unit-test
+! Support //foo.com, which has the same protocol as the url we derive from
+[ URL" http://foo.com" ]
+[ URL" http://google.com" URL" //foo.com" derive-url ] unit-test
+
+[ URL" https://foo.com" ]
+[ URL" https://google.com" URL" //foo.com" derive-url ] unit-test
+
[ "a" ] [
<url> "a" "b" set-query-param "b" query-param
] unit-test
[ "/" ] [ "http://www.jedit.org" >url path>> ] unit-test
-[ "USING: urls ;\nURL\" foo\"" ] [ URL" foo" unparse-use ] unit-test
\ No newline at end of file
+[ "USING: urls ;\nURL\" foo\"" ] [ URL" foo" unparse-use ] unit-test
auth = (username (":" password => [[ second ]])? "@"
=> [[ first2 2array ]])?
-url = ((protocol "://") => [[ first ]] auth hostname)?
+url = (((protocol "://") => [[ first ]] auth hostname)
+ | (("//") => [[ f ]] auth hostname))?
(pathname)?
("?" query => [[ second ]])?
("#" anchor => [[ second ]])?
[ port>> ] [ port>> ] [ protocol>> protocol-port ] tri =
[ drop f ] when ;
-: unparse-host-part ( url protocol -- )
- %
- "://" %
+: unparse-host-part ( url -- )
{
[ unparse-username-password ]
[ host>> url-encode % ]
[ path>> "/" head? [ "/" % ] unless ]
} cleave ;
+! URL" //foo.com" takes on the protocol of the url it's derived from
+: unparse-protocol ( url -- )
+ dup protocol>> [
+ % "://" % unparse-host-part
+ ] [
+ dup host>> [
+ "//" % unparse-host-part
+ ] [
+ drop
+ ] if
+ ] if* ;
+
M: url present
[
{
- [ dup protocol>> dup [ unparse-host-part ] [ 2drop ] if ]
+ [ unparse-protocol ]
[ path>> url-encode % ]
[ query>> dup assoc-empty? [ drop ] [ "?" % assoc>query % ] if ]
[ anchor>> [ "#" % present url-encode % ] when* ]