-! Copyright (C) 2008, 2010 Slava Pestov.
+! Copyright (C) 2008, 2011 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel ascii combinators combinators.short-circuit
sequences splitting fry namespaces make assocs arrays strings
[ drop f ]
} case ;
+: relative-url ( url -- url' )
+ clone
+ f >>protocol
+ f >>host
+ f >>port ;
+
+: relative-url? ( url -- ? ) protocol>> not ;
+
<PRIVATE
: unparse-username-password ( url -- )
[ path>> "/" head? [ "/" % ] unless ]
} cleave ;
-PRIVATE>
-
M: url present
[
{
} cleave
] "" make ;
+PRIVATE>
+
: url-append-path ( path1 path2 -- path )
{
{ [ dup "/" head? ] [ nip ] }
[ [ "/" split1-last drop "/" ] dip 3append ]
} cond ;
+<PRIVATE
+
+: derive-port ( url base -- url' )
+ over relative-url? [ [ port>> ] either? ] [ drop port>> ] if ;
+
+: derive-path ( url base -- url' )
+ [ path>> ] bi@ swap url-append-path ;
+
PRIVATE>
: derive-url ( base url -- url' )
[ [ username>> ] either? >>username ]
[ [ password>> ] either? >>password ]
[ [ host>> ] either? >>host ]
- [ [ port>> ] either? >>port ]
- [ [ path>> ] bi@ swap url-append-path >>path ]
+ [ derive-port >>port ]
+ [ derive-path >>path ]
[ [ query>> ] either? >>query ]
[ [ anchor>> ] either? >>anchor ]
} 2cleave ;
-: relative-url ( url -- url' )
- clone
- f >>protocol
- f >>host
- f >>port ;
-
-: relative-url? ( url -- ? ) protocol>> not ;
-
! Half-baked stuff follows
: secure-protocol? ( protocol -- ? )
"https" = ;