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
9 changes: 2 additions & 7 deletions .travis.yml
Original file line number Diff line number Diff line change
@@ -1,13 +1,8 @@
language: node_js
node_js:
- 0.10
env:
- TAG=v0.7.0
install:
- wget -O $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/$TAG/linux64.tar.gz
- sudo tar zxvf $HOME/purescript.tar.gz -C /usr/local/bin purescript/psc{,i,-docs,-bundle} --strip-components=1
- sudo chmod a+x /usr/local/bin/psc{,i,-docs,-bundle}
- npm install bower gulp -g
- npm install && bower install
- npm install && bower install
script:
- gulp test-bundle
- gulp
22 changes: 11 additions & 11 deletions bower.json
Original file line number Diff line number Diff line change
Expand Up @@ -18,18 +18,18 @@
"tests"
],
"dependencies": {
"purescript-control": "^0.3.0",
"purescript-transformers": "^0.6.1",
"purescript-maps": "^0.4.0",
"purescript-aff": "^0.11.0",
"purescript-strings": "^0.5.2",
"purescript-arrays": "^0.4.0",
"purescript-lists": "^0.7.0",
"purescript-monoid": "^0.3.0",
"purescript-validation": "^0.2.0",
"purescript-aff": "^0.13.0",
"purescript-dom": "^0.2.6",
"purescript-eff": "^0.1.1",
"purescript-either": "^0.2.2",
"purescript-globals": "^0.2.1",
"purescript-lists": "^0.7.4",
"purescript-maps": "^0.5.0",
"purescript-maybe": "^0.3.4",
"purescript-prelude": "^0.1.2",
"purescript-semirings": "^0.2.0",
"purescript-dom": "^0.1.2",
"purescript-globals": "^0.2.0"
"purescript-tuples": "^0.4.0",
"purescript-validation": "^0.2.0"
},
"devDependencies": {
"purescript-console": "^0.1.0"
Expand Down
12 changes: 9 additions & 3 deletions docs/Routing/Match.md
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,12 @@ instance matchApply :: Apply Match
instance matchApplicative :: Applicative Match
```

#### `unMatch`

``` purescript
unMatch :: forall a. Match a -> Route -> V (Free MatchError) (Tuple Route a)
```

#### `list`

``` purescript
Expand All @@ -39,7 +45,7 @@ runMatch :: forall a. Match a -> Route -> Either String a
eitherMatch :: forall a b. Match (Either a b) -> Match b
```

if we match something that can fail then we have to
if we match something that can fail then we have to
match `Either a b`. This function converts matching on such
sum to matching on right subpart. Matching on left branch fails.
i.e.
Expand All @@ -49,11 +55,11 @@ sortOfString :: String -> Either String Sort
sortOfString "asc" = Right Asc
sortOfString "desc" = Right Desc
sortOfString _ = Left "incorrect sort"

newtype Routing = Routing Sort
routes :: Match Routing
routes = (pure Routing) <*> (eitherMatch (sortOfString <$> var))

```


2 changes: 1 addition & 1 deletion docs/Routing/Types.md
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
``` purescript
data RoutePart
= Path String
| Query (StrMap String)
| Query (Map String String)
```

#### `Route`
Expand Down
12 changes: 3 additions & 9 deletions gulpfile.js
Original file line number Diff line number Diff line change
@@ -1,15 +1,7 @@
'use strict'

var gulp = require('gulp'),
purescript = require('gulp-purescript'),
runSequence = require('run-sequence');

function sequence() {
var args = [].slice.apply(arguments);
return function() {
runSequence.apply(null, args);
};
}
purescript = require('gulp-purescript');

var sources = [
'src/**/*.purs',
Expand Down Expand Up @@ -66,3 +58,5 @@ gulp.task('test-bundle', ['test-make'], function() {
output: 'public/test.js'
});
});

gulp.task("default", ["test-bundle", "docs"]);
4 changes: 2 additions & 2 deletions package.json
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@
"homepage": "https://github.com/slamdata/purescript-routing",
"dependencies": {
"gulp": "^3.9.0",
"gulp-purescript": "^0.5.0",
"run-sequence": "^1.1.1"
"gulp-purescript": "^0.7.0",
"purescript": "^0.7.4"
}
}
20 changes: 10 additions & 10 deletions src/Routing.purs
Original file line number Diff line number Diff line change
Expand Up @@ -10,20 +10,20 @@ module Routing (
) where

import Prelude
import Control.Monad.Eff
import Control.Monad.Aff
import Data.Maybe
import Data.Either
import Data.Tuple
import Control.Monad.Eff (Eff())
import Control.Monad.Aff (Aff(), makeAff)
import Data.Maybe (Maybe(..))
import Data.Either (Either(), either)
import Data.Tuple (Tuple(..))
import qualified Data.String.Regex as R

import Routing.Parser
import Routing.Match


foreign import decodeURIComponent :: String -> String
foreign import decodeURIComponent :: String -> String

foreign import hashChanged :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit
foreign import hashChanged :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit


hashes :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit
Expand All @@ -49,16 +49,16 @@ matches' decoder routing cb = hashes $ \old new ->
matchesAff' :: forall e a. (String -> String) ->
Match a -> Aff e (Tuple (Maybe a) a)
matchesAff' decoder routing =
makeAff \_ k -> do
makeAff \_ k -> do
matches' decoder routing \old new ->
k $ Tuple old new

matchesAff :: forall e a. Match a -> Aff e (Tuple (Maybe a) a)
matchesAff = matchesAff' decodeURIComponent


matchHash :: forall a. Match a -> String -> Either String a
matchHash = matchHash' decodeURIComponent

matchHash' :: forall a. (String -> String) -> Match a -> String -> Either String a
matchHash' decoder matcher hash = runMatch matcher $ parse decoder hash
matchHash' decoder matcher hash = runMatch matcher $ parse decoder hash
72 changes: 38 additions & 34 deletions src/Routing/Match.purs
Original file line number Diff line number Diff line change
@@ -1,28 +1,31 @@
module Routing.Match where

import Prelude
import Data.Either
import Data.Tuple
import Data.Maybe
import Data.List
import Control.Alt
import Control.Plus
import Control.Apply
import Control.Alternative
import Control.Monad.Error
import qualified Data.StrMap as M
import Data.Either (Either(..))
import Data.Tuple (Tuple(..), snd)
import Data.Maybe (Maybe(..))
import Data.List (List(..), reverse)
import Control.Alt (Alt, (<|>))
import Control.Plus (Plus)
import Control.Alternative (Alternative)
import Control.Monad.Except
import Global (readFloat, isNaN)
import Data.Semiring.Free
import Data.Semiring.Free (Free(), free, runFree)
import Data.Foldable
import qualified Data.Array as A
import Data.Validation.Semiring


import qualified Data.Map as M
import qualified Data.String as S

import Routing.Parser
import Routing.Types
import Routing.Match.Class
import Routing.Match.Error

newtype Match a = Match (Route -> V (Free MatchError) (Tuple Route a))
newtype Match a = Match (Route -> V (Free MatchError) (Tuple Route a))
unMatch :: forall a. Match a -> (Route -> V (Free MatchError) (Tuple Route a))
unMatch (Match a) = a

instance matchMatchClass :: MatchClass Match where
lit input = Match $ \route ->
Expand All @@ -35,21 +38,21 @@ instance matchMatchClass :: MatchClass Match where
invalid $ free ExpectedPathPart
num = Match $ \route ->
case route of
Cons (Path input) rs ->
Cons (Path input) rs ->
let res = readFloat input in
if isNaN res then
invalid $ free ExpectedNumber
else
pure $ Tuple rs res
pure $ Tuple rs res
_ ->
invalid $ free ExpectedNumber

bool = Match $ \route ->
case route of
Cons (Path input) rs | input == "true" ->
pure $ Tuple rs true
pure $ Tuple rs true
Cons (Path input) rs | input == "false" ->
pure $ Tuple rs false
pure $ Tuple rs false
_ ->
invalid $ free ExpectedBoolean

Expand Down Expand Up @@ -80,24 +83,23 @@ instance matchFunctor :: Functor Match where
instance matchAlt :: Alt Match where
alt (Match r2e1) (Match r2e2) = Match $ \r -> do
(r2e1 r) <|> (r2e2 r)

instance matchPlus :: Plus Match where
empty = Match $ const $ invalid one

instance matchAlternative :: Alternative Match

instance matchApply :: Apply Match where
apply (Match r2a2b) (Match r2a) =
apply (Match r2a2b) (Match r2a) =
Match $ (\r -> runV (processFnErr r) processFnRes (r2a2b r))
where processFnErr r err =
where processFnErr r err =
invalid $ err * runV id (const one) (r2a r)
processFnRes (Tuple rs a2b) =
runV invalid (\(Tuple rss a) -> pure $ Tuple rss (a2b a)) (r2a rs)

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)
Expand All @@ -109,22 +111,23 @@ list (Match r2a) =
(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
-- [[String]] -fold with semicolon-> [String] -fold with newline-> String
runMatch :: forall a. Match a -> Route -> Either String a
runMatch (Match fn) route =
runV foldErrors (Right <<< snd) $ fn route
where foldErrors errs = Left $
foldl (\b a -> a <> "\n" <> b) "" do
es <- reverse <$> runFree errs
pure $ foldl (\b a -> a <> ";" <> b) "" $ showMatchError <$> es
where
foldErrors errs =
Left $ foldl (\b a -> a <> "\n" <> b) "" do
es <- reverse <$> runFree errs
pure $ foldl (\b a -> a <> ";" <> b) "" $ showMatchError <$> es


-- | if we match something that can fail then we have to
-- | if we match something that can fail then we have to
-- | match `Either a b`. This function converts matching on such
-- | sum to matching on right subpart. Matching on left branch fails.
-- | i.e.
Expand All @@ -134,16 +137,17 @@ runMatch (Match fn) route =
-- | sortOfString "asc" = Right Asc
-- | sortOfString "desc" = Right Desc
-- | sortOfString _ = Left "incorrect sort"
-- |
-- |
-- | newtype Routing = Routing Sort
-- | routes :: Match Routing
-- | routes = (pure Routing) <*> (eitherMatch (sortOfString <$> var))
-- |
-- |
-- | ```
eitherMatch :: forall a b. Match (Either a b) -> Match b
eitherMatch (Match r2eab) = Match $ \r ->
runV invalid runEither $ (r2eab r)
where runEither (Tuple rs eit) =
case eit of
Left _ -> invalid $ free $ Fail "Nested check failed"
Right res -> pure $ Tuple rs res
where
runEither (Tuple rs eit) =
case eit of
Left _ -> invalid $ free $ Fail "Nested check failed"
Right res -> pure $ Tuple rs res
2 changes: 1 addition & 1 deletion src/Routing/Match/Class.purs
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
module Routing.Match.Class where

import Prelude
import Control.Alternative
import Control.Alternative (Alternative)

class (Alternative f) <= MatchClass f where
lit :: String -> f Unit
Expand Down
32 changes: 14 additions & 18 deletions src/Routing/Parser.purs
Original file line number Diff line number Diff line change
Expand Up @@ -2,43 +2,39 @@ module Routing.Parser (
parse
) where

import Prelude
import Prelude
import Control.MonadPlus (guard)
import Data.Maybe (Maybe(), fromMaybe)
import Data.Tuple (Tuple(..))
import Data.List (toList, List())
import Data.Traversable (traverse)
import qualified Data.StrMap as M
import Data.Traversable (traverse)
import qualified Data.Map as M
import qualified Data.String as S
import qualified Data.Array as A

import Routing.Types


tryQuery :: RoutePart -> RoutePart
tryQuery source@(Path string) = fromMaybe source $ do
guard $ S.take 1 string == "?"
Query <$> M.fromList <$> traverse part2tuple parts

-- | Parse part of hash. Will return `Query (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.fromList)
$ traverse part2tuple parts
where
parts :: List String
parts = toList $ S.split "&" $ S.drop 1 string
parts = toList $ S.split "&" $ S.drop 1 str

part2tuple :: String -> Maybe (Tuple String String)
part2tuple input = do
let keyVal = S.split "=" input
guard $ A.length keyVal <= 2
Tuple <$> (A.head keyVal) <*> (keyVal A.!! 1)

tryQuery q = q


-- | 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 <$>
decoder <$>
toList (S.split "/" hash)

map ( decoder >>> parsePart ) $ toList (S.split "/" hash)
Loading