From aee3b96caf44ab58050d05689629035944298245 Mon Sep 17 00:00:00 2001
From: nukisman <nukisman@gmail.com>
Date: Wed, 19 Dec 2018 20:11:55 +0300
Subject: [PATCH] Typed query params

---
 src/Routing/Match.purs | 59 +++++++++++++++++++++++++++++++++++++++++-
 test/Test/Main.purs    |  8 +++++-
 2 files changed, 65 insertions(+), 2 deletions(-)

diff --git a/src/Routing/Match.purs b/src/Routing/Match.purs
index 99a0969..8a47be6 100644
--- a/src/Routing/Match.purs
+++ b/src/Routing/Match.purs
@@ -16,7 +16,7 @@ import Data.Semiring.Free (Free, free)
 import Data.String.NonEmpty (NonEmptyString)
 import Data.String.NonEmpty as NES
 import Data.Tuple (Tuple(..), snd)
-import Data.Validation.Semiring (V, invalid, unV)
+import Data.Validation.Semiring (V, invalid, unV, toEither)
 import Global (readFloat, isNaN)
 import Routing.Match.Error (MatchError(..), showMatchError)
 import Routing.Types (Route, RoutePart(..))
@@ -126,6 +126,63 @@ param key = Match \route ->
     _ ->
       invalid $ free ExpectedQuery
 
+-- | Matches a parameter with custom decoder
+paramWith :: forall a. (String -> V (Free MatchError) a) -> String -> Match a
+paramWith decode key = Match \route ->
+  case route of
+    Cons (Query map) rs ->
+      case M.lookup key map of
+        Nothing ->
+          invalid $ free $ KeyNotFound key
+        Just s ->
+          case decode s # toEither of
+            Right el  ->
+              pure $ Tuple (Cons (Query <<< M.delete key $ map) rs) el
+            Left e -> invalid $ e
+    _ ->
+      invalid $ free ExpectedQuery
+
+-- | `paramWith toNum`
+paramNum :: String -> Match Number
+paramNum = paramWith toNum
+
+-- | `paramWith toInt`
+paramInt :: String -> Match Int
+paramInt = paramWith toInt
+
+-- | `paramWith toBool`
+paramBool :: String -> Match Boolean
+paramBool = paramWith toBool
+
+-- | `Number` decoder for usage with `paramWith`
+toNum ::
+  String ->
+  V (Free MatchError) Number
+toNum s =
+  let n = readFloat s
+  in
+    if isNaN n
+    then invalid $ free ExpectedNumber
+    else pure n
+
+-- | `Int` decoder for usage with `paramWith`
+toInt ::
+  String ->
+  V (Free MatchError) Int
+toInt s =
+  case fromString s of
+    Just n -> pure n
+    Nothing -> invalid $ free ExpectedInt
+
+-- | `Boolean` decoder for usage with `paramWith`
+toBool ::
+  String ->
+  V (Free MatchError) Boolean
+toBool = case _ of
+  "true" -> pure true
+  "false" -> pure false
+  _ -> invalid $ free ExpectedBoolean
+
 -- | `params` matches an entire query block. For exmaple, `params`
 -- | matches `/?q=a&r=b` as the map `{q : "a", r : "b"}`. Note that
 -- | `lit "foo" *> params` does *not* match `/foo`, since a query component
diff --git a/test/Test/Main.purs b/test/Test/Main.purs
index 5876045..b29c589 100644
--- a/test/Test/Main.purs
+++ b/test/Test/Main.purs
@@ -16,7 +16,7 @@ import Data.String.NonEmpty as NES
 import Data.Tuple (Tuple(..))
 import Partial.Unsafe (unsafePartial)
 import Routing (match)
-import Routing.Match (Match, bool, end, int, list, lit, nonempty, num, param, params, str)
+import Routing.Match (Match, bool, end, int, list, lit, nonempty, num, param, paramNum, paramInt, paramBool, params, str)
 import Test.Assert (assertEqual)
 
 data MyRoutes
@@ -26,6 +26,7 @@ data MyRoutes
   | Quux Int
   | Corge String
   | Corge' NonEmptyString
+  | TypedParams Int Boolean Number
   | End Int
 
 derive instance eqMyRoutes :: Eq MyRoutes
@@ -40,6 +41,7 @@ routing = oneOf
   , Quux <$> (lit "" *> lit "quux" *> int)
   , Corge <$> (lit "corge" *> str)
   , Corge' <$> (lit "corge'" *> nonempty)
+  , TypedParams <$ lit "typedParams" <*> paramInt "i" <*> paramBool "is" <*> paramNum "n"
   , End <$> (lit "" *> int <* end)
   ]
 
@@ -53,6 +55,10 @@ main = do
     { actual: match routing "foo/12?welp='hi'&b=false"
     , expected: Right (Foo 12.0 (M.fromFoldable [Tuple "welp" "'hi'", Tuple "b" "false"]))
     }
+  assertEqual
+    { actual: match routing "typedParams?i=123&is=false&n=0.99"
+    , expected: Right (TypedParams 123 false 0.99)
+    }
   assertEqual
     { actual: match routing "bar/true?baz=test"
     , expected: Right (Bar true "test")