Parse/print tweaks

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
     ]

src/Data/URI/Authority.purs

@@ -17,14 +17,15 @@ 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)
   pure $ Authority ui (fromFoldable hosts)
 
 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

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

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 "&")

src/Data/URI/RelativePart.purs

@@ -11,15 +11,14 @@ 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
   where
 
   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
       ]
 

src/Data/URI/RelativeRef.purs

@@ -11,26 +11,26 @@ 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
 
 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
 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

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 <> ":"

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)

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