Merge pull request #7 from cryogenian/squashed

Squashed commit of the following:

Author: jdegoes

.travis.yml

@@ -2,12 +2,12 @@ language: node_js
 node_js:
   - 0.10
 env:
-  - TAG=v0.6.8
+  - TAG=v0.6.9.3
 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,-make} --strip-components=1
   - sudo chmod a+x /usr/local/bin/psc{,i,-docs,-make}
   - npm install bower gulp -g
   - npm install && bower install 
 script:
-  - gulp bundle-test
+  - gulp bundle-dev

MODULES.md

@@ -31,13 +31,37 @@ matchHash :: forall a. Match a -> String -> Either String a
 
 
 
+## Module Routing.Hash
+
+#### `setHash`
+
+``` purescript
+setHash :: forall e. String -> Eff (dom :: DOM | e) Unit
+```
+
+
+#### `getHash`
+
+``` purescript
+getHash :: forall e. Eff (dom :: DOM | e) String
+```
+
+
+#### `modifyHash`
+
+``` purescript
+modifyHash :: forall e. (String -> String) -> Eff (dom :: DOM | e) Unit
+```
+
+
+
 ## Module Routing.Match
 
 #### `Match`
 
 ``` purescript
 newtype Match a
-  = Match (Route -> Either String (Tuple Route a))
+  = Match (Route -> V (Free MatchError) (Tuple Route a))
 ```
 
 
@@ -90,35 +114,36 @@ instance matchApplicative :: Applicative Match
 ```
 
 
-#### `matchBind`
-
-``` purescript
-instance matchBind :: Bind Match
-```
-
-
-#### `matchMonad`
+#### `runMatch`
 
 ``` purescript
-instance matchMonad :: Monad Match
+runMatch :: forall a. Match a -> Route -> Either String a
 ```
 
-
-#### `matchMonadPlus`
+#### `eitherMatch`
 
 ``` purescript
-instance matchMonadPlus :: MonadPlus Match
+eitherMatch :: forall a b. Match (Either a b) -> Match b
 ```
 
-
-#### `runMatch`
-
-``` purescript
-runMatch :: forall a. Match a -> Route -> Either String a
+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.
+```purescript
+data Sort = Asc | Desc
+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))
+           
 ```
 
 
-
 ## Module Routing.Parser
 
 #### `parse`
@@ -129,33 +154,6 @@ parse :: String -> Route
 
 
 
-## Module Routing.Setter
-
-#### `setHash`
-
-``` purescript
-setHash :: forall e. String -> Eff e Unit
-```
-
-
-#### `RouteState`
-
-``` purescript
-class RouteState a where
-  toHash :: a -> String
-```
-
-Class of types that can be converted to hashes 
-
-#### `setRouteState`
-
-``` purescript
-setRouteState :: forall r e. (RouteState r) => r -> Eff e Unit
-```
-
-wrapper over `setHash` that uses `RouteState`
-
-
 ## Module Routing.Types
 
 #### `RoutePart`
@@ -170,7 +168,7 @@ data RoutePart
 #### `Route`
 
 ``` purescript
-type Route = [RoutePart]
+type Route = List RoutePart
 ```
 
 
@@ -180,28 +178,38 @@ type Route = [RoutePart]
 #### `MatchClass`
 
 ``` purescript
-class (MonadPlus f) <= MatchClass f where
+class (Alternative f) <= MatchClass f where
   lit :: String -> f Unit
-  var :: f String
+  str :: f String
   param :: String -> f String
+  num :: f Number
+  bool :: f Boolean
   fail :: forall a. String -> f a
 ```
 
 
 
-## Module Routing.Match.Combinators
+## Module Routing.Match.Error
 
-#### `num`
+#### `MatchError`
 
 ``` purescript
-num :: forall f. (MatchClass f) => String -> f Number
+data MatchError
+  = UnexpectedPath String
+  | ExpectedBoolean 
+  | ExpectedNumber 
+  | ExpectedString 
+  | ExpectedQuery 
+  | ExpectedPathPart 
+  | KeyNotFound String
+  | Fail String
 ```
 
 
-#### `bool`
+#### `showMatchError`
 
 ``` purescript
-bool :: forall f. (MatchClass f) => String -> f Boolean
+showMatchError :: MatchError -> String
 ```
 
 

bower.json

@@ -27,7 +27,8 @@
     "purescript-validation": "~0.1.1",
     "purescript-semirings": "~0.1.1",
     "purescript-lists": "~0.6.0",
-    "purescript-globals": "~0.1.6"
+    "purescript-globals": "~0.1.6",
+    "purescript-dom": "~0.1.2"
   },
   "devDependencies": {
     "purescript-timers": "~0.0.8",

src/Routing/Hash.purs

@@ -0,0 +1,21 @@
+module Routing.Hash where
+
+import Control.Monad.Eff
+import DOM
+
+foreign import setHash """
+function setHash(hash) {
+  return function() {
+    document.location.hash = hash;
+  };
+}
+""" :: forall e. String -> Eff (dom :: DOM |e) Unit
+
+foreign import getHash """
+function getHash() {
+  return document.location.hash.replace(/^[^#]*#/g, "");
+}
+""" :: forall e. Eff (dom :: DOM |e) String
+
+modifyHash :: forall e. (String -> String) -> Eff (dom :: DOM|e) Unit
+modifyHash fn = (fn <$> getHash) >>= setHash 

src/Routing/Match.purs

@@ -107,4 +107,26 @@ runMatch (Match fn) route =
             pure $ foldl (\b a -> a <> ";" <> b) "" $ showMatchError <$>  es
 
 
-    
+-- | 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.
+-- | ```purescript
+-- | data Sort = Asc | Desc
+-- | 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))
+-- |            
+-- | ```
+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