basis: use lint.vocabs tool to trim using lists

[factor.git] / basis / urls / urls.factor

diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index a0edf38a84cee17627c28b7831109497784273ef..c3aa3a93ec32273840e6755bb6fb192687f7f714 100644 (file)
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -2,11 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 
 USING: accessors ascii assocs combinators
-combinators.short-circuit fry io.encodings.string
-io.encodings.utf8 io.pathnames io.sockets io.sockets.secure
-kernel lexer linked-assocs make math math.parser multiline
-namespaces peg.ebnf present sequences sequences.generalizations
-splitting strings strings.parser urls.encoding vocabs.loader ;
+combinators.short-circuit io.pathnames io.sockets
+io.sockets.secure kernel lexer linked-assocs make math.parser
+multiline namespaces peg.ebnf present sequences
+sequences.generalizations splitting strings strings.parser
+urls.encoding vocabs.loader ;
 
 IN: urls
 
@@ -44,8 +44,19 @@ M: url >url ;
 
 <PRIVATE
 
+: remove-dot-segments ( path -- path' )
+    [ "//" split1 ] [ "/" glue ] while*
+    [ "/./" split1 ] [ "/" glue ] while*
+    [ "/../" split1 ] [ [ "/" split1-last drop ] dip "/" glue ] while*
+    "/.." ?tail [ "/" split1-last drop "/" append ] when
+    "../" ?head [ "/" prepend ] when
+    "./" ?head [ "/" prepend ] when
+    "/." ?tail [ "/" append ] when
+    [ "/" ] when-empty ;
+
 : parse-path ( string -- path )
-    "/" split [ url-decode "/" "%2F" replace ] map "/" join ;
+    "/" split [ url-decode "/" "%2F" replace ] map "/" join
+    remove-dot-segments ;
 
 EBNF: parse-url [=[
 
@@ -109,7 +120,7 @@ M: pathname >url string>> >url ;
 
 : ipv6-host ( host -- host/ipv6 ipv6? )
     dup { [ "[" head? ] [ "]" tail? ] } 1&& [
-        1 swap [ length 1 - ] [ subseq ] bi t
+        1 swap index-of-last subseq t
     ] [ f ] if ;
 
 : unparse-host ( url -- host )
@@ -153,9 +164,9 @@ PRIVATE>
         { [ dup "/" head? ] [ nip ] }
         { [ dup empty? ] [ drop ] }
         { [ over "/" tail? ] [ append ] }
-        { [ "/" pick subseq-start not ] [ nip ] }
+        { [ over "/" subseq-index not ] [ nip ] }
         [ [ "/" split1-last drop "/" ] dip 3append ]
-    } cond ;
+    } cond remove-dot-segments ;
 
 <PRIVATE