From c76f282e0231897460e9506a9de908a998e61b72 Mon Sep 17 00:00:00 2001 From: Tomasz Rybarczyk Date: Wed, 31 Aug 2016 14:47:22 +0200 Subject: [PATCH 1/7] Migrate tests to purescript-test-unit --- bower.json | 3 + src/Data/URI/Types.purs | 22 +-- test/Main.purs | 325 ++++++++++++++++++++++++++++++++-------- 3 files changed, 277 insertions(+), 73 deletions(-) diff --git a/bower.json b/bower.json index ce3ffbd..93cb823 100755 --- a/bower.json +++ b/bower.json @@ -23,5 +23,8 @@ "purescript-pathy": "^2.0.0", "purescript-string-parsers": "^1.0.1", "purescript-unfoldable": "^1.0.0" + }, + "devDependencies": { + "purescript-test-unit": "7.0.0" } } diff --git a/src/Data/URI/Types.purs b/src/Data/URI/Types.purs index 1046cec..fae9ba1 100644 --- a/src/Data/URI/Types.purs +++ b/src/Data/URI/Types.purs @@ -65,52 +65,52 @@ type Fragment = String derive instance eqURI ∷ Eq URI instance showURI ∷ Show URI where - show (URI s h q f) = "URI (" <> show s <> ") (" <> show h <> ") (" <> show q <> ") (" <> show f <> ")" + show (URI s h q f) = "(URI " <> show s <> " " <> show h <> " " <> show q <> " " <> show f <> ")" derive instance eqAbsoluteURI ∷ Eq AbsoluteURI instance showAbsoluteURI ∷ Show AbsoluteURI where - show (AbsoluteURI s h q) = "AbsoluteURI (" <> show s <> ") (" <> show h <> ") (" <> show q <> ")" + show (AbsoluteURI s h q) = "(AbsoluteURI " <> show s <> " " <> show h <> " " <> show q <> ")" derive instance eqRelativeRef ∷ Eq RelativeRef instance showRelativeRef ∷ Show RelativeRef where - show (RelativeRef r q f) = "RelativeRef (" <> show r <> ") (" <> show q <> ") (" <> show f <> ")" + show (RelativeRef r q f) = "(RelativeRef " <> show r <> " " <> show q <> " " <> show f <> ")" derive instance eqURIScheme ∷ Eq URIScheme derive instance ordURIScheme ∷ Ord URIScheme derive instance genericURIScheme ∷ Generic URIScheme instance showURIScheme ∷ Show URIScheme where - show (URIScheme s) = "URIScheme " <> show s + show (URIScheme s) = "(URIScheme " <> show s <> ")" derive instance eqHierarchicalPart ∷ Eq HierarchicalPart instance showHierarchicalPart ∷ Show HierarchicalPart where - show (HierarchicalPart authority path) = "HierarchicalPart (" <> show authority <> ") (" <> show path <> ")" + show (HierarchicalPart authority path) = "(HierarchicalPart " <> show authority <> " " <> show path <> ")" derive instance eqRelativePart ∷ Eq RelativePart instance showRelativePart ∷ Show RelativePart where - show (RelativePart authority path) = "RelativePart (" <> show authority <> ") (" <> show path <> ")" + show (RelativePart authority path) = "(RelativePart " <> show authority <> " " <> show path <> ")" derive instance eqAuthority ∷ Eq Authority derive instance ordAuthority ∷ Ord Authority derive instance genericAuthority ∷ Generic Authority instance showAuthority ∷ Show Authority where - show (Authority userinfo hosts) = "Authority (" <> show userinfo <> ") " <> show hosts + show (Authority userinfo hosts) = "(Authority " <> show userinfo <> " " <> show hosts <> ")" derive instance eqHost ∷ Eq Host derive instance ordHost ∷ Ord Host derive instance genericQuery ∷ Generic Host instance showHost ∷ Show Host where - show (IPv6Address ip) = "IPv6Address " <> show ip - show (IPv4Address ip) = "IPv4Address " <> show ip - show (NameAddress name) = "NameAddress " <> show name + show (IPv6Address ip) = "(IPv6Address " <> show ip <> ")" + show (IPv4Address ip) = "(IPv4Address " <> show ip <> ")" + show (NameAddress name) = "(NameAddress " <> show name <> ")" derive instance eqQuery ∷ Eq Query instance showQuery ∷ Show Query where - show (Query m) = "Query (" <> show m <> ")" + show (Query m) = "(Query (" <> show m <> "))" diff --git a/test/Main.purs b/test/Main.purs index aa97436..399dab0 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -1,71 +1,272 @@ module Test.Main where import Prelude - import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Console as C -import Control.Monad.Eff.Exception as E - -import Data.Either (Either(..)) -import Data.URI (printURIRef, runParseURIRef) -import Data.URI.Types (URIRef) - -import Text.Parsing.StringParser (ParseError) - -type Test = Eff (console ∷ C.CONSOLE, err ∷ E.EXCEPTION) Unit - -main ∷ Test -main = do - test runParseURIRef "sql2:///?q=foo&var.bar=baz" - test runParseURIRef "mongodb://localhost" - test runParseURIRef "http://en.wikipedia.org/wiki/URI_scheme" - test runParseURIRef "http://local.slamdata.com/?#?sort=asc&q=path%3A%2F&salt=1177214" - test runParseURIRef "mongodb://foo:bar@db1.example.net,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" - test runParseURIRef "mongodb://foo:bar@db1.example.net:666,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" - test runParseURIRef "mongodb://192.168.0.1" - test runParseURIRef "mongodb://192.168.0.1,192.168.0.2" - test runParseURIRef "mongodb://sysop:moon@localhost" - test runParseURIRef "mongodb://sysop:moon@localhost" - test runParseURIRef "mongodb://sysop:moon@localhost/" - test runParseURIRef "mongodb://sysop:moon@localhost/records" - test runParseURIRef "foo://[2001:cdba:0000:0000:0000:0000:3257:9652]" - test runParseURIRef "foo://[FE80::0202:B3FF:FE1E:8329]" - test runParseURIRef "foo://[2001:db8::1]:80" - test runParseURIRef "ftp://ftp.is.co.za/rfc/rfc1808.txt" - test runParseURIRef "http://www.ietf.org/rfc/rfc2396.txt" - test runParseURIRef "ldap://[2001:db8::7]/c=GB?objectClass?one" - test runParseURIRef "telnet://192.0.2.16:80/" - test runParseURIRef "foo://example.com:8042/over/there?name=ferret#nose" - test runParseURIRef "foo://info.example.com?fred" - test runParseURIRef "ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm" - test runParseURIRef "../top_story.htm" - test runParseURIRef "top_story.htm" +import Control.Monad.Eff.Console (CONSOLE) +import Data.Either (isLeft, Either(..)) +import Data.List (singleton) +import Data.Maybe (Maybe(Nothing, Just)) +import Data.Path.Pathy (currentDir, parentDir', file, dir, rootDir, ()) +import Data.StrMap (empty, fromFoldable, fromList) +import Data.Tuple (Tuple(Tuple)) +import Data.URI (Authority(Authority), HierarchicalPart(HierarchicalPart), Host(IPv4Address, NameAddress, IPv6Address), Query(Query), RelativePart(RelativePart), RelativeRef(RelativeRef), URI(URI), URIScheme(URIScheme), runParseURIRef) +import Test.Unit (suite, test, TestSuite) +import Test.Unit.Assert (assert, equal) +import Test.Unit.Console (TESTOUTPUT) +import Test.Unit.Main (runTest) - C.log "\nFailing test cases: " - testFails runParseURIRef "news:comp.infosystems.www.servers.unix" - testFails runParseURIRef "tel:+1-816-555-1212" - testFails runParseURIRef "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" - testFails runParseURIRef "mailto:John.Doe@example.com" - testFails runParseURIRef "mailto:fred@example.com" - testFails runParseURIRef "/top_story.htm" +testRunParseURIRefParses :: forall a. String -> Either URI RelativeRef -> TestSuite a +testRunParseURIRefParses uri expected = + test ("parses: " <> uri) (equal (Right expected) (runParseURIRef uri)) -testCommon - ∷ (String → Test) - → (String → Test) - → (String → Either ParseError URIRef) - → String - → Test -testCommon leftMsg rightMsg f s = do - C.log $ "\nTrying to parse " <> s <> "" - case f s of - Left err → leftMsg $ " Parse failed: " <> show err - Right x → do - rightMsg $ " printURI: " <> printURIRef x - <> "\n show: " <> show x +testRunParseURIRefFailes :: forall a. String -> TestSuite a +testRunParseURIRefFailes uri = + test ("failes to parse: " <> uri) (assert ("parse should fail for: " <> uri) <<< isLeft <<< runParseURIRef $ uri) +main :: forall eff. Eff ( console :: CONSOLE , testOutput :: TESTOUTPUT | eff ) Unit +main = runTest $ suite "Data.URI" do + suite "runParseURIRef" do + testRunParseURIRefParses + "sql2:///?q=foo&var.bar=baz" + (Left + (URI + (Just (URIScheme "sql2")) + (HierarchicalPart + (Just (Authority Nothing [])) + (Just (Left rootDir))) + (Just (Query (fromFoldable [Tuple "q" (Just "foo"), Tuple "var.bar" (Just "baz")]))) + Nothing)) + testRunParseURIRefParses + "mongodb://localhost" + (Left + (URI + (Just (URIScheme "mongodb")) + (HierarchicalPart + (Just (Authority Nothing [(Tuple (NameAddress "localhost") Nothing)])) + Nothing) + Nothing + Nothing)) + testRunParseURIRefParses + "http://en.wikipedia.org/wiki/URI_scheme" + (Left + (URI + (Just (URIScheme "http")) + (HierarchicalPart + (Just (Authority Nothing [Tuple (NameAddress "en.wikipedia.org") Nothing])) + ((Just (Right ((rootDir dir "wiki") file "URI_scheme"))))) + Nothing + Nothing)) + testRunParseURIRefParses + "http://local.slamdata.com/?#?sort=asc&q=path%3A%2F&salt=1177214" + (Left + (URI + (Just (URIScheme "http")) + (HierarchicalPart + (Just (Authority Nothing [Tuple (NameAddress "local.slamdata.com") Nothing])) + ((Just (Left rootDir)))) + ((Just (Query empty))) + ((Just "?sort=asc&q=path%3A%2F&salt=1177214")))) + testRunParseURIRefParses + "mongodb://foo:bar@db1.example.net,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" + (Left + (URI + (Just (URIScheme "mongodb")) + (HierarchicalPart + (Just + (Authority + (Just "foo:bar") + [ Tuple (NameAddress "db1.example.net") Nothing + , Tuple (NameAddress "db2.example.net") (Just 2500)])) + (Just (Right (rootDir file "authdb")))) + (Just + (Query + (fromFoldable [Tuple "replicaSet" (Just "test"), Tuple "connectTimeoutMS" (Just "300000")]))) + Nothing)) + testRunParseURIRefParses + "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" + (Left + (URI + (Just (URIScheme "mongodb")) + (HierarchicalPart + (Just (Authority (Just "foo:bar") [(Tuple (NameAddress "db1.example.net") (Just 6)),(Tuple (NameAddress "db2.example.net") (Just 2500))])) + (Just (Right (rootDir file "authdb")))) + (Just (Query (fromFoldable [ Tuple "replicaSet" (Just "test"), Tuple "connectTimeoutMS" (Just "300000")]))) + Nothing)) + testRunParseURIRefParses + "mongodb://192.168.0.1" + (Left + (URI + (Just (URIScheme "mongodb")) + (HierarchicalPart (Just (Authority Nothing [(Tuple (IPv4Address "192.168.0.1") Nothing)])) Nothing) + Nothing + Nothing)) + testRunParseURIRefParses + "mongodb://192.168.0.1,192.168.0.2" + (Left + (URI + (Just (URIScheme "mongodb")) + (HierarchicalPart + (Just + (Authority + Nothing + [ Tuple (IPv4Address "192.168.0.1") Nothing + , Tuple (IPv4Address "192.168.0.2") Nothing + ])) + Nothing) + Nothing + Nothing)) + testRunParseURIRefParses + "mongodb://sysop:moon@localhost" + (Left + (URI + (Just (URIScheme "mongodb")) + (HierarchicalPart + (Just(Authority (Just "sysop:moon") [(Tuple (NameAddress "localhost") Nothing)])) + Nothing) + Nothing + Nothing)) + testRunParseURIRefParses + "mongodb://sysop:moon@localhost/" + (Left + (URI + (Just (URIScheme "mongodb")) + (HierarchicalPart + (Just (Authority (Just "sysop:moon") [(Tuple (NameAddress "localhost") Nothing)])) + (Just (Left rootDir))) + Nothing + Nothing)) + testRunParseURIRefParses + "mongodb://sysop:moon@localhost/records" + (Left + (URI + (Just (URIScheme "mongodb")) + (HierarchicalPart + (Just (Authority (Just "sysop:moon") [(Tuple (NameAddress "localhost") Nothing)])) + (Just (Right (rootDir file "records")))) + Nothing + Nothing)) + testRunParseURIRefParses + "foo://[2001:cdba:0000:0000:0000:0000:3257:9652]" + (Left + (URI + (Just (URIScheme "foo")) + (HierarchicalPart + (Just (Authority Nothing [Tuple (IPv6Address "2001:cdba:0000:0000:0000:0000:3257:9652") Nothing])) + Nothing) + Nothing + Nothing)) + testRunParseURIRefParses + "foo://[FE80::0202:B3FF:FE1E:8329]" + (Left + (URI + (Just (URIScheme "foo")) + (HierarchicalPart + (Just (Authority Nothing [(Tuple (IPv6Address "FE80::0202:B3FF:FE1E:8329") Nothing)])) + Nothing) + Nothing + Nothing)) + testRunParseURIRefParses + "foo://[2001:db8::1]:80" + (Left + (URI + (Just (URIScheme "foo")) + (HierarchicalPart + (Just (Authority Nothing [(Tuple (IPv6Address "2001:db8::1") (Just 80))])) + Nothing) + Nothing + Nothing)) + testRunParseURIRefParses + "ftp://ftp.is.co.za/rfc/rfc1808.txt" + (Left + (URI + (Just (URIScheme "ftp")) + (HierarchicalPart + (Just (Authority Nothing [(Tuple (NameAddress "ftp.is.co.za") Nothing)])) + (Just (Right ((rootDir dir "rfc") file "rfc1808.txt")))) + Nothing + Nothing)) + testRunParseURIRefParses + "http://www.ietf.org/rfc/rfc2396.txt" + (Left + (URI + (Just (URIScheme "http")) + (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "www.ietf.org") Nothing)])) (Just (Right ((rootDir dir "rfc") file "rfc2396.txt")))) + Nothing + Nothing)) + testRunParseURIRefParses + "ldap://[2001:db8::7]/c=GB?objectClass?one" + (Left + (URI + (Just (URIScheme "ldap")) + (HierarchicalPart + (Just (Authority Nothing [(Tuple (IPv6Address "2001:db8::7") Nothing)])) + (Just (Right (rootDir file "c=GB")))) + (Just (Query (fromList <<< singleton $ (Tuple "objectClass?one" Nothing)))) + Nothing)) + testRunParseURIRefParses + "telnet://192.0.2.16:80/" + (Left + (URI + (Just (URIScheme "telnet")) + (HierarchicalPart + (Just (Authority Nothing [(Tuple (IPv4Address "192.0.2.16") (Just 80))])) + (Just (Left rootDir))) + Nothing + Nothing)) + testRunParseURIRefParses + "foo://example.com:8042/over/there?name=ferret#nose" + (Left + (URI + (Just (URIScheme "foo")) + (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just 8042))])) (Just (Right ((rootDir dir "over") file "there")))) + (Just (Query (fromFoldable [ Tuple "name" (Just "ferret") ]))) + (Just "nose"))) + testRunParseURIRefParses + "foo://info.example.com?fred" + (Left + (URI + (Just (URIScheme "foo")) + (HierarchicalPart + (Just (Authority Nothing [(Tuple (NameAddress "info.example.com") Nothing)])) + Nothing) + (Just (Query (fromList <<< singleton $ Tuple "fred" Nothing))) + Nothing)) + testRunParseURIRefParses + "ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm" + (Left + (URI + (Just (URIScheme "ftp")) + (HierarchicalPart + (Just + (Authority + (Just "cnn.example.com&story=breaking_news") + [(Tuple (IPv4Address "10.0.0.1") Nothing)])) + (Just (Right (rootDir file "top_story.htm")))) + Nothing + Nothing)) + testRunParseURIRefParses + "../top_story.htm" + (Right + (RelativeRef + (RelativePart + Nothing + (Just (Right ((parentDir' currentDir) file "top_story.htm")))) + Nothing + Nothing)) + testRunParseURIRefParses + "top_story.htm" + (Right + (RelativeRef + (RelativePart + Nothing + (Just (Right (currentDir file "top_story.htm")))) + Nothing + Nothing)) -test ∷ (String → Either ParseError URIRef) → String → Test -test = testCommon (\x → C.error x *> (E.throwException $ E.error x)) C.log + testRunParseURIRefFailes "news:comp.infosystems.www.servers.unix" + testRunParseURIRefFailes "tel:+1-816-555-1212" + testRunParseURIRefFailes "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" + testRunParseURIRefFailes "mailto:John.Doe@example.com" + testRunParseURIRefFailes "mailto:fred@example.com" + testRunParseURIRefFailes "/top_story.htm" -testFails ∷ (String → Either ParseError URIRef) → String → Test -testFails = testCommon C.log (\x → C.error x *> (E.throwException $ E.error x)) From e20616e07b65a47b6a95707a48b925cf344afac4 Mon Sep 17 00:00:00 2001 From: Tomasz Rybarczyk Date: Wed, 31 Aug 2016 15:13:24 +0200 Subject: [PATCH 2/7] Bump purescript-test-unit version --- bower.json | 2 +- test/Main.purs | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/bower.json b/bower.json index 93cb823..a07e0d5 100755 --- a/bower.json +++ b/bower.json @@ -25,6 +25,6 @@ "purescript-unfoldable": "^1.0.0" }, "devDependencies": { - "purescript-test-unit": "7.0.0" + "purescript-test-unit": "9.0.0" } } diff --git a/test/Main.purs b/test/Main.purs index 399dab0..754602c 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -1,6 +1,7 @@ module Test.Main where import Prelude +import Control.Monad.Aff.AVar (AVAR) import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE) import Data.Either (isLeft, Either(..)) @@ -23,7 +24,7 @@ testRunParseURIRefFailes :: forall a. String -> TestSuite a testRunParseURIRefFailes uri = test ("failes to parse: " <> uri) (assert ("parse should fail for: " <> uri) <<< isLeft <<< runParseURIRef $ uri) -main :: forall eff. Eff ( console :: CONSOLE , testOutput :: TESTOUTPUT | eff ) Unit +main :: forall eff. Eff ( console :: CONSOLE , testOutput :: TESTOUTPUT, avar :: AVAR | eff ) Unit main = runTest $ suite "Data.URI" do suite "runParseURIRef" do testRunParseURIRefParses From 6ec4bf8ea3f2ce655e6aaf725dd6764a402f7242 Mon Sep 17 00:00:00 2001 From: Tomasz Rybarczyk Date: Fri, 2 Sep 2016 15:27:12 +0200 Subject: [PATCH 3/7] Cosmetics --- test/Main.purs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/test/Main.purs b/test/Main.purs index 754602c..bdc7d05 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -11,6 +11,7 @@ import Data.Path.Pathy (currentDir, parentDir', file, dir, rootDir, ()) import Data.StrMap (empty, fromFoldable, fromList) import Data.Tuple (Tuple(Tuple)) import Data.URI (Authority(Authority), HierarchicalPart(HierarchicalPart), Host(IPv4Address, NameAddress, IPv6Address), Query(Query), RelativePart(RelativePart), RelativeRef(RelativeRef), URI(URI), URIScheme(URIScheme), runParseURIRef) +import Data.URI.Query (printQuery) import Test.Unit (suite, test, TestSuite) import Test.Unit.Assert (assert, equal) import Test.Unit.Console (TESTOUTPUT) @@ -18,11 +19,15 @@ import Test.Unit.Main (runTest) testRunParseURIRefParses :: forall a. String -> Either URI RelativeRef -> TestSuite a testRunParseURIRefParses uri expected = - test ("parses: " <> uri) (equal (Right expected) (runParseURIRef uri)) + test + ("parses: " <> uri) + (equal (Right expected) (runParseURIRef uri)) testRunParseURIRefFailes :: forall a. String -> TestSuite a testRunParseURIRefFailes uri = - test ("failes to parse: " <> uri) (assert ("parse should fail for: " <> uri) <<< isLeft <<< runParseURIRef $ uri) + test + ("failes to parse: " <> uri) + (assert ("parse should fail for: " <> uri) <<< isLeft <<< runParseURIRef $ uri) main :: forall eff. Eff ( console :: CONSOLE , testOutput :: TESTOUTPUT, avar :: AVAR | eff ) Unit main = runTest $ suite "Data.URI" do @@ -271,3 +276,6 @@ main = runTest $ suite "Data.URI" do testRunParseURIRefFailes "mailto:fred@example.com" testRunParseURIRefFailes "/top_story.htm" + test "query with empty value is printed correctly" $ do + let query = Query <<< fromFoldable $ [ Tuple "empty" Nothing, Tuple "non-empty" (Just "1") ] + equal "test" (printQuery query) From 59a495f552385bd3559d93bb298cd57ff0808828 Mon Sep 17 00:00:00 2001 From: Tomasz Rybarczyk Date: Tue, 6 Sep 2016 21:32:59 +0200 Subject: [PATCH 4/7] Cleanup --- test/Main.purs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/test/Main.purs b/test/Main.purs index bdc7d05..091d0f5 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -275,7 +275,3 @@ main = runTest $ suite "Data.URI" do testRunParseURIRefFailes "mailto:John.Doe@example.com" testRunParseURIRefFailes "mailto:fred@example.com" testRunParseURIRefFailes "/top_story.htm" - - test "query with empty value is printed correctly" $ do - let query = Query <<< fromFoldable $ [ Tuple "empty" Nothing, Tuple "non-empty" (Just "1") ] - equal "test" (printQuery query) From 158bd1b105bc9c10e823c7331c36b04ea1577e20 Mon Sep 17 00:00:00 2001 From: Tomasz Rybarczyk Date: Fri, 16 Sep 2016 13:33:44 +0200 Subject: [PATCH 5/7] Use list of tuple as query representation --- src/Data/URI/Query.purs | 7 +++---- src/Data/URI/Types.purs | 5 ++--- test/Main.purs | 17 ++++++++--------- 3 files changed, 13 insertions(+), 16 deletions(-) diff --git a/src/Data/URI/Query.purs b/src/Data/URI/Query.purs index d662bc5..bf11dce 100644 --- a/src/Data/URI/Query.purs +++ b/src/Data/URI/Query.purs @@ -12,7 +12,6 @@ import Data.Either (fromRight) import Data.List (List(..)) import Data.Maybe (Maybe(..)) import Data.String.Regex as Rgx -import Data.StrMap (StrMap, fromList, toList) import Data.Tuple (Tuple(..)) import Data.URI.Common (joinWith, rxPat, parsePChar, wrapParser) import Data.URI.Types (Query(..)) @@ -29,8 +28,8 @@ parseQuery ∷ Parser Query parseQuery = Query <$> (wrapParser parseParts $ try (joinWith "" <$> many (parsePChar <|> string "/" <|> string "?"))) -parseParts ∷ Parser (StrMap (Maybe String)) -parseParts = fromList <$> sepBy parsePart (string ";" <|> string "&") +parseParts ∷ Parser (List (Tuple String (Maybe String))) +parseParts = sepBy parsePart (string ";" <|> string "&") parsePart ∷ Parser (Tuple String (Maybe String)) parsePart = do @@ -40,7 +39,7 @@ parsePart = do printQuery ∷ Query → String printQuery (Query m) = - case toList m of + case m of Nil → "" items → "?" <> joinWith "&" (printPart <$> items) where diff --git a/src/Data/URI/Types.purs b/src/Data/URI/Types.purs index fae9ba1..e6464ba 100644 --- a/src/Data/URI/Types.purs +++ b/src/Data/URI/Types.purs @@ -1,12 +1,11 @@ module Data.URI.Types where import Prelude - import Data.Either (Either) import Data.Generic (class Generic) +import Data.List (List) import Data.Maybe (Maybe) import Data.Path.Pathy (Path, File, Dir, Abs, Rel, Sandboxed, Unsandboxed) -import Data.StrMap (StrMap) import Data.Tuple (Tuple) -- | A generic URI @@ -57,7 +56,7 @@ data Host type Port = Int -- | The query component of a URI. -newtype Query = Query (StrMap (Maybe String)) +newtype Query = Query (List (Tuple String (Maybe String))) -- | The hash fragment of a URI. type Fragment = String diff --git a/test/Main.purs b/test/Main.purs index 091d0f5..ea5d15d 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -1,17 +1,16 @@ module Test.Main where import Prelude +import Control.Alternative (empty) import Control.Monad.Aff.AVar (AVAR) import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE) import Data.Either (isLeft, Either(..)) -import Data.List (singleton) +import Data.List (List(Nil), singleton, (:)) import Data.Maybe (Maybe(Nothing, Just)) import Data.Path.Pathy (currentDir, parentDir', file, dir, rootDir, ()) -import Data.StrMap (empty, fromFoldable, fromList) import Data.Tuple (Tuple(Tuple)) import Data.URI (Authority(Authority), HierarchicalPart(HierarchicalPart), Host(IPv4Address, NameAddress, IPv6Address), Query(Query), RelativePart(RelativePart), RelativeRef(RelativeRef), URI(URI), URIScheme(URIScheme), runParseURIRef) -import Data.URI.Query (printQuery) import Test.Unit (suite, test, TestSuite) import Test.Unit.Assert (assert, equal) import Test.Unit.Console (TESTOUTPUT) @@ -40,7 +39,7 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority Nothing [])) (Just (Left rootDir))) - (Just (Query (fromFoldable [Tuple "q" (Just "foo"), Tuple "var.bar" (Just "baz")]))) + (Just (Query (Tuple "q" (Just "foo") : Tuple "var.bar" (Just "baz") : Nil))) Nothing)) testRunParseURIRefParses "mongodb://localhost" @@ -86,7 +85,7 @@ main = runTest $ suite "Data.URI" do (Just (Right (rootDir file "authdb")))) (Just (Query - (fromFoldable [Tuple "replicaSet" (Just "test"), Tuple "connectTimeoutMS" (Just "300000")]))) + (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil))) Nothing)) testRunParseURIRefParses "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" @@ -96,7 +95,7 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority (Just "foo:bar") [(Tuple (NameAddress "db1.example.net") (Just 6)),(Tuple (NameAddress "db2.example.net") (Just 2500))])) (Just (Right (rootDir file "authdb")))) - (Just (Query (fromFoldable [ Tuple "replicaSet" (Just "test"), Tuple "connectTimeoutMS" (Just "300000")]))) + (Just (Query (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil))) Nothing)) testRunParseURIRefParses "mongodb://192.168.0.1" @@ -207,7 +206,7 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority Nothing [(Tuple (IPv6Address "2001:db8::7") Nothing)])) (Just (Right (rootDir file "c=GB")))) - (Just (Query (fromList <<< singleton $ (Tuple "objectClass?one" Nothing)))) + (Just (Query (singleton $ (Tuple "objectClass?one" Nothing)))) Nothing)) testRunParseURIRefParses "telnet://192.0.2.16:80/" @@ -225,7 +224,7 @@ main = runTest $ suite "Data.URI" do (URI (Just (URIScheme "foo")) (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just 8042))])) (Just (Right ((rootDir dir "over") file "there")))) - (Just (Query (fromFoldable [ Tuple "name" (Just "ferret") ]))) + (Just (Query (singleton (Tuple "name" (Just "ferret"))))) (Just "nose"))) testRunParseURIRefParses "foo://info.example.com?fred" @@ -235,7 +234,7 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "info.example.com") Nothing)])) Nothing) - (Just (Query (fromList <<< singleton $ Tuple "fred" Nothing))) + (Just (Query (singleton $ Tuple "fred" Nothing))) Nothing)) testRunParseURIRefParses "ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm" From bb840f667fe91e8f1168969f16c90a6a8ba188ad Mon Sep 17 00:00:00 2001 From: Tomasz Rybarczyk Date: Fri, 16 Sep 2016 14:26:01 +0200 Subject: [PATCH 6/7] Add tests for query serialization --- test/Main.purs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/test/Main.purs b/test/Main.purs index ea5d15d..9955e26 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -11,6 +11,7 @@ import Data.Maybe (Maybe(Nothing, Just)) import Data.Path.Pathy (currentDir, parentDir', file, dir, rootDir, ()) import Data.Tuple (Tuple(Tuple)) import Data.URI (Authority(Authority), HierarchicalPart(HierarchicalPart), Host(IPv4Address, NameAddress, IPv6Address), Query(Query), RelativePart(RelativePart), RelativeRef(RelativeRef), URI(URI), URIScheme(URIScheme), runParseURIRef) +import Data.URI.Query (printQuery) import Test.Unit (suite, test, TestSuite) import Test.Unit.Assert (assert, equal) import Test.Unit.Console (TESTOUTPUT) @@ -28,6 +29,12 @@ testRunParseURIRefFailes uri = ("failes to parse: " <> uri) (assert ("parse should fail for: " <> uri) <<< isLeft <<< runParseURIRef $ uri) +testQuerySerialization :: forall a. Query -> String -> TestSuite a +testQuerySerialization query expected = + test + ("query " <> show query <> " serializes.") + (equal expected (printQuery query)) + main :: forall eff. Eff ( console :: CONSOLE , testOutput :: TESTOUTPUT, avar :: AVAR | eff ) Unit main = runTest $ suite "Data.URI" do suite "runParseURIRef" do @@ -274,3 +281,9 @@ main = runTest $ suite "Data.URI" do testRunParseURIRefFailes "mailto:John.Doe@example.com" testRunParseURIRefFailes "mailto:fred@example.com" testRunParseURIRefFailes "/top_story.htm" + + testQuerySerialization + (Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) + "?key1=value1&key2=value2&key1=value3" + testQuerySerialization (Query Nil) "" + From fa045bfa918c227bea07ab93c945cf48c8c31d13 Mon Sep 17 00:00:00 2001 From: Tomasz Rybarczyk Date: Mon, 19 Sep 2016 18:42:24 +0200 Subject: [PATCH 7/7] Fix empty query value parsing and add appropriate tests --- src/Data/URI/Query.purs | 2 +- test/Main.purs | 38 ++++++++++++++++++++++++++++++++------ 2 files changed, 33 insertions(+), 7 deletions(-) diff --git a/src/Data/URI/Query.purs b/src/Data/URI/Query.purs index bf11dce..3f7dbb3 100644 --- a/src/Data/URI/Query.purs +++ b/src/Data/URI/Query.purs @@ -33,7 +33,7 @@ parseParts = sepBy parsePart (string ";" <|> string "&") parsePart ∷ Parser (Tuple String (Maybe String)) parsePart = do - key ← rxPat "[^=]+" + key ← rxPat "[^=;&]+" value ← optionMaybe $ string "=" *> rxPat "[^;&]*" pure $ Tuple (prettyDecodeURI key) (prettyDecodeURI <$> value) diff --git a/test/Main.purs b/test/Main.purs index 9955e26..3239df5 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -11,11 +11,12 @@ import Data.Maybe (Maybe(Nothing, Just)) import Data.Path.Pathy (currentDir, parentDir', file, dir, rootDir, ()) import Data.Tuple (Tuple(Tuple)) import Data.URI (Authority(Authority), HierarchicalPart(HierarchicalPart), Host(IPv4Address, NameAddress, IPv6Address), Query(Query), RelativePart(RelativePart), RelativeRef(RelativeRef), URI(URI), URIScheme(URIScheme), runParseURIRef) -import Data.URI.Query (printQuery) +import Data.URI.Query (parseQuery, printQuery) import Test.Unit (suite, test, TestSuite) import Test.Unit.Assert (assert, equal) import Test.Unit.Console (TESTOUTPUT) import Test.Unit.Main (runTest) +import Text.Parsing.StringParser (runParser) testRunParseURIRefParses :: forall a. String -> Either URI RelativeRef -> TestSuite a testRunParseURIRefParses uri expected = @@ -29,12 +30,18 @@ testRunParseURIRefFailes uri = ("failes to parse: " <> uri) (assert ("parse should fail for: " <> uri) <<< isLeft <<< runParseURIRef $ uri) -testQuerySerialization :: forall a. Query -> String -> TestSuite a -testQuerySerialization query expected = +testPrintQuerySerializes :: forall a. Query -> String -> TestSuite a +testPrintQuerySerializes query expected = test - ("query " <> show query <> " serializes.") + ("serializes: " <> show query) (equal expected (printQuery query)) +testParseQueryParses :: forall a. String -> Query -> TestSuite a +testParseQueryParses uri query = + test + ("parses: \"" <> uri <> "\"") + (equal (Right query) (runParser parseQuery uri)) + main :: forall eff. Eff ( console :: CONSOLE , testOutput :: TESTOUTPUT, avar :: AVAR | eff ) Unit main = runTest $ suite "Data.URI" do suite "runParseURIRef" do @@ -282,8 +289,27 @@ main = runTest $ suite "Data.URI" do testRunParseURIRefFailes "mailto:fred@example.com" testRunParseURIRefFailes "/top_story.htm" - testQuerySerialization + suite "printQuery" do + testPrintQuerySerializes (Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) "?key1=value1&key2=value2&key1=value3" - testQuerySerialization (Query Nil) "" + testPrintQuerySerializes (Query Nil) "" + testPrintQuerySerializes + (Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) + "?key1=&key2=" + testPrintQuerySerializes + (Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) + "?key1&key2" + + suite "parseQuery" do + testParseQueryParses + "key1=value1&key2=value2&key1=value3" + (Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) + testParseQueryParses + "key1&key2" + (Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) + testParseQueryParses + "key1=&key2=" + (Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) +