Merge pull request #29 from garyb/semicolon-in-query

Fix behaviour of semicolons in query parts

Author: garyb

src/Data/URI/Common.purs

@@ -12,7 +12,7 @@ import Data.String as S
 import Data.String.Regex as RX
 import Data.String.Regex.Flags as RXF
 import Data.Unfoldable (replicateA)
-import Global (decodeURI, decodeURIComponent, encodeURIComponent)
+import Global (decodeURI, decodeURIComponent)
 import Partial.Unsafe (unsafePartial)
 import Text.Parsing.StringParser (ParseError(..), Parser(..), unParser)
 import Text.Parsing.StringParser.String (string)
@@ -44,21 +44,6 @@ parsePChar f
 parseUnreserved ∷ Parser String
 parseUnreserved = rxPat "[0-9a-z\\-\\._~]+"
 
-parseFragmentOrQuery ∷ Parser String
-parseFragmentOrQuery = parsePChar decodePCTComponent <|> string "/" <|> string "?"
-
-printFragmentOrQuery ∷ String → String
-printFragmentOrQuery = S.joinWith "" <<< map printChar <<< S.split (S.Pattern "")
-  where
-  -- Fragments & queries have a bunch of characters that don't need escaping
-  printChar ∷ String → String
-  printChar s
-    | RX.test rxPrintable s = s
-    | otherwise = encodeURIComponent s
-
-rxPrintable ∷ RX.Regex
-rxPrintable = unsafePartial fromRight $ RX.regex "[$&+;=/?:@]" RXF.global
-
 newtype PCTEncoded = PCTEncoded String
 
 decodePCT ∷ PCTEncoded → String

src/Data/URI/Fragment.purs

@@ -2,13 +2,31 @@ module Data.URI.Fragment (parser, print) where
 
 import Prelude
 
+import Control.Alt ((<|>))
+import Data.Either (fromRight)
+import Data.String as S
+import Data.String.Regex as RX
+import Data.String.Regex.Flags as RXF
 import Data.URI (Fragment(..))
-import Data.URI.Common (joinWith, parseFragmentOrQuery, printFragmentOrQuery)
+import Data.URI.Common (decodePCTComponent, joinWith, parsePChar)
+import Global (encodeURIComponent)
+import Partial.Unsafe (unsafePartial)
 import Text.Parsing.StringParser (Parser)
 import Text.Parsing.StringParser.Combinators (many)
+import Text.Parsing.StringParser.String (string)
 
 parser ∷ Parser Fragment
-parser = Fragment <<< joinWith "" <$> many parseFragmentOrQuery
+parser = Fragment <<< joinWith ""
+  <$> many (parsePChar decodePCTComponent <|> string "/" <|> string "?")
 
 print ∷ Fragment → String
-print (Fragment f) = printFragmentOrQuery 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
+  printChar s
+    | RX.test rxPrintable s = s
+    | otherwise = encodeURIComponent s
+
+rxPrintable ∷ RX.Regex
+rxPrintable = unsafePartial fromRight $ RX.regex "[&;$+=/?:@]" RXF.global

src/Data/URI/Query.purs

@@ -3,25 +3,31 @@ module Data.URI.Query (parser, print) where
 import Prelude
 
 import Control.Alt ((<|>))
+import Data.Either (fromRight)
 import Data.List (List(..))
 import Data.Maybe (Maybe(..))
+import Data.String as S
+import Data.String.Regex as RX
+import Data.String.Regex.Flags as RXF
 import Data.Tuple (Tuple(..))
 import Data.URI (Query(..))
-import Data.URI.Common (joinWith, parseFragmentOrQuery, printFragmentOrQuery, rxPat, wrapParser)
+import Data.URI.Common (joinWith, rxPat, wrapParser)
+import Global (decodeURIComponent, encodeURIComponent)
+import Partial.Unsafe (unsafePartial)
 import Text.Parsing.StringParser (Parser, try)
-import Text.Parsing.StringParser.Combinators (optionMaybe, sepBy, many)
+import Text.Parsing.StringParser.Combinators (optionMaybe, sepBy)
 import Text.Parsing.StringParser.String (string)
 
 parser ∷ Parser Query
-parser = Query <$> (wrapParser parseParts $ try (joinWith "" <$> many parseFragmentOrQuery))
+parser = Query <$> wrapParser parseParts (try (rxPat "[^#]*"))
 
 parseParts ∷ Parser (List (Tuple String (Maybe String)))
 parseParts = sepBy parsePart (string ";" <|> string "&")
 
 parsePart ∷ Parser (Tuple String (Maybe String))
 parsePart = do
-  key ← rxPat "[^=;&]+"
-  value ← optionMaybe $ string "=" *> rxPat "[^;&]*"
+  key ← decodeURIComponent <$> rxPat "[^=;&]+"
+  value ← optionMaybe $ decodeURIComponent <$> (string "=" *> rxPat "[^;&]*")
   pure $ Tuple key value
 
 print ∷ Query → String
@@ -31,5 +37,19 @@ print (Query m) =
     items → "?" <> joinWith "&" (printPart <$> items)
   where
   printPart ∷ Tuple String (Maybe String) → String
-  printPart (Tuple k Nothing) = printFragmentOrQuery k
-  printPart (Tuple k (Just v)) = printFragmentOrQuery k <> "=" <> printFragmentOrQuery v
+  printPart (Tuple k Nothing) =
+    printQueryPart k
+  printPart (Tuple k (Just v)) =
+    printQueryPart k <> "=" <> printQueryPart v
+
+printQueryPart ∷ String → String
+printQueryPart = S.joinWith "" <<< map printChar <<< S.split (S.Pattern "")
+  where
+  -- Fragments & queries have a bunch of characters that don't need escaping
+  printChar ∷ String → String
+  printChar s
+    | RX.test rxPrintable s = s
+    | otherwise = encodeURIComponent s
+
+rxPrintable ∷ RX.Regex
+rxPrintable = unsafePartial fromRight $ RX.regex "[$+=/?:@]" RXF.global

test/Main.purs

@@ -450,6 +450,9 @@ main = runTest $ suite "Data.URI" do
     testPrintQuerySerializes
       (Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil))
       "?key1&key2"
+    testPrintQuerySerializes
+      (Query (Tuple "key1" (Just "foo;bar") : Nil))
+      "?key1=foo%3Bbar"
 
   suite "Query.parser" do
     testParseQueryParses
@@ -461,6 +464,9 @@ main = runTest $ suite "Data.URI" do
     testParseQueryParses
       "key1=&key2="
       (Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil))
+    testParseQueryParses
+      "key1=foo%3Bbar"
+      (Query (Tuple "key1" (Just "foo;bar") : Nil))
 
   suite "Common.match1From" do
     testMatch1FromMisses (regex "key1" noFlags) 0 ""