Merge pull request #46 from garyb/query-parsing-fixes

Query parsing fixes

Author: garyb

bower.json

@@ -41,6 +41,7 @@
     "purescript-integers": "^3.0.0"
   },
   "devDependencies": {
-    "purescript-console": "^3.0.0"
+    "purescript-console": "^3.0.0",
+    "purescript-assert": "^3.0.0"
   }
 }

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

@@ -1,16 +1,19 @@
 module Test.Main where
 
-import Prelude (class Show, Unit, discard, show, ($), (<$>), (*>), (<*), (<*>), (<>), append)
-import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (CONSOLE(), log)
+import Prelude
+
 import Control.Alt ((<|>))
+import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.Console (CONSOLE, log)
+import Data.Either (Either(..))
 import Data.List (List)
+import Data.List as L
 import Data.Map as M
-
-
+import Data.Tuple (Tuple(..))
 import Routing (match)
 import Routing.Match (Match, list)
 import Routing.Match.Class (bool, end, int, lit, num, param, params)
+import Test.Assert (ASSERT, assert')
 
 data FooBar
   = Foo Number (M.Map String String)
@@ -19,6 +22,8 @@ data FooBar
   | Quux Int
   | End Int
 
+derive instance eqFooBar :: Eq FooBar
+
 instance showFooBar :: Show FooBar where
   show (Foo num q) = "(Foo " <> show num <> " " <> show q <> ")"
   show (Bar bool str) = "(Bar " <> show bool <> " " <> show str <> ")"
@@ -36,18 +41,22 @@ routing =
     <|> Baz <$> (list num)
 
 
-main :: Eff (console :: CONSOLE) Unit
+main :: Eff (assert :: ASSERT, console :: CONSOLE) Unit
 main = do
-  print "Foo: " $ match routing "foo/12/?welp='hi'&b=false" -- foo
-  print "Foo: " $ match routing "foo/12?welp='hi'&b=false" -- foo
-  print "Quux: " $ match routing "/quux/42" -- quux
-  print "Baz: " $ match routing "/123/" -- baz
-  print "End: " $ match routing "/1" -- end
-
-  where print s e = log $ append s $ show e
-
-  -- (minimal test for browser)
-
-  -- matches routing $ \old new -> void do
-  --   logShow old
-  --   logShow new
+  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 "/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
+  . Eq a
+  => Show a
+  => a
+  -> a
+  -> Eff (assert :: ASSERT, console :: CONSOLE | eff) Unit
+assertEq actual expected
+  | actual /= expected = assert' ("Equality assertion failed\n\nActual: " <> show actual <> "\n\nExpected: " <> show expected) false
+  | otherwise = log ("Equality assertion passed for " <> show actual)