Merge pull request #15 from cryogenian/ready/update

update

Author: cryogenian

.travis.yml

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

bower.json

@@ -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"

docs/Routing/Match.md

@@ -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
@@ -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.
@@ -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))
-           
+
 ```
 
 

docs/Routing/Types.md

@@ -5,7 +5,7 @@
 ``` purescript
 data RoutePart
   = Path String
-  | Query (StrMap String)
+  | Query (Map String String)
 ```
 
 #### `Route`

gulpfile.js

@@ -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',
@@ -66,3 +58,5 @@ gulp.task('test-bundle', ['test-make'], function() {
         output: 'public/test.js'
     });
 });
+
+gulp.task("default", ["test-bundle", "docs"]);

package.json

@@ -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"
   }
 }

src/Routing.purs

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

src/Routing/Match.purs

@@ -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 ->
@@ -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
 
@@ -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)
@@ -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.
@@ -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

src/Routing/Match/Class.purs

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

src/Routing/Parser.purs

@@ -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)