Skip to content

Commit 6bfb21c

Browse files
garybgaryb
authored
Merge pull request #32 from garyb/parse-print-tweaks
Parse/print tweaks
2 parents beb5873 + 6ff7004 commit 6bfb21c

File tree

9 files changed

+79
-44
lines changed

9 files changed

+79
-44
lines changed

‎src/Data/URI/AbsoluteURI.purs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -13,22 +13,22 @@ import Data.URI.Query as Query
1313
import Data.URI.Scheme as Scheme
1414
import Text.Parsing.StringParser (ParseError, Parser, runParser)
1515
import Text.Parsing.StringParser.Combinators (optionMaybe)
16-
import Text.Parsing.StringParser.String (string, eof)
16+
import Text.Parsing.StringParser.String (eof)
1717

1818
parse ∷ String → Either ParseError AbsoluteURI
1919
parse = runParser parser
2020

2121
parser ∷ Parser AbsoluteURI
2222
parser = AbsoluteURI
23-
<$> (optionMaybe Scheme.parser <* string ":")
24-
<*> (string "//" *> HPart.parser)
25-
<*> optionMaybe (string "?" *> Query.parser)
23+
<$> optionMaybe Scheme.parser
24+
<*> HPart.parser
25+
<*> optionMaybe Query.parser
2626
<* eof
2727

2828
print ∷ AbsoluteURI → String
2929
print (AbsoluteURI s h q) =
3030
S.joinWith "" $ catMaybes
31-
[ (\scheme → Scheme.print scheme <> "//") <$> s
31+
[ Scheme.print <$> s
3232
, Just (HPart.print h)
3333
, Query.print <$> q
3434
]

‎src/Data/URI/Authority.purs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,14 +17,15 @@ import Text.Parsing.StringParser.String (string)
1717

1818
parser ∷ Parser Authority
1919
parser = do
20+
_ ← string "//"
2021
ui ← optionMaybe $ try (UserInfo.parser <* string "@")
2122
hosts ← flip sepBy (string ",") $
2223
Tuple <$> Host.parser <*> optionMaybe (string ":" *> Port.parser)
2324
pure $ Authority ui (fromFoldable hosts)
2425

2526
print ∷ Authority → String
2627
print (Authority ui hs) =
27-
printUserInfo <> S.joinWith "," (printHostAndPort <$> hs)
28+
"//" <> printUserInfo <> S.joinWith "," (printHostAndPort <$> hs)
2829
where
2930
printUserInfo =
3031
maybe "" (\u → UserInfo.print u <> "@") ui

‎src/Data/URI/Fragment.purs

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -16,11 +16,13 @@ import Text.Parsing.StringParser.Combinators (many)
1616
import Text.Parsing.StringParser.String (string)
1717

1818
parser ∷ Parser Fragment
19-
parser = Fragment <<< joinWith ""
20-
<$> many (parsePChar decodePCTComponent <|> string "/" <|> string "?")
19+
parser = string "#" *>
20+
(Fragment <<< joinWith ""
21+
<$> many (parsePChar decodePCTComponent <|> string "/" <|> string "?"))
2122

2223
print ∷ Fragment → String
23-
print (Fragment f) = S.joinWith "" $ map printChar $ S.split (S.Pattern "") f
24+
print (Fragment f) =
25+
"#" <> S.joinWith "" (map printChar $ S.split (S.Pattern "") f)
2426
where
2527
-- Fragments & queries have a bunch of characters that don't need escaping
2628
printChar ∷ String → String

‎src/Data/URI/Query.purs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ import Text.Parsing.StringParser.Combinators (optionMaybe, sepBy)
1919
import Text.Parsing.StringParser.String (string)
2020

2121
parser ∷ Parser Query
22-
parser = Query <$> wrapParser parseParts (try (rxPat "[^#]*"))
22+
parser = string "?" *> (Query <$> wrapParser parseParts (try (rxPat "[^#]*")))
2323

2424
parseParts ∷ Parser (List (Tuple String (Maybe String)))
2525
parseParts = sepBy parsePart (string ";" <|> string "&")

‎src/Data/URI/RelativePart.purs

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -11,15 +11,14 @@ import Data.URI (Authority, RelativePart(..), URIPathRel)
1111
import Data.URI.Authority as Authority
1212
import Data.URI.Path (printPath, parseURIPathRel, parsePathNoScheme, parsePathAbsolute, parsePathAbEmpty)
1313
import Text.Parsing.StringParser (Parser)
14-
import Text.Parsing.StringParser.String (string)
1514

1615
parser ∷ Parser RelativePart
1716
parser = withAuth <|> withoutAuth
1817
where
1918

2019
withAuth =
2120
RelativePart
22-
<$> Just <$> (string "//" *> Authority.parser)
21+
<$> Just <$> Authority.parser
2322
<*> parsePathAbEmpty parseURIPathRel
2423

2524
withoutAuth = RelativePart Nothing <$> noAuthPath
@@ -33,7 +32,7 @@ print ∷ RelativePart → String
3332
print (RelativePart a p) =
3433
S.joinWith "" $
3534
catMaybes
36-
[ (\auth → "//" <> Authority.print auth) <$> a
35+
[ Authority.print <$> a
3736
, printPath <$> p
3837
]
3938

‎src/Data/URI/RelativeRef.purs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -11,26 +11,26 @@ import Data.URI (Fragment, Query, RelativePart, RelativeRef(..))
1111
import Data.URI.Fragment as Fragment
1212
import Data.URI.Query as Query
1313
import Data.URI.RelativePart as RPart
14-
import Text.Parsing.StringParser (Parser, ParseError, runParser, try)
14+
import Text.Parsing.StringParser (Parser, ParseError, runParser)
1515
import Text.Parsing.StringParser.Combinators (optionMaybe)
16-
import Text.Parsing.StringParser.String (string, eof)
16+
import Text.Parsing.StringParser.String (eof)
1717

1818
parse ∷ String → Either ParseError RelativeRef
1919
parse = runParser parser
2020

2121
parser ∷ Parser RelativeRef
2222
parser = RelativeRef
2323
<$> RPart.parser
24-
<*> optionMaybe (string "?" *> Query.parser)
25-
<*> optionMaybe (string "#" *> try Fragment.parser)
24+
<*> optionMaybe Query.parser
25+
<*> optionMaybe Fragment.parser
2626
<* eof
2727

2828
print ∷ RelativeRef → String
2929
print (RelativeRef h q f) =
3030
S.joinWith "" $ catMaybes
3131
[ Just (RPart.print h)
3232
, Query.print <$> q
33-
, (\frag → "#" <> Fragment.print frag) <$> f
33+
, Fragment.print <$> f
3434
]
3535

3636
_relPart ∷ Lens' RelativeRef RelativePart

‎src/Data/URI/Scheme.purs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,9 +5,10 @@ import Prelude
55
import Data.URI (Scheme(..))
66
import Data.URI.Common (rxPat)
77
import Text.Parsing.StringParser (Parser)
8+
import Text.Parsing.StringParser.String (string)
89

910
parser ∷ Parser Scheme
10-
parser = Scheme <$> rxPat "[a-z][a-z0-9+\\.\\-]+"
11+
parser = Scheme <$> rxPat "[a-z][a-z0-9+\\.\\-]+" <* string ":"
1112

1213
print ∷ Scheme → String
1314
print (Scheme s) = s <> ":"

‎src/Data/URI/URI.purs

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -12,28 +12,28 @@ import Data.URI.Fragment as Fragment
1212
import Data.URI.HierarchicalPart as HPart
1313
import Data.URI.Query as Query
1414
import Data.URI.Scheme as Scheme
15-
import Text.Parsing.StringParser (Parser, ParseError, runParser, try)
15+
import Text.Parsing.StringParser (Parser, ParseError, runParser)
1616
import Text.Parsing.StringParser.Combinators (optionMaybe)
17-
import Text.Parsing.StringParser.String (string, eof)
17+
import Text.Parsing.StringParser.String (eof)
1818

1919
parse ∷ String → Either ParseError URI
2020
parse = runParser parser
2121

2222
parser ∷ Parser URI
2323
parser = URI
24-
<$> (optionMaybe Scheme.parser <* string ":")
25-
<*> (string "//" *> HPart.parser)
26-
<*> optionMaybe (string "?" *> Query.parser)
27-
<*> optionMaybe (string "#" *> try Fragment.parser)
24+
<$> optionMaybe Scheme.parser
25+
<*> HPart.parser
26+
<*> optionMaybe Query.parser
27+
<*> optionMaybe Fragment.parser
2828
<* eof
2929

3030
print ∷ URI → String
3131
print (URI s h q f) =
3232
S.joinWith "" $ catMaybes
33-
[ (\scheme → Scheme.print scheme <> "//") <$> s
33+
[ Scheme.print <$> s
3434
, Just (HPart.print h)
3535
, Query.print <$> q
36-
, (\frag → "#" <> Fragment.print frag) <$> f
36+
, Fragment.print <$> f
3737
]
3838

3939
_scheme ∷ Lens' URI (Maybe Scheme)

‎test/Main.purs

Lines changed: 49 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -59,10 +59,10 @@ testIsoURIRef = testIso URIRef.parser URIRef.print
5959
testRunParseURIRefParses :: forall a. String -> Either URI RelativeRef -> TestSuite a
6060
testRunParseURIRefParses = testRunParseSuccess URIRef.parser
6161

62-
testRunParseURIRefFailes :: forall a. String -> TestSuite a
63-
testRunParseURIRefFailes uri =
62+
testRunParseURIRefFails :: forall a. String -> TestSuite a
63+
testRunParseURIRefFails uri =
6464
test
65-
("failes to parse: " <> uri)
65+
("fails to parse: " <> uri)
6666
(assert ("parse should fail for: " <> uri) <<< isLeft <<< URIRef.parse $ uri)
6767

6868
testPrintQuerySerializes :: forall a. Query -> String -> TestSuite a
@@ -110,8 +110,8 @@ main = runTest $ suite "Data.URI" do
110110
isLeft $ runParser Host.ipv4AddressParser "192.168.001.1"
111111

112112
suite "Scheme parser" do
113-
testRunParseSuccess Scheme.parser "http" (Scheme "http")
114-
testRunParseSuccess Scheme.parser "git+ssh" (Scheme "git+ssh")
113+
testRunParseSuccess Scheme.parser "http:" (Scheme "http")
114+
testRunParseSuccess Scheme.parser "git+ssh:" (Scheme "git+ssh")
115115

116116
suite "UserInfo parser" do
117117
testRunParseSuccess UserInfo.parser "user" (UserInfo "user")
@@ -132,8 +132,14 @@ main = runTest $ suite "Data.URI" do
132132
testRunParseSuccess Port.parser "63174" (Port 63174)
133133

134134
suite "Authority parser" do
135-
testRunParseSuccess Authority.parser "localhost" (Authority Nothing [Tuple (NameAddress "localhost") Nothing])
136-
testRunParseSuccess Authority.parser "localhost:3000" (Authority Nothing [Tuple (NameAddress "localhost") (Just (Port 3000))])
135+
testRunParseSuccess
136+
Authority.parser
137+
"//localhost"
138+
(Authority Nothing [Tuple (NameAddress "localhost") Nothing])
139+
testRunParseSuccess
140+
Authority.parser
141+
"//localhost:3000"
142+
(Authority Nothing [Tuple (NameAddress "localhost") (Just (Port 3000))])
137143

138144
suite "URIRef.parse" do
139145
testIsoURIRef
@@ -321,6 +327,14 @@ main = runTest $ suite "Data.URI" do
321327
(HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) (Just (Right ((rootDir </> dir "over") </> file "there"))))
322328
(Just (Query (singleton (Tuple "name" (Just "ferret")))))
323329
(Just (Fragment "nose"))))
330+
testIsoURIRef
331+
"foo://example.com:8042/over/there?name=ferret#"
332+
(Left
333+
(URI
334+
(Just (Scheme "foo"))
335+
(HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) (Just (Right ((rootDir </> dir "over") </> file "there"))))
336+
(Just (Query (singleton (Tuple "name" (Just "ferret")))))
337+
(Just (Fragment ""))))
324338
testIsoURIRef
325339
"foo://info.example.com?fred"
326340
(Left
@@ -408,6 +422,25 @@ main = runTest $ suite "Data.URI" do
408422
((Just (Right (rootDir </> dir "metadata" </> dir "fs" </> dir "test" </> file "Пациенты# #")))))
409423
(Just mempty)
410424
Nothing))
425+
testIsoURIRef
426+
"/top_story.htm"
427+
(Left
428+
(URI
429+
Nothing
430+
(HierarchicalPart
431+
Nothing
432+
(Just (Right (rootDir </> file "top_story.htm"))))
433+
Nothing
434+
Nothing))
435+
testIsoURIRef
436+
"../top_story.htm"
437+
(Right
438+
(RelativeRef
439+
(RelativePart
440+
Nothing
441+
(Just (Right (parentDir' currentDir </> file "top_story.htm"))))
442+
Nothing
443+
Nothing))
411444

412445
-- Not an iso in this case as the printed path is normalised
413446
testRunParseURIRefParses
@@ -432,12 +465,11 @@ main = runTest $ suite "Data.URI" do
432465
((Just mempty))
433466
((Just (Fragment "?sort=asc&q=path:/&salt=1177214")))))
434467

435-
testRunParseURIRefFailes "news:comp.infosystems.www.servers.unix"
436-
testRunParseURIRefFailes "tel:+1-816-555-1212"
437-
testRunParseURIRefFailes "urn:oasis:names:specification:docbook:dtd:xml:4.1.2"
438-
testRunParseURIRefFailes "mailto:[email protected]"
439-
testRunParseURIRefFailes "mailto:[email protected]"
440-
testRunParseURIRefFailes "/top_story.htm"
468+
testRunParseURIRefFails "news:comp.infosystems.www.servers.unix"
469+
testRunParseURIRefFails "tel:+1-816-555-1212"
470+
testRunParseURIRefFails "urn:oasis:names:specification:docbook:dtd:xml:4.1.2"
471+
testRunParseURIRefFails "mailto:[email protected]"
472+
testRunParseURIRefFails "mailto:[email protected]"
441473

442474
suite "Query.print" do
443475
testPrintQuerySerializes
@@ -456,16 +488,16 @@ main = runTest $ suite "Data.URI" do
456488

457489
suite "Query.parser" do
458490
testParseQueryParses
459-
"key1=value1&key2=value2&key1=value3"
491+
"?key1=value1&key2=value2&key1=value3"
460492
(Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil))
461493
testParseQueryParses
462-
"key1&key2"
494+
"?key1&key2"
463495
(Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil))
464496
testParseQueryParses
465-
"key1=&key2="
497+
"?key1=&key2="
466498
(Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil))
467499
testParseQueryParses
468-
"key1=foo%3Bbar"
500+
"?key1=foo%3Bbar"
469501
(Query (Tuple "key1" (Just "foo;bar") : Nil))
470502

471503
suite "Common.match1From" do

0 commit comments

Comments
 (0)