Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
30 changes: 29 additions & 1 deletion MODULES.md
Original file line number Diff line number Diff line change
Expand Up @@ -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`

Expand All @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
28 changes: 24 additions & 4 deletions src/Routing.purs
Original file line number Diff line number Diff line change
@@ -1,4 +1,11 @@
module Routing where
module Routing (
hashChanged,
hashes,
matches,
matches',
matchHash,
matchHash'
) where

import Control.Monad.Eff
import Data.Maybe
Expand All @@ -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() {
Expand All @@ -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
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This Eff feels like it doesn't belong here. You have a few options:

matches :: forall e a b. Match a -> (Maybe a -> a -> b) -> Maybe b

matches :: forall e a b. (Monoid b) => Match a -> (Maybe a -> a -> b) -> b

With the 2nd option, you'd have to submit a PR for purescript-monoid to define Monoid (Eff eff a) when a is a Monoid (which is a sensible monoid to have, just missing).

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
16 changes: 16 additions & 0 deletions src/Routing/Match.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
9 changes: 5 additions & 4 deletions src/Routing/Parser.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

7 changes: 5 additions & 2 deletions test/Main.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down