diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index 2ea7497..9479e57 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -13,22 +13,22 @@ import Data.URI.Query as Query import Data.URI.Scheme as Scheme import Text.Parsing.StringParser (ParseError, Parser, runParser) import Text.Parsing.StringParser.Combinators (optionMaybe) -import Text.Parsing.StringParser.String (string, eof) +import Text.Parsing.StringParser.String (eof) parse ∷ String → Either ParseError AbsoluteURI parse = runParser parser parser ∷ Parser AbsoluteURI parser = AbsoluteURI - <$> (optionMaybe Scheme.parser <* string ":") - <*> (string "//" *> HPart.parser) - <*> optionMaybe (string "?" *> Query.parser) + <$> optionMaybe Scheme.parser + <*> HPart.parser + <*> optionMaybe Query.parser <* eof print ∷ AbsoluteURI → String print (AbsoluteURI s h q) = S.joinWith "" $ catMaybes - [ (\scheme → Scheme.print scheme <> "//") <$> s + [ Scheme.print <$> s , Just (HPart.print h) , Query.print <$> q ] diff --git a/src/Data/URI/Authority.purs b/src/Data/URI/Authority.purs index 74b5427..69ff1d6 100644 --- a/src/Data/URI/Authority.purs +++ b/src/Data/URI/Authority.purs @@ -17,6 +17,7 @@ import Text.Parsing.StringParser.String (string) parser ∷ Parser Authority parser = do + _ ← string "//" ui ← optionMaybe $ try (UserInfo.parser <* string "@") hosts ← flip sepBy (string ",") $ Tuple <$> Host.parser <*> optionMaybe (string ":" *> Port.parser) @@ -24,7 +25,7 @@ parser = do print ∷ Authority → String print (Authority ui hs) = - printUserInfo <> S.joinWith "," (printHostAndPort <$> hs) + "//" <> printUserInfo <> S.joinWith "," (printHostAndPort <$> hs) where printUserInfo = maybe "" (\u → UserInfo.print u <> "@") ui diff --git a/src/Data/URI/Fragment.purs b/src/Data/URI/Fragment.purs index bb7b7cc..bdb6ad4 100644 --- a/src/Data/URI/Fragment.purs +++ b/src/Data/URI/Fragment.purs @@ -16,11 +16,13 @@ import Text.Parsing.StringParser.Combinators (many) import Text.Parsing.StringParser.String (string) parser ∷ Parser Fragment -parser = Fragment <<< joinWith "" - <$> many (parsePChar decodePCTComponent <|> string "/" <|> string "?") +parser = string "#" *> + (Fragment <<< joinWith "" + <$> many (parsePChar decodePCTComponent <|> string "/" <|> string "?")) print ∷ Fragment → String -print (Fragment f) = S.joinWith "" $ map printChar $ S.split (S.Pattern "") f +print (Fragment f) = + "#" <> S.joinWith "" (map printChar $ S.split (S.Pattern "") f) where -- Fragments & queries have a bunch of characters that don't need escaping printChar ∷ String → String diff --git a/src/Data/URI/Query.purs b/src/Data/URI/Query.purs index 4b7dd89..45e91f5 100644 --- a/src/Data/URI/Query.purs +++ b/src/Data/URI/Query.purs @@ -19,7 +19,7 @@ import Text.Parsing.StringParser.Combinators (optionMaybe, sepBy) import Text.Parsing.StringParser.String (string) parser ∷ Parser Query -parser = Query <$> wrapParser parseParts (try (rxPat "[^#]*")) +parser = string "?" *> (Query <$> wrapParser parseParts (try (rxPat "[^#]*"))) parseParts ∷ Parser (List (Tuple String (Maybe String))) parseParts = sepBy parsePart (string ";" <|> string "&") diff --git a/src/Data/URI/RelativePart.purs b/src/Data/URI/RelativePart.purs index b222134..b12e095 100644 --- a/src/Data/URI/RelativePart.purs +++ b/src/Data/URI/RelativePart.purs @@ -11,7 +11,6 @@ import Data.URI (Authority, RelativePart(..), URIPathRel) import Data.URI.Authority as Authority import Data.URI.Path (printPath, parseURIPathRel, parsePathNoScheme, parsePathAbsolute, parsePathAbEmpty) import Text.Parsing.StringParser (Parser) -import Text.Parsing.StringParser.String (string) parser ∷ Parser RelativePart parser = withAuth <|> withoutAuth @@ -19,7 +18,7 @@ parser = withAuth <|> withoutAuth withAuth = RelativePart - <$> Just <$> (string "//" *> Authority.parser) + <$> Just <$> Authority.parser <*> parsePathAbEmpty parseURIPathRel withoutAuth = RelativePart Nothing <$> noAuthPath @@ -33,7 +32,7 @@ print ∷ RelativePart → String print (RelativePart a p) = S.joinWith "" $ catMaybes - [ (\auth → "//" <> Authority.print auth) <$> a + [ Authority.print <$> a , printPath <$> p ] diff --git a/src/Data/URI/RelativeRef.purs b/src/Data/URI/RelativeRef.purs index f40bd6f..bdf931d 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/Data/URI/RelativeRef.purs @@ -11,9 +11,9 @@ import Data.URI (Fragment, Query, RelativePart, RelativeRef(..)) import Data.URI.Fragment as Fragment import Data.URI.Query as Query import Data.URI.RelativePart as RPart -import Text.Parsing.StringParser (Parser, ParseError, runParser, try) +import Text.Parsing.StringParser (Parser, ParseError, runParser) import Text.Parsing.StringParser.Combinators (optionMaybe) -import Text.Parsing.StringParser.String (string, eof) +import Text.Parsing.StringParser.String (eof) parse ∷ String → Either ParseError RelativeRef parse = runParser parser @@ -21,8 +21,8 @@ parse = runParser parser parser ∷ Parser RelativeRef parser = RelativeRef <$> RPart.parser - <*> optionMaybe (string "?" *> Query.parser) - <*> optionMaybe (string "#" *> try Fragment.parser) + <*> optionMaybe Query.parser + <*> optionMaybe Fragment.parser <* eof print ∷ RelativeRef → String @@ -30,7 +30,7 @@ print (RelativeRef h q f) = S.joinWith "" $ catMaybes [ Just (RPart.print h) , Query.print <$> q - , (\frag → "#" <> Fragment.print frag) <$> f + , Fragment.print <$> f ] _relPart ∷ Lens' RelativeRef RelativePart diff --git a/src/Data/URI/Scheme.purs b/src/Data/URI/Scheme.purs index e6814ae..9bdbaf7 100644 --- a/src/Data/URI/Scheme.purs +++ b/src/Data/URI/Scheme.purs @@ -5,9 +5,10 @@ import Prelude import Data.URI (Scheme(..)) import Data.URI.Common (rxPat) import Text.Parsing.StringParser (Parser) +import Text.Parsing.StringParser.String (string) parser ∷ Parser Scheme -parser = Scheme <$> rxPat "[a-z][a-z0-9+\\.\\-]+" +parser = Scheme <$> rxPat "[a-z][a-z0-9+\\.\\-]+" <* string ":" print ∷ Scheme → String print (Scheme s) = s <> ":" diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index 833ae3f..f2f83d7 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -12,28 +12,28 @@ import Data.URI.Fragment as Fragment import Data.URI.HierarchicalPart as HPart import Data.URI.Query as Query import Data.URI.Scheme as Scheme -import Text.Parsing.StringParser (Parser, ParseError, runParser, try) +import Text.Parsing.StringParser (Parser, ParseError, runParser) import Text.Parsing.StringParser.Combinators (optionMaybe) -import Text.Parsing.StringParser.String (string, eof) +import Text.Parsing.StringParser.String (eof) parse ∷ String → Either ParseError URI parse = runParser parser parser ∷ Parser URI parser = URI - <$> (optionMaybe Scheme.parser <* string ":") - <*> (string "//" *> HPart.parser) - <*> optionMaybe (string "?" *> Query.parser) - <*> optionMaybe (string "#" *> try Fragment.parser) + <$> optionMaybe Scheme.parser + <*> HPart.parser + <*> optionMaybe Query.parser + <*> optionMaybe Fragment.parser <* eof print ∷ URI → String print (URI s h q f) = S.joinWith "" $ catMaybes - [ (\scheme → Scheme.print scheme <> "//") <$> s + [ Scheme.print <$> s , Just (HPart.print h) , Query.print <$> q - , (\frag → "#" <> Fragment.print frag) <$> f + , Fragment.print <$> f ] _scheme ∷ Lens' URI (Maybe Scheme) diff --git a/test/Main.purs b/test/Main.purs index a23b2a6..a4a4481 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -59,10 +59,10 @@ testIsoURIRef = testIso URIRef.parser URIRef.print testRunParseURIRefParses :: forall a. String -> Either URI RelativeRef -> TestSuite a testRunParseURIRefParses = testRunParseSuccess URIRef.parser -testRunParseURIRefFailes :: forall a. String -> TestSuite a -testRunParseURIRefFailes uri = +testRunParseURIRefFails :: forall a. String -> TestSuite a +testRunParseURIRefFails uri = test - ("failes to parse: " <> uri) + ("fails to parse: " <> uri) (assert ("parse should fail for: " <> uri) <<< isLeft <<< URIRef.parse $ uri) testPrintQuerySerializes :: forall a. Query -> String -> TestSuite a @@ -110,8 +110,8 @@ main = runTest $ suite "Data.URI" do isLeft $ runParser Host.ipv4AddressParser "192.168.001.1" suite "Scheme parser" do - testRunParseSuccess Scheme.parser "http" (Scheme "http") - testRunParseSuccess Scheme.parser "git+ssh" (Scheme "git+ssh") + testRunParseSuccess Scheme.parser "http:" (Scheme "http") + testRunParseSuccess Scheme.parser "git+ssh:" (Scheme "git+ssh") suite "UserInfo parser" do testRunParseSuccess UserInfo.parser "user" (UserInfo "user") @@ -132,8 +132,14 @@ main = runTest $ suite "Data.URI" do testRunParseSuccess Port.parser "63174" (Port 63174) suite "Authority parser" do - testRunParseSuccess Authority.parser "localhost" (Authority Nothing [Tuple (NameAddress "localhost") Nothing]) - testRunParseSuccess Authority.parser "localhost:3000" (Authority Nothing [Tuple (NameAddress "localhost") (Just (Port 3000))]) + testRunParseSuccess + Authority.parser + "//localhost" + (Authority Nothing [Tuple (NameAddress "localhost") Nothing]) + testRunParseSuccess + Authority.parser + "//localhost:3000" + (Authority Nothing [Tuple (NameAddress "localhost") (Just (Port 3000))]) suite "URIRef.parse" do testIsoURIRef @@ -321,6 +327,14 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) (Just (Query (singleton (Tuple "name" (Just "ferret"))))) (Just (Fragment "nose")))) + testIsoURIRef + "foo://example.com:8042/over/there?name=ferret#" + (Left + (URI + (Just (Scheme "foo")) + (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) + (Just (Query (singleton (Tuple "name" (Just "ferret"))))) + (Just (Fragment "")))) testIsoURIRef "foo://info.example.com?fred" (Left @@ -408,6 +422,25 @@ main = runTest $ suite "Data.URI" do ((Just (Right (rootDir dir "metadata" dir "fs" dir "test" file "Пациенты# #"))))) (Just mempty) Nothing)) + testIsoURIRef + "/top_story.htm" + (Left + (URI + Nothing + (HierarchicalPart + Nothing + (Just (Right (rootDir file "top_story.htm")))) + Nothing + Nothing)) + testIsoURIRef + "../top_story.htm" + (Right + (RelativeRef + (RelativePart + Nothing + (Just (Right (parentDir' currentDir file "top_story.htm")))) + Nothing + Nothing)) -- Not an iso in this case as the printed path is normalised testRunParseURIRefParses @@ -432,12 +465,11 @@ main = runTest $ suite "Data.URI" do ((Just mempty)) ((Just (Fragment "?sort=asc&q=path:/&salt=1177214"))))) - 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" + testRunParseURIRefFails "news:comp.infosystems.www.servers.unix" + testRunParseURIRefFails "tel:+1-816-555-1212" + testRunParseURIRefFails "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" + testRunParseURIRefFails "mailto:John.Doe@example.com" + testRunParseURIRefFails "mailto:fred@example.com" suite "Query.print" do testPrintQuerySerializes @@ -456,16 +488,16 @@ main = runTest $ suite "Data.URI" do suite "Query.parser" do testParseQueryParses - "key1=value1&key2=value2&key1=value3" + "?key1=value1&key2=value2&key1=value3" (Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) testParseQueryParses - "key1&key2" + "?key1&key2" (Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) testParseQueryParses - "key1=&key2=" + "?key1=&key2=" (Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) testParseQueryParses - "key1=foo%3Bbar" + "?key1=foo%3Bbar" (Query (Tuple "key1" (Just "foo;bar") : Nil)) suite "Common.match1From" do