Merge pull request #8 from cryogenian/decoder-and-list

Decoder and list combinator

Author: jdegoes

MODULES.md

@@ -22,6 +22,16 @@ hashes :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit
 matches :: forall e a. Match a -> (Maybe a -> a -> Eff e Unit) -> Eff e Unit
 ```
 
+Stream of hash changed, callback called when new hash can be matched
+First argument of callback is `Just a` when old hash can be matched
+and `Nothing` when it can't.
+
+#### `matches'`
+
+``` purescript
+matches' :: forall e a. (String -> String) -> Match a -> (Maybe a -> a -> Eff e Unit) -> Eff e Unit
+```
+
 
 #### `matchHash`
 
@@ -30,6 +40,13 @@ matchHash :: forall a. Match a -> String -> Either String a
 ```
 
 
+#### `matchHash'`
+
+``` purescript
+matchHash' :: forall a. (String -> String) -> Match a -> String -> Either String a
+```
+
+
 
 ## Module Routing.Hash
 
@@ -114,6 +131,15 @@ instance matchApplicative :: Applicative Match
 ```
 
 
+#### `list`
+
+``` purescript
+list :: forall a. Match a -> Match (List a)
+```
+
+Matches list of matchers. Useful when argument can easy fail (not `str`)
+returns `Match Nil` if no matches
+
 #### `runMatch`
 
 ``` purescript
@@ -149,9 +175,11 @@ routes = (pure Routing) <*> (eitherMatch (sortOfString <$> var))
 #### `parse`
 
 ``` purescript
-parse :: String -> Route
+parse :: (String -> String) -> String -> Route
 ```
 
+Parse hash string to `Route` with `decoder` function
+applied to every hash part (usually `decodeURIComponent`)
 
 
 ## Module Routing.Types

src/Routing.purs

@@ -1,4 +1,11 @@
-module Routing where
+module Routing (
+  hashChanged,
+  hashes,
+  matches,
+  matches',
+  matchHash,
+  matchHash'
+  ) where
 
 import Control.Monad.Eff
 import Data.Maybe
@@ -8,6 +15,9 @@ import qualified Data.String.Regex as R
 import Routing.Parser
 import Routing.Match
 
+
+foreign import decodeURIComponent :: String -> String 
+
 foreign import hashChanged """
 function hashChanged(handler) {
   return function() {
@@ -28,12 +38,22 @@ hashes cb =
   where dropHash h = R.replace (R.regex "^[^#]*#" R.noFlags) "" h
 
 
+-- | Stream of hash changed, callback called when new hash can be matched
+-- | First argument of callback is `Just a` when old hash can be matched
+-- | and `Nothing` when it can't.
 matches :: forall e a. Match a -> (Maybe a -> a -> Eff e Unit) -> Eff e Unit
-matches routing cb = hashes $ \old new -> 
-  let mr = matchHash routing 
+matches = matches' decodeURIComponent
+
+matches' :: forall e a. (String -> String) ->
+            Match a -> (Maybe a -> a -> Eff e Unit) -> Eff e Unit
+matches' decoder routing cb = hashes $ \old new ->
+  let mr = matchHash' decoder routing
       fst = either (const Nothing) Just $ mr old
   in either (const $ pure unit) (cb fst) $ mr new 
 
 
 matchHash :: forall a. Match a -> String -> Either String a
-matchHash matcher hash = runMatch matcher $ parse hash
+matchHash = matchHash' decodeURIComponent
+
+matchHash' :: forall a. (String -> String) -> Match a -> String -> Either String a
+matchHash' decoder matcher hash = runMatch matcher $ parse decoder hash 

src/Routing/Match.purs

@@ -96,6 +96,22 @@ instance matchApply :: Apply Match where
 instance matchApplicative :: Applicative Match where
   pure a = Match \r -> pure $ Tuple r a
 
+
+-- | Matches list of matchers. Useful when argument can easy fail (not `str`)
+-- | returns `Match Nil` if no matches
+list :: forall a. Match a -> Match (List a)
+list (Match r2a) =
+  Match $ go Nil
+  where go :: List a -> Route -> V (Free MatchError) (Tuple Route (List a))
+        go accum r =
+          runV
+          (const $ pure (Tuple r (reverse accum)))
+          (\(Tuple rs a) -> go (Cons a accum) rs)
+          (r2a r)
+          
+
+
+
 -- It groups `Free MatchError` -> [[MatchError]] -map with showMatchError ->
 -- [[String]] -fold with semicolon-> [String] -fold with newline-> String 
 runMatch :: forall a. Match a -> Route -> Either String a

src/Routing/Parser.purs

@@ -26,11 +26,12 @@ tryQuery source@(Path string) = fromMaybe source $ do
           Tuple <$> (A.head keyVal) <*> (keyVal A.!! 1)
 tryQuery q = q
 
-foreign import decodeURIComponent :: String -> String
 
-parse :: String -> Route
-parse hash = tryQuery <$>
+-- | Parse hash string to `Route` with `decoder` function
+-- | applied to every hash part (usually `decodeURIComponent`)
+parse :: (String -> String) -> String -> Route
+parse decoder hash = tryQuery <$>
              Path <$>
-             decodeURIComponent <$>
+             decoder <$> 
              fromArray (S.split "/" hash)
 

test/Main.purs

@@ -5,19 +5,22 @@ import Debug.Trace
 import Control.Alt
 import Control.Apply
 import Debug.Foreign
-
+import Data.List
 
 import Routing
 import Routing.Match
 import Routing.Match.Class
 
-data FooBar = Foo Number | Bar Boolean String
+data FooBar = Foo Number | Bar Boolean String | Baz (List Number) 
 
 routing :: Match FooBar
 routing =
   Foo <$> (lit "foo" *> num)
   <|>
   Bar <$> (lit "bar" *> bool) <*> (param "baz")
+  <|>
+  Baz <$> (list num)
+
 
 main = do
   fprint $ matchHash routing "food/asdf"