urls: move a test for parse-host from http.client, simplify parse-url ebnf.

diff --git a/basis/http/client/client-tests.factor b/basis/http/client/client-tests.factor
index c94a85136bae6d929506fbfce42415713836f3ab..e1ae200ac6366920b05a30f78c99d7105830b754 100644 (file)
--- a/basis/http/client/client-tests.factor
+++ b/basis/http/client/client-tests.factor
@@ -2,9 +2,6 @@ USING: accessors http http.client http.client.private
 io.streams.string kernel namespaces sequences tools.test urls ;
 IN: http.client.tests
 
-{ "localhost" f } [ "localhost" parse-host ] unit-test
-{ "localhost" 8888 } [ "localhost:8888" parse-host ] unit-test
-
 { "foo.txt" } [ "http://www.paulgraham.com/foo.txt" download-name ] unit-test
 { "foo.txt" } [ "http://www.arc.com/foo.txt?xxx" download-name ] unit-test
 { "foo.txt" } [ "http://www.arc.com/foo.txt/" download-name ] unit-test

diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor
index df58573343847590ae19b04c8e3b7383089dde08..771b9120cf6b91705f9449da4252162d0c89c195 100644 (file)
--- a/basis/http/client/client.factor
+++ b/basis/http/client/client.factor
@@ -133,11 +133,10 @@ SYMBOL: redirects
     hex> [ "Bad chunk size" throw ] unless* ;
 
 : read-chunked ( quot: ( chunk -- ) -- )
-    read-chunk-size dup zero?
-    [ 2drop ] [
+    read-chunk-size [ drop ] [
         read [ swap call ] [ drop ] 2bi
         read-crlf B{ } assert= read-chunked
-    ] if ; inline recursive
+    ] if-zero ; inline recursive
 
 : read-response-body ( quot: ( chunk -- ) response -- )
     binary decode-input

diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor
index 0447be47e6503206b397f657dd3c98037d46f792..f3db4f4ece5a7e97f2c243c1e8b56dd23adae89f 100644 (file)
--- a/basis/urls/urls-tests.factor
+++ b/basis/urls/urls-tests.factor
@@ -2,6 +2,9 @@ USING: accessors arrays assocs io.sockets io.sockets.secure kernel
 linked-assocs present prettyprint sequences tools.test urls ;
 IN: urls.tests
 
+{ "localhost" f } [ "localhost" parse-host ] unit-test
+{ "localhost" 8888 } [ "localhost:8888" parse-host ] unit-test
+
 CONSTANT: urls {
     {
         T{ url

diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index 0a1deade940e4904b15133594b524782bf82a499..37f8c1e597b2c02f636ab3b7bbde6004c2b40eb2 100644 (file)
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -1,11 +1,11 @@
 ! Copyright (C) 2008, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 
-USING: accessors arrays ascii assocs combinators fry
-io.pathnames io.sockets io.sockets.secure kernel lexer
-linked-assocs make math.parser multiline namespaces peg.ebnf
-present sequences splitting strings strings.parser urls.encoding
-vocabs.loader math math.order ;
+USING: accessors ascii assocs combinators fry 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
 
@@ -27,13 +27,12 @@ TUPLE: url protocol username password host port path query anchor ;
 
 ERROR: malformed-port ;
 
+: parse-port ( string -- port/f )
+    [ f ] [ string>number [ malformed-port ] unless* ] if-empty ;
+
 : parse-host ( string -- host/f port/f )
     [
-        ":" split1-last [ url-decode ]
-        [ [ f ] 
-          [ string>number [ malformed-port ] unless* ]
-          if-empty 
-        ] bi*
+        ":" split1-last [ url-decode ] [ parse-port ] bi*
     ] [ f f ] if* ;
 
 GENERIC: >url ( obj -- url )
@@ -46,49 +45,41 @@ M: url >url ;
 
 EBNF: parse-url [=[
 
-protocol = [a-zA-Z0-9.+-]+          => [[ url-decode ]]
-username = [^/:@#?]*                => [[ url-decode ]]
-password = [^/:@#?]*                => [[ url-decode ]]
-pathname = [^#?]+                   => [[ url-decode ]]
-query    = [^#]+                    => [[ query>assoc ]]
-anchor   = .+                       => [[ url-decode ]]
-
-hostname = [^/#?]+                  => [[ url-decode ]]
-
-hostname-spec = hostname ("/"|!(.)) => [[ first ]]
+protocol = [a-zA-Z0-9.+-]+ => [[ url-decode ]]
+username = [^/:@#?]*       => [[ url-decode ]]
+password = [^/:@#?]*       => [[ url-decode ]]
+path     = [^#?]+          => [[ url-decode ]]
+query    = [^#]+           => [[ query>assoc ]]
+anchor   = .+              => [[ url-decode ]]
+hostname = [^/#?:]+        => [[ url-decode ]]
+port     = [^/#?]+         => [[ url-decode parse-port ]]
 
-auth     = (username (":" password  => [[ second ]])? "@"
-                                    => [[ first2 2array ]])?
+auth     = username (":"~ password?)? "@"~
+host     = hostname (":"~ port?)?
 
-url      = (((protocol "://") => [[ first ]] auth hostname)
-                    | (("//") => [[ f ]] auth hostname)
-                    | ((protocol ":") => [[ first V{ f f } V{ } 2sequence ]]))?
-           (pathname)?
-           ("?" query               => [[ second ]])?
-           ("#" anchor              => [[ second ]])?
+url      = (protocol ":"~)?
+           ("//"~ auth? host?)?
+           path?
+           ("?"~ query)?
+           ("#"~ anchor)?
 
 ]=]
 
 PRIVATE>
 
 M: string >url
-    [ <url> ] dip
-    parse-url {
+    [ <url> ] dip parse-url 5 firstn {
+        [ >lower >>protocol ]
         [
-            first [
-                [ first >lower >>protocol ]
-                [
-                    second
-                    [ first [ first2 [ >>username ] [ >>password ] bi* ] when* ]
-                    [ second parse-host [ >>host ] [ >>port ] bi* ] bi
-                ] bi
+            [
+                [ first [ first2 [ >>username ] [ >>password ] bi* ] when* ]
+                [ second [ first2 [ >>host ] [ >>port ] bi* ] when* ] bi
             ] when*
         ]
-        [ second >>path ]
-        [ third >>query ]
-        [ fourth >>anchor ]
-    } cleave
-    dup host>> [ [ "/" or ] change-path ] when ;
+        [ >>path ]
+        [ >>query ]
+        [ >>anchor ]
+    } spread dup host>> [ [ "/" or ] change-path ] when ;
 
 M: pathname >url string>> >url ;