Fix routing for query strings

Author: garyb

src/Routing/Parser.purs

@@ -1,46 +1,45 @@
-module Routing.Parser (
-  parse
-  ) where
+module Routing.Parser (parse) where
 
-import Control.MonadPlus (guard)
+import Prelude
+
+import Routing.Types (Route, RoutePart(..))
 import Data.Array as A
-import Data.Either (fromRight)
-import Data.List (fromFoldable, List)
 import Data.Map as M
-import Data.Maybe (Maybe, fromMaybe)
 import Data.String as S
-import Data.String.Regex (Regex, regex, split) as R
-import Data.String.Regex.Flags (noFlags) as R
+import Control.MonadPlus (guard)
+import Data.List as L
+import Data.Maybe (Maybe(..))
 import Data.Traversable (traverse)
 import Data.Tuple (Tuple(..))
-import Partial.Unsafe (unsafePartial)
-import Prelude (map, discard, (>>>), ($), (<<<), (==), (<*>), (<$>), (<=))
-import Routing.Types (Route, RoutePart(..))
 
--- | Parse part of hash. Will return `Query (Map String String)` for query
+-- | Parse query part of hash. Will return `Map String String` for query
 -- | i.e. `"?foo=bar&bar=baz"` -->
--- |     `Query (fromList [Tuple "foo" "bar", Tuple "bar" "baz"])`
-parsePart :: String -> RoutePart
-parsePart str = fromMaybe (Path str) do
-  guard $ S.take 1 str == "?"
-  map (Query <<< M.fromFoldable)
-    $ traverse part2tuple parts
+-- |     `fromList [Tuple "foo" "bar", Tuple "bar" "baz"]`
+parseQueryPart :: (String -> String) -> String -> Maybe (M.Map String String)
+parseQueryPart decoder =
+  map M.fromFoldable <<< traverse part2tuple <<< S.split (S.Pattern "&")
   where
-  parts :: List String
-  parts = fromFoldable $ S.split (S.Pattern "&") $ S.drop 1 str
-
-  part2tuple :: String -> Maybe (Tuple String String)
-  part2tuple input = do
-    let keyVal = S.split (S.Pattern "=") input
-    guard $ A.length keyVal <= 2
-    Tuple <$> (A.head keyVal) <*> (keyVal A.!! 1)
-
-
-splitRegex :: R.Regex
-splitRegex = unsafePartial fromRight $ R.regex "\\/|(?=\\?)" R.noFlags
+    part2tuple :: String -> Maybe (Tuple String String)
+    part2tuple input = do
+      let keyVal = decoder <$> S.split (S.Pattern "=") input
+      guard $ A.length keyVal <= 2
+      Tuple <$> A.head keyVal <*> keyVal A.!! 1
 
 -- | Parse hash string to `Route` with `decoder` function
 -- | applied to every hash part (usually `decodeURIComponent`)
 parse :: (String -> String) -> String -> Route
 parse decoder hash =
-  map ( decoder >>> parsePart ) $ fromFoldable (R.split splitRegex hash)
+  case flip S.splitAt hash =<< S.indexOf (S.Pattern "?") hash of
+    Just { before, after } ->
+      pathParts before
+        <> map Query (L.fromFoldable (parseQueryPart decoder (S.drop 1 after)))
+    Nothing ->
+      pathParts hash
+  where
+    pathParts str =
+      let
+        parts = L.fromFoldable $ map Path (S.split (S.Pattern "/") str)
+      in
+        case L.unsnoc parts of
+          Just { init, last: Path "" } -> init
+          _ -> parts

test/Test/Main.purs

@@ -38,16 +38,17 @@ routing =
     <|> Quux <$> (lit "" *> lit "quux" *> int)
     -- Order matters here.  `list` is greedy, and `end` wont match after it
     <|> End <$> (lit "" *> int <* end)
-    <|> Baz <$> (lit "" *> list num)
+    <|> Baz <$> (list num)
 
 
 main :: Eff (assert :: ASSERT, console :: CONSOLE) Unit
 main = do
   assertEq (match routing "foo/12/?welp='hi'&b=false") (Right (Foo 12.0 (M.fromFoldable [Tuple "welp" "'hi'", Tuple "b" "false"])))
   assertEq (match routing "foo/12?welp='hi'&b=false") (Right (Foo 12.0 (M.fromFoldable [Tuple "welp" "'hi'", Tuple "b" "false"])))
   assertEq (match routing "/quux/42") (Right (Quux 42))
-  assertEq (match routing "/123/") (Right (Baz (L.fromFoldable [123.0])))
+  assertEq (match routing "123/") (Right (Baz (L.fromFoldable [123.0])))
   assertEq (match routing "/1") (Right (End 1))
+  assertEq (match routing "foo/0/?test=a/b/c") (Right (Foo 0.0 (M.fromFoldable [Tuple "test" "a/b/c"])))
 
 assertEq
   :: forall a eff