From c5cc4402c96ca60c3788c6b1386d0c66d11e7c8f Mon Sep 17 00:00:00 2001
From: "John A. De Goes" <john@degoes.net>
Date: Mon, 9 Mar 2015 16:46:55 -0600
Subject: [PATCH 01/18] Initial commit

---
 LICENSE | 202 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 202 insertions(+)
 create mode 100644 LICENSE

diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..e06d208
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,202 @@
+Apache License
+                           Version 2.0, January 2004
+                        http://www.apache.org/licenses/
+
+   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
+
+   1. Definitions.
+
+      "License" shall mean the terms and conditions for use, reproduction,
+      and distribution as defined by Sections 1 through 9 of this document.
+
+      "Licensor" shall mean the copyright owner or entity authorized by
+      the copyright owner that is granting the License.
+
+      "Legal Entity" shall mean the union of the acting entity and all
+      other entities that control, are controlled by, or are under common
+      control with that entity. For the purposes of this definition,
+      "control" means (i) the power, direct or indirect, to cause the
+      direction or management of such entity, whether by contract or
+      otherwise, or (ii) ownership of fifty percent (50%) or more of the
+      outstanding shares, or (iii) beneficial ownership of such entity.
+
+      "You" (or "Your") shall mean an individual or Legal Entity
+      exercising permissions granted by this License.
+
+      "Source" form shall mean the preferred form for making modifications,
+      including but not limited to software source code, documentation
+      source, and configuration files.
+
+      "Object" form shall mean any form resulting from mechanical
+      transformation or translation of a Source form, including but
+      not limited to compiled object code, generated documentation,
+      and conversions to other media types.
+
+      "Work" shall mean the work of authorship, whether in Source or
+      Object form, made available under the License, as indicated by a
+      copyright notice that is included in or attached to the work
+      (an example is provided in the Appendix below).
+
+      "Derivative Works" shall mean any work, whether in Source or Object
+      form, that is based on (or derived from) the Work and for which the
+      editorial revisions, annotations, elaborations, or other modifications
+      represent, as a whole, an original work of authorship. For the purposes
+      of this License, Derivative Works shall not include works that remain
+      separable from, or merely link (or bind by name) to the interfaces of,
+      the Work and Derivative Works thereof.
+
+      "Contribution" shall mean any work of authorship, including
+      the original version of the Work and any modifications or additions
+      to that Work or Derivative Works thereof, that is intentionally
+      submitted to Licensor for inclusion in the Work by the copyright owner
+      or by an individual or Legal Entity authorized to submit on behalf of
+      the copyright owner. For the purposes of this definition, "submitted"
+      means any form of electronic, verbal, or written communication sent
+      to the Licensor or its representatives, including but not limited to
+      communication on electronic mailing lists, source code control systems,
+      and issue tracking systems that are managed by, or on behalf of, the
+      Licensor for the purpose of discussing and improving the Work, but
+      excluding communication that is conspicuously marked or otherwise
+      designated in writing by the copyright owner as "Not a Contribution."
+
+      "Contributor" shall mean Licensor and any individual or Legal Entity
+      on behalf of whom a Contribution has been received by Licensor and
+      subsequently incorporated within the Work.
+
+   2. Grant of Copyright License. Subject to the terms and conditions of
+      this License, each Contributor hereby grants to You a perpetual,
+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+      copyright license to reproduce, prepare Derivative Works of,
+      publicly display, publicly perform, sublicense, and distribute the
+      Work and such Derivative Works in Source or Object form.
+
+   3. Grant of Patent License. Subject to the terms and conditions of
+      this License, each Contributor hereby grants to You a perpetual,
+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+      (except as stated in this section) patent license to make, have made,
+      use, offer to sell, sell, import, and otherwise transfer the Work,
+      where such license applies only to those patent claims licensable
+      by such Contributor that are necessarily infringed by their
+      Contribution(s) alone or by combination of their Contribution(s)
+      with the Work to which such Contribution(s) was submitted. If You
+      institute patent litigation against any entity (including a
+      cross-claim or counterclaim in a lawsuit) alleging that the Work
+      or a Contribution incorporated within the Work constitutes direct
+      or contributory patent infringement, then any patent licenses
+      granted to You under this License for that Work shall terminate
+      as of the date such litigation is filed.
+
+   4. Redistribution. You may reproduce and distribute copies of the
+      Work or Derivative Works thereof in any medium, with or without
+      modifications, and in Source or Object form, provided that You
+      meet the following conditions:
+
+      (a) You must give any other recipients of the Work or
+          Derivative Works a copy of this License; and
+
+      (b) You must cause any modified files to carry prominent notices
+          stating that You changed the files; and
+
+      (c) You must retain, in the Source form of any Derivative Works
+          that You distribute, all copyright, patent, trademark, and
+          attribution notices from the Source form of the Work,
+          excluding those notices that do not pertain to any part of
+          the Derivative Works; and
+
+      (d) If the Work includes a "NOTICE" text file as part of its
+          distribution, then any Derivative Works that You distribute must
+          include a readable copy of the attribution notices contained
+          within such NOTICE file, excluding those notices that do not
+          pertain to any part of the Derivative Works, in at least one
+          of the following places: within a NOTICE text file distributed
+          as part of the Derivative Works; within the Source form or
+          documentation, if provided along with the Derivative Works; or,
+          within a display generated by the Derivative Works, if and
+          wherever such third-party notices normally appear. The contents
+          of the NOTICE file are for informational purposes only and
+          do not modify the License. You may add Your own attribution
+          notices within Derivative Works that You distribute, alongside
+          or as an addendum to the NOTICE text from the Work, provided
+          that such additional attribution notices cannot be construed
+          as modifying the License.
+
+      You may add Your own copyright statement to Your modifications and
+      may provide additional or different license terms and conditions
+      for use, reproduction, or distribution of Your modifications, or
+      for any such Derivative Works as a whole, provided Your use,
+      reproduction, and distribution of the Work otherwise complies with
+      the conditions stated in this License.
+
+   5. Submission of Contributions. Unless You explicitly state otherwise,
+      any Contribution intentionally submitted for inclusion in the Work
+      by You to the Licensor shall be under the terms and conditions of
+      this License, without any additional terms or conditions.
+      Notwithstanding the above, nothing herein shall supersede or modify
+      the terms of any separate license agreement you may have executed
+      with Licensor regarding such Contributions.
+
+   6. Trademarks. This License does not grant permission to use the trade
+      names, trademarks, service marks, or product names of the Licensor,
+      except as required for reasonable and customary use in describing the
+      origin of the Work and reproducing the content of the NOTICE file.
+
+   7. Disclaimer of Warranty. Unless required by applicable law or
+      agreed to in writing, Licensor provides the Work (and each
+      Contributor provides its Contributions) on an "AS IS" BASIS,
+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+      implied, including, without limitation, any warranties or conditions
+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
+      PARTICULAR PURPOSE. You are solely responsible for determining the
+      appropriateness of using or redistributing the Work and assume any
+      risks associated with Your exercise of permissions under this License.
+
+   8. Limitation of Liability. In no event and under no legal theory,
+      whether in tort (including negligence), contract, or otherwise,
+      unless required by applicable law (such as deliberate and grossly
+      negligent acts) or agreed to in writing, shall any Contributor be
+      liable to You for damages, including any direct, indirect, special,
+      incidental, or consequential damages of any character arising as a
+      result of this License or out of the use or inability to use the
+      Work (including but not limited to damages for loss of goodwill,
+      work stoppage, computer failure or malfunction, or any and all
+      other commercial damages or losses), even if such Contributor
+      has been advised of the possibility of such damages.
+
+   9. Accepting Warranty or Additional Liability. While redistributing
+      the Work or Derivative Works thereof, You may choose to offer,
+      and charge a fee for, acceptance of support, warranty, indemnity,
+      or other liability obligations and/or rights consistent with this
+      License. However, in accepting such obligations, You may act only
+      on Your own behalf and on Your sole responsibility, not on behalf
+      of any other Contributor, and only if You agree to indemnify,
+      defend, and hold each Contributor harmless for any liability
+      incurred by, or claims asserted against, such Contributor by reason
+      of your accepting any such warranty or additional liability.
+
+   END OF TERMS AND CONDITIONS
+
+   APPENDIX: How to apply the Apache License to your work.
+
+      To apply the Apache License to your work, attach the following
+      boilerplate notice, with the fields enclosed by brackets "{}"
+      replaced with your own identifying information. (Don't include
+      the brackets!)  The text should be enclosed in the appropriate
+      comment syntax for the file format. We also recommend that a
+      file or class name and description of purpose be included on the
+      same "printed page" as the copyright notice for easier
+      identification within third-party archives.
+
+   Copyright {yyyy} {name of copyright owner}
+
+   Licensed under the Apache License, Version 2.0 (the "License");
+   you may not use this file except in compliance with the License.
+   You may obtain a copy of the License at
+
+       http://www.apache.org/licenses/LICENSE-2.0
+
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS,
+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+   See the License for the specific language governing permissions and
+   limitations under the License.
+

From 5c3392130bec9f69891a9652693310c1aae2dd6a Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Tue, 10 Mar 2015 20:33:28 +0300
Subject: [PATCH 02/18] initial

set up

basic parser with colons

query string

fixed query strings

route, or

added class, children

almost done

moved Main.purs to test/Test/Main.purs

docs

readme

removed public
---
 .gitignore              |   9 +++
 .travis.yml             |  13 +++
 MODULES.md              | 175 ++++++++++++++++++++++++++++++++++++++++
 README.md               |  60 ++++++++++++++
 bower.json              |  34 ++++++++
 gulpfile.js             |   1 +
 package.json            |  27 +++++++
 src/Routing/Getter.purs | 123 ++++++++++++++++++++++++++++
 src/Routing/Parser.purs | 116 ++++++++++++++++++++++++++
 src/Routing/Setter.purs |  17 ++++
 test/Test/Main.purs     |  68 ++++++++++++++++
 11 files changed, 643 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 .travis.yml
 create mode 100644 MODULES.md
 create mode 100644 README.md
 create mode 100644 bower.json
 create mode 100644 gulpfile.js
 create mode 100644 package.json
 create mode 100644 src/Routing/Getter.purs
 create mode 100644 src/Routing/Parser.purs
 create mode 100644 src/Routing/Setter.purs
 create mode 100644 test/Test/Main.purs

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..4c4b4f5
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,9 @@
+/node_modules/
+/bower_components/
+/tmp/
+/dist/
+/output/
+/coverage/
+public/*.js
+.psci_modules
+.psci
\ No newline at end of file
diff --git a/.travis.yml b/.travis.yml
new file mode 100644
index 0000000..919962f
--- /dev/null
+++ b/.travis.yml
@@ -0,0 +1,13 @@
+language: node_js
+node_js:
+  - 0.10
+env:
+  - TAG=v0.6.8
+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
diff --git a/MODULES.md b/MODULES.md
new file mode 100644
index 0000000..3160a99
--- /dev/null
+++ b/MODULES.md
@@ -0,0 +1,175 @@
+# Module Documentation
+
+## Module Routing.Getter
+
+
+
+#### `Check`
+
+``` purescript
+type Check = Tuple String (M.StrMap String)
+```
+
+
+#### `Checks`
+
+``` purescript
+type Checks = Tuple Check [Check]
+```
+
+
+#### `PErr`
+
+``` purescript
+type PErr a = Either P.ParseError a
+```
+
+
+#### `Route`
+
+``` purescript
+newtype Route
+```
+
+
+#### `runRoute`
+
+``` purescript
+runRoute :: String -> Route -> PErr Checks
+```
+
+
+#### `route`
+
+``` purescript
+route :: String -> String -> PErr Route
+```
+
+
+#### `or`
+
+``` purescript
+or :: Route -> Route -> Route
+```
+
+
+#### `contains`
+
+``` purescript
+contains :: Route -> Route -> Route
+```
+
+
+#### `hashes`
+
+``` purescript
+hashes :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit
+```
+
+
+#### `RouteMsg`
+
+``` purescript
+class RouteMsg a where
+  toMsg :: Check -> Maybe a
+```
+
+
+#### `strMap`
+
+``` purescript
+instance strMap :: RouteMsg (Tuple String (M.StrMap String))
+```
+
+
+#### `checks`
+
+``` purescript
+checks :: forall e. Route -> (Checks -> Eff e Unit) -> Eff e Unit
+```
+
+
+#### `routes`
+
+``` purescript
+routes :: forall e a. (RouteMsg a) => Route -> (Tuple a [a] -> Eff e Unit) -> Eff e Unit
+```
+
+
+
+## Module Routing.Parser
+
+
+
+#### `TemplateEl`
+
+``` purescript
+data TemplateEl
+  = Placeholder String
+  | Key String
+  | Ask [String]
+```
+
+Ast of parsed route template
+
+#### `Template`
+
+``` purescript
+type Template = [TemplateEl]
+```
+
+shortcut
+
+#### `StateObj`
+
+``` purescript
+type StateObj = State (M.StrMap String)
+```
+
+shortcut 
+
+#### `template`
+
+``` purescript
+template :: forall m. (Monad m) => P.ParserT String m Template
+```
+
+parses all template elements
+
+#### `parse`
+
+``` purescript
+parse :: Template -> P.ParserT String StateObj Unit
+```
+
+Produce parsers of uri from template strings
+
+
+## Module Routing.Setter
+
+
+
+#### `setHash`
+
+``` purescript
+setHash :: forall e. String -> Eff e Unit
+```
+
+
+#### `RouteState`
+
+``` purescript
+class RouteState a where
+  toHash :: a -> String
+```
+
+
+#### `setRouteState`
+
+``` purescript
+setRouteState :: forall r e. (RouteState r) => r -> Eff e Unit
+```
+
+
+
+
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..b46330f
--- /dev/null
+++ b/README.md
@@ -0,0 +1,60 @@
+# purescript-routing
+
+[![Build Status](https://travis-ci.org/cryogenian/purescript-routing.svg?branch=master)](https://travis-ci.org/cryogenian/purescript-routing)
+
+Library to handle hash routing for purescript
+
+define route:
+
+```purescript
+routing :: PErr Route
+routing = do
+  notebook <- route "notebook" "notebook?foo&bar"
+  file <- route "file" "file/:id"
+  read <- route "read" "/read"
+  write <- route "write" "/write"
+  pure $ notebook `or` (file `contains` (read `or` write))
+  ```
+  
+It will match
+* `notebook?foo=12&bar=23` and `notebook?bar=12&foo=123`
+* `file/123` 
+* `file/123/write` 
+* `file/123/read` 
+
+When hash changes from something to `file/123/read` messages of `file` routing
+and `read` will be produced. When hash changes from `file/123` to `file/123/read` 
+only one message will be produced. 
+
+To get this messages it's necessary to define instance of `RouteMsg` i.e.
+```purescript
+instance tstRouteMsg :: RouteMsg Test where
+  toMsg (Tuple "write" _) = Just Write
+  toMsg (Tuple "read" _) = Just Read
+  toMsg (Tuple "file" map) = do
+    f <- lookup "id" map
+    pure $ File f 
+  toMsg (Tuple "notebook" map) = do
+    foo <- readFloat <$> lookup "foo" map
+    bar <- readFloat <$> lookup "bar" map
+    if isNaN foo || isNaN bar then
+      Nothing
+      else
+      pure $ Notebook foo bar
+  toMsg _  = Nothing
+```
+
+then you can to use it with something like that 
+```purescript
+main = do
+  let fp :: Tuple Test [Test] -> Eff _ Unit
+      fp t = void $ fprint t
+  case routing of
+    Right r -> do
+      routes r $ \r -> void do
+        fp r
+    _ -> pure unit
+```
+
+If you have a state of application you can define instance of `RouteState` then 
+you can use `setRouteState` to update hash. 
diff --git a/bower.json b/bower.json
new file mode 100644
index 0000000..644d329
--- /dev/null
+++ b/bower.json
@@ -0,0 +1,34 @@
+{
+  "name": "purescript-routing",
+  "version": "0.1.0",
+  "homepage": "https://github.com/slamdata/purescript-routing",
+  "authors": [
+    "Maxim Zimaliev <zimaliev@yandex.ru>"
+  ],
+  "description": "purescript library for routing",
+  "keywords": [
+    "purescript",
+    "routing"
+  ],
+  "license": "Apache 2.0",
+  "ignore": [
+    "**/.*",
+    "node_modules",
+    "bower_components",
+    "test",
+    "tests"
+  ],
+  "dependencies": {
+    "purescript-strings": "~0.4.3",
+    "purescript-parsing": "~0.3.1",
+    "purescript-maps": "~0.3.2",
+    "purescript-debug-foreign": "~0.0.4",
+    "purescript-control": "~0.2.2",
+    "purescript-transformers": "~0.5.1",
+    "purescript-arrays": "~0.3.3",
+    "purescript-globals": "~0.1.5"
+  },
+  "devDependencies": {
+    "purescript-timers": "~0.0.8"
+  }
+}
diff --git a/gulpfile.js b/gulpfile.js
new file mode 100644
index 0000000..f8dbeba
--- /dev/null
+++ b/gulpfile.js
@@ -0,0 +1 @@
+require("mandragora-bucket").define();
diff --git a/package.json b/package.json
new file mode 100644
index 0000000..c70a23f
--- /dev/null
+++ b/package.json
@@ -0,0 +1,27 @@
+{
+  "name": "purescript-routing",
+  "version": "0.1.0",
+  "description": "Routing lib for purescript",
+  "main": "index.js",
+  "scripts": {
+    "test": "echo \"Error: no test specified\" && exit 1"
+  },
+  "repository": {
+    "type": "git",
+    "url": "https://github.com/slamdata/purescripot-routing.git"
+  },
+  "keywords": [
+    "purescript",
+    "routing"
+  ],
+  "author": "Maxim Zimaliev <zimaliev@gmail.com>",
+  "license": "Apache 2.0",
+  "bugs": {
+    "url": "https://github.com/slamdata/purescripot-routing/issues"
+  },
+  "homepage": "https://github.com/slamdata/purescripot-routing",
+  "dependencies": {
+    "gulp": "^3.8.11",
+    "mandragora-bucket": "^0.1.12"
+  }
+}
diff --git a/src/Routing/Getter.purs b/src/Routing/Getter.purs
new file mode 100644
index 0000000..599ab25
--- /dev/null
+++ b/src/Routing/Getter.purs
@@ -0,0 +1,123 @@
+module Routing.Getter (
+  route,
+  or,
+  contains,
+  runRoute,
+  hashes,
+  checks,
+  routes,
+  PErr(),
+  Route(),
+  RouteMsg,
+  toMsg,
+  Check(),
+  Checks()
+  ) where
+
+import Data.Either
+import Data.Maybe
+import Data.Tuple
+import Control.Monad.Eff
+import Control.Monad.State
+import Control.Monad.Trans
+import Control.Monad.State.Class
+import Control.Monad.Error
+import Control.Apply ((*>))
+import Control.Alt ((<|>))
+import Data.String.Regex (replace, noFlags, Regex(), regex)
+import Data.Array (findIndex, drop, take)
+import Data.Traversable (traverse)
+
+import qualified Data.StrMap as M
+import qualified Text.Parsing.Parser as P
+import qualified Text.Parsing.Parser.Combinators as P
+
+import Routing.Parser (parse, template, StateObj())
+
+type RouteParser = P.ParserT String StateObj Checks
+type Check = Tuple String (M.StrMap String)
+type Checks = Tuple Check [Check]
+type PErr a = Either P.ParseError a 
+newtype Route = Route RouteParser
+
+runRoute :: String -> Route -> PErr Checks
+runRoute s (Route p) =
+  case runState (P.runParserT s p) M.empty of
+    Tuple lr state -> lr
+
+             
+route :: String -> String -> PErr Route
+route name templateStr = do
+  parser <- parse <$> P.runParser templateStr template
+  let p = parser *> lift get >>= \res ->
+        pure $ Tuple (Tuple name res) []
+  pure $ Route p
+
+or :: Route -> Route -> Route
+or (Route one) (Route two) =
+  Route $ one <|> two
+
+contains :: Route -> Route -> Route
+contains (Route parent) (Route child) =
+  let put' :: M.StrMap String -> StateObj Unit
+      put' = put 
+  in Route $ do
+    Tuple pHead parentChecks <- parent
+    lift $ put' M.empty
+    c <- P.optionMaybe child
+    pure $ case c of
+      Nothing -> Tuple pHead parentChecks
+      Just (Tuple cHead []) -> Tuple cHead (pHead:parentChecks)
+
+
+foreign import hashChanged """
+function hashChanged(handler) {
+  return function() {
+    var currentHash = document.location.hash;
+    handler("")(currentHash)();
+    window.addEventListener("hashchange", function(ev) {
+      handler(ev.oldURL)(ev.newURL)();
+    });
+  };
+}
+""" :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit
+
+rgx :: Regex
+rgx = regex "^[^#]+#" noFlags 
+
+hashes :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit
+hashes cb =
+  hashChanged $ \old new -> do
+    cb (replace rgx "" old) (replace rgx "" new)
+
+class RouteMsg a where 
+  toMsg :: Check -> Maybe a
+
+instance strMap :: RouteMsg (Tuple String (M.StrMap String)) where
+  toMsg = Just
+
+checks :: forall e. Route -> (Checks -> Eff e Unit) -> Eff e Unit
+checks route callback =  
+  hashes $ \old new -> do
+    let diff = do
+          Tuple headOld olds <- runRoute old route
+          Tuple headNew news <- runRoute new route
+          case findIndex ((==) headOld) news of
+            -1 -> pure $ Tuple headNew news
+            i -> if drop i news == (headOld:olds) then
+                   pure $ Tuple headNew (take i news)
+                   else
+                   pure $ Tuple headNew news 
+    case diff of
+      Right checks -> callback checks
+      _ -> pure unit
+
+routes :: forall e a. (RouteMsg a) =>
+          Route -> (Tuple a [a] -> Eff e Unit) -> Eff e Unit
+routes route callback =
+  checks route $ \(Tuple check checks) -> 
+    maybe (pure unit) callback do
+          r <- toMsg check
+          rs <- traverse toMsg checks
+          pure $ Tuple r rs
+
diff --git a/src/Routing/Parser.purs b/src/Routing/Parser.purs
new file mode 100644
index 0000000..03c75af
--- /dev/null
+++ b/src/Routing/Parser.purs
@@ -0,0 +1,116 @@
+module Routing.Parser (
+  parse,
+  template,
+  StateObj(),
+  TemplateEl(..),
+  Template()
+  ) where
+
+import Data.Maybe
+import Data.Either
+
+import Control.Alternative (many)
+import Control.Alt ((<|>))
+import Data.Foldable (fold, foldl, sequence_, traverse_)
+import Data.Traversable (sequence, traverse)
+import Control.Monad.State 
+import Control.Monad.Trans
+import Control.Monad.State.Class
+
+import qualified Text.Parsing.Parser as P
+import qualified Text.Parsing.Parser.Combinators as P
+import qualified Text.Parsing.Parser.String as P
+import qualified Data.StrMap as M
+
+
+-- | Ast of parsed route template
+data TemplateEl = Placeholder String | Key String | Ask [String]
+-- | shortcut
+type Template = [TemplateEl]
+-- | shortcut 
+type StateObj = State (M.StrMap String)
+
+-- | Parses placeholder names
+name :: forall m. (Monad m) => P.ParserT String m String
+name = do
+  strs <- many $ P.noneOf [":", "&", "?"]
+  case strs of
+    [] -> P.fail "empty name"
+    cs -> return (fold cs)
+    
+-- | parses variables 
+variable :: forall m. (Monad m) => P.ParserT String m String
+variable = do
+  strs <- many $ P.noneOf [":", "&", "/", "?", "="]
+  case strs of
+    [] -> P.fail "empty var"
+    cs -> return (fold cs)
+    
+-- | parses placeholder
+placeholder :: forall m. (Monad m) => P.ParserT String m TemplateEl
+placeholder =  Placeholder <$> name 
+
+-- | parses variables in `:foo`
+colon :: forall m. (Monad m) => P.ParserT String m TemplateEl
+colon = do
+  P.string ":"
+  Key <$> variable
+
+-- | parses variables in `?foo&bar&baz`
+query :: forall m. (Monad m) => P.ParserT String m TemplateEl
+query = do
+  strs <- many $ do
+    P.string "&" <|> P.string "?"
+    variable
+  case strs of
+    [] -> P.fail "not an query string"
+    qs -> pure $ Ask qs
+
+-- | parses all template elements
+template :: forall m. (Monad m) => P.ParserT String m Template
+template = many $ P.choice [
+  P.try placeholder,
+  P.try query,
+  P.try colon]
+
+
+-- | Produce parsers of uri from template strings
+parse :: Template -> P.ParserT String StateObj Unit
+parse template =
+  -- type hints
+  let get' :: String -> StateObj (Maybe String)
+      get' str = gets (M.lookup str)
+      get'' :: StateObj (M.StrMap String)
+      get'' = get
+      
+    in case template of
+    [] -> pure unit
+    
+    (Key str):ts -> do
+      g <- lift $ get' str
+      v <- variable
+      case g of
+        Nothing -> do
+          lift $ modify (M.insert str v)
+          parse ts
+        _ -> P.fail $ "duplicated key '" <> str <> "' is unmatching"
+        
+    (Ask strs):ts -> do
+      P.string "?"
+      res <- many $ do
+        (P.try $ P.string "&") <|> pure ""
+        s <- P.choice $ P.try <<< P.string <$> strs
+        P.string "="
+        v <- variable
+        g <- lift $ get' s
+        lift $ modify (M.insert s v)
+        case g of
+          Nothing -> 
+            pure v
+          _ -> 
+            P.fail "query contains duplicated keys"
+      parse ts
+      
+    (Placeholder str):ts -> do
+      P.string str
+      parse ts
diff --git a/src/Routing/Setter.purs b/src/Routing/Setter.purs
new file mode 100644
index 0000000..2dc8e52
--- /dev/null
+++ b/src/Routing/Setter.purs
@@ -0,0 +1,17 @@
+module Routing.Setter where
+
+import Control.Monad.Eff
+
+foreign import setHash """
+function setHash(hash) {
+  return function() {
+    document.location.hash = hash;
+  };
+}
+""" :: forall e. String -> Eff e Unit
+
+class RouteState a where
+  toHash :: a -> String
+
+setRouteState :: forall r e. (RouteState r) => r -> Eff e Unit
+setRouteState r = setHash $ toHash r
diff --git a/test/Test/Main.purs b/test/Test/Main.purs
new file mode 100644
index 0000000..20cc177
--- /dev/null
+++ b/test/Test/Main.purs
@@ -0,0 +1,68 @@
+module Test.Main where
+
+import Control.Monad.Eff
+import Data.Tuple
+import Data.Array
+import Data.Either
+import Data.Maybe
+import Data.StrMap (lookup)
+import Global
+
+import Debug.Trace
+import Debug.Foreign
+
+import Routing.Setter
+import Routing.Getter
+
+routing :: PErr Route
+routing = do
+  one <- route "notebook" "notebook?foo&bar"
+  two <- route "file" "file/:id"
+  three <- route "read" "/read"
+  four <- route "write" "/write"
+  pure $ one `or` (two `contains` (three `or` four))
+  
+data Test =
+  Notebook Number Number 
+  | File String
+  | Write
+  | Read
+
+data TestState
+  = NotebookState Number Number
+  | FileState String Boolean
+
+instance tstStTestState :: RouteState TestState where
+  toHash (NotebookState foo bar) = "notebook?foo=" <> show foo <>
+                                   "&bar=" <> show bar
+  toHash (FileState id read) = "file/" <> id <> if read then "read" else "write"
+
+instance tstRouteMsg :: RouteMsg Test where
+  toMsg (Tuple "write" _) = Just Write
+  toMsg (Tuple "read" _) = Just Read
+  toMsg (Tuple "file" map) = do
+    f <- lookup "id" map
+    pure $ File f 
+  toMsg (Tuple "notebook" map) = do
+    foo <- readFloat <$> lookup "foo" map
+    bar <- readFloat <$> lookup "bar" map
+    if isNaN foo || isNaN bar then
+      Nothing
+      else
+      pure $ Notebook foo bar
+  toMsg _  = Nothing
+
+
+main = do
+  fprint $ do
+    r <- routing
+    runRoute "notebook?foo=1&bar=2" r
+  let fp :: Tuple Test [Test] -> Eff _ Unit
+      fp t = void $ fprint t
+  case routing of
+    Right r -> do
+      routes r $ \r -> void do
+        fp r
+        setRouteState $ NotebookState 123 234
+    _ -> pure unit
+                      

From 56274e2962af53cb280fc9d05e7d07f5c26823a9 Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Wed, 18 Mar 2015 18:29:29 +0300
Subject: [PATCH 03/18] comments of pr

---
 README.md               |  14 ++---
 bower.json              |   3 +-
 package.json            |  47 +++++++-------
 src/Routing/Getter.purs | 136 +++++++++++++++++++++++++---------------
 src/Routing/Parser.purs |  37 +++++++----
 src/Routing/Setter.purs |   3 +
 test/Test/Main.purs     |  16 ++---
 7 files changed, 152 insertions(+), 104 deletions(-)

diff --git a/README.md b/README.md
index b46330f..0f6d3c5 100644
--- a/README.md
+++ b/README.md
@@ -26,22 +26,22 @@ When hash changes from something to `file/123/read` messages of `file` routing
 and `read` will be produced. When hash changes from `file/123` to `file/123/read` 
 only one message will be produced. 
 
-To get this messages it's necessary to define instance of `RouteMsg` i.e.
+To get this messages it's necessary to define instance of `RouteDiff` i.e.
 ```purescript
-instance tstRouteMsg :: RouteMsg Test where
-  toMsg (Tuple "write" _) = Just Write
-  toMsg (Tuple "read" _) = Just Read
-  toMsg (Tuple "file" map) = do
+instance tstRouteDiff :: RouteDiff Test where
+  fromMatch (Tuple "write" _) = Just Write
+  fromMatch (Tuple "read" _) = Just Read
+  fromMatch (Tuple "file" map) = do
     f <- lookup "id" map
     pure $ File f 
-  toMsg (Tuple "notebook" map) = do
+  fromMatch (Tuple "notebook" map) = do
     foo <- readFloat <$> lookup "foo" map
     bar <- readFloat <$> lookup "bar" map
     if isNaN foo || isNaN bar then
       Nothing
       else
       pure $ Notebook foo bar
-  toMsg _  = Nothing
+  fromMatch _  = Nothing
 ```
 
 then you can to use it with something like that 
diff --git a/bower.json b/bower.json
index 644d329..e19ae59 100644
--- a/bower.json
+++ b/bower.json
@@ -26,7 +26,8 @@
     "purescript-control": "~0.2.2",
     "purescript-transformers": "~0.5.1",
     "purescript-arrays": "~0.3.3",
-    "purescript-globals": "~0.1.5"
+    "purescript-globals": "~0.1.5",
+    "purescript-monoid": "~0.2.0"
   },
   "devDependencies": {
     "purescript-timers": "~0.0.8"
diff --git a/package.json b/package.json
index c70a23f..832960d 100644
--- a/package.json
+++ b/package.json
@@ -1,27 +1,24 @@
 {
-  "name": "purescript-routing",
-  "version": "0.1.0",
-  "description": "Routing lib for purescript",
-  "main": "index.js",
-  "scripts": {
-    "test": "echo \"Error: no test specified\" && exit 1"
-  },
-  "repository": {
-    "type": "git",
-    "url": "https://github.com/slamdata/purescripot-routing.git"
-  },
-  "keywords": [
-    "purescript",
-    "routing"
-  ],
-  "author": "Maxim Zimaliev <zimaliev@gmail.com>",
-  "license": "Apache 2.0",
-  "bugs": {
-    "url": "https://github.com/slamdata/purescripot-routing/issues"
-  },
-  "homepage": "https://github.com/slamdata/purescripot-routing",
-  "dependencies": {
-    "gulp": "^3.8.11",
-    "mandragora-bucket": "^0.1.12"
-  }
+    "name": "purescript-routing",
+    "version": "0.1.0",
+    "description": "Routing lib for purescript",
+    "private": true,
+    "repository": {
+        "type": "git",
+        "url": "https://github.com/slamdata/purescript-routing.git"
+    },
+    "keywords": [
+        "purescript",
+        "routing"
+    ],
+    "author": "Maxim Zimaliev <zimaliev@gmail.com>",
+    "license": "Apache 2.0",
+    "bugs": {
+        "url": "https://github.com/slamdata/purescript-routing/issues"
+    },
+    "homepage": "https://github.com/slamdata/purescript-routing",
+    "dependencies": {
+        "gulp": "^3.8.11",
+        "mandragora-bucket": "^0.1.12"
+    }
 }
diff --git a/src/Routing/Getter.purs b/src/Routing/Getter.purs
index 599ab25..f2ae4ce 100644
--- a/src/Routing/Getter.purs
+++ b/src/Routing/Getter.purs
@@ -1,17 +1,20 @@
+-- | Getting `hashchange` events and wraps 
+-- | `oldURL` and `newURL` to RouteMatch
+-- | or RouteDiff instances 
 module Routing.Getter (
   route,
   or,
   contains,
-  runRoute,
+  runRouter,
   hashes,
-  checks,
+  matches,
   routes,
   PErr(),
-  Route(),
-  RouteMsg,
-  toMsg,
-  Check(),
-  Checks()
+  Router(),
+  RouteDiff,
+  fromMatch,
+  RouteMatch(),
+  RouteMatches()
   ) where
 
 import Data.Either
@@ -22,6 +25,7 @@ import Control.Monad.State
 import Control.Monad.Trans
 import Control.Monad.State.Class
 import Control.Monad.Error
+import Data.Monoid
 import Control.Apply ((*>))
 import Control.Alt ((<|>))
 import Data.String.Regex (replace, noFlags, Regex(), regex)
@@ -34,42 +38,55 @@ import qualified Text.Parsing.Parser.Combinators as P
 
 import Routing.Parser (parse, template, StateObj())
 
-type RouteParser = P.ParserT String StateObj Checks
-type Check = Tuple String (M.StrMap String)
-type Checks = Tuple Check [Check]
-type PErr a = Either P.ParseError a 
-newtype Route = Route RouteParser
-
-runRoute :: String -> Route -> PErr Checks
-runRoute s (Route p) =
-  case runState (P.runParserT s p) M.empty of
-    Tuple lr state -> lr
-
-             
-route :: String -> String -> PErr Route
+-- | Shortcut for parser
+type RouteParser = P.ParserT String StateObj RouteMatches
+-- | Main data produced by matching hash
+-- | Tuple routeName mappedTemplateArgumentsValues
+type RouteMatch = Tuple String (M.StrMap String)
+-- | nonempty list of matches
+type RouteMatches = Tuple RouteMatch [RouteMatch]
+-- | Shortcut for parsing errors
+type PErr a = Either P.ParseError a
+-- | 
+newtype Router = Router RouteParser
+
+-- | check if `s` matches router
+runRouter :: String -> Router -> PErr RouteMatches
+runRouter s (Router p) =
+  evalState (P.runParserT s p) M.empty 
+
+-- | define router by name and template
+route :: String -> String -> PErr Router
 route name templateStr = do
   parser <- parse <$> P.runParser templateStr template
   let p = parser *> lift get >>= \res ->
         pure $ Tuple (Tuple name res) []
-  pure $ Route p
-
-or :: Route -> Route -> Route
-or (Route one) (Route two) =
-  Route $ one <|> two
-
-contains :: Route -> Route -> Route
-contains (Route parent) (Route child) =
+  pure $ Router p
+  
+-- | construct router from two routers
+-- | will match first **or** second
+or :: Router -> Router -> Router
+or (Router one) (Router two) =
+  Router $ one <|> two
+
+-- | construct router from two routers
+-- | will try to match first router and
+-- | if it matches try to match second
+-- | produced result of matching first if
+-- | second fails or aggregated result otherwise
+contains :: Router -> Router -> Router
+contains (Router parent) (Router child) =
   let put' :: M.StrMap String -> StateObj Unit
       put' = put 
-  in Route $ do
-    Tuple pHead parentChecks <- parent
+  in Router $ do
+    Tuple pHead pTail <- parent
     lift $ put' M.empty
     c <- P.optionMaybe child
     pure $ case c of
-      Nothing -> Tuple pHead parentChecks
-      Just (Tuple cHead []) -> Tuple cHead (pHead:parentChecks)
-
+      Nothing -> Tuple pHead pTail
+      Just (Tuple cHead []) -> Tuple cHead (pHead:pTail)
 
+-- | Main driver of routing 
 foreign import hashChanged """
 function hashChanged(handler) {
   return function() {
@@ -82,42 +99,59 @@ function hashChanged(handler) {
 }
 """ :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit
 
-rgx :: Regex
-rgx = regex "^[^#]+#" noFlags 
-
+-- | stream of hashes without hash symbol
 hashes :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit
 hashes cb =
   hashChanged $ \old new -> do
-    cb (replace rgx "" old) (replace rgx "" new)
+    cb (dropHash old) (dropHash new)
+  where dropHash h = replace (regex "^[^#]+#" noFlags) "" h
 
-class RouteMsg a where 
-  toMsg :: Check -> Maybe a
+-- | Class of types that can be produced by matching
+-- | diffs of hashes
+class RouteDiff a where 
+  fromMatch :: RouteMatch -> Maybe a
 
-instance strMap :: RouteMsg (Tuple String (M.StrMap String)) where
-  toMsg = Just
+-- | Tuple name argValMap is just RouteMatch
+instance strMap :: RouteDiff (Tuple String (M.StrMap String)) where
+  fromMatch = Just
 
-checks :: forall e. Route -> (Checks -> Eff e Unit) -> Eff e Unit
-checks route callback =  
+-- | Stream of `RouteMatch`es 
+matches :: forall e. Router -> (RouteMatches -> Eff e Unit) -> Eff e Unit
+matches route callback =  
   hashes $ \old new -> do
     let diff = do
-          Tuple headOld olds <- runRoute old route
-          Tuple headNew news <- runRoute new route
+          -- Get old url matches 
+          Tuple headOld olds <- runRouter old route
+          -- Get new url matches
+          Tuple headNew news <- runRouter new route
+          -- if new url is substate of old url
           case findIndex ((==) headOld) news of
             -1 -> pure $ Tuple headNew news
+            -- find depth of substate and return only new part 
             i -> if drop i news == (headOld:olds) then
                    pure $ Tuple headNew (take i news)
                    else
                    pure $ Tuple headNew news 
     case diff of
-      Right checks -> callback checks
+      -- If router matches hash then callback
+      Right matches -> callback matches
+      -- Otherwise do nothing
       _ -> pure unit
 
-routes :: forall e a. (RouteMsg a) =>
-          Route -> (Tuple a [a] -> Eff e Unit) -> Eff e Unit
+-- Stream of decoded messages. i.e. in case of
+-- purescript-halogen `i` from `HTML a i`
+routes :: forall e a. (RouteDiff a) =>
+          Router -> (Tuple a [a] -> Eff e Unit) -> Eff e Unit
 routes route callback =
-  checks route $ \(Tuple check checks) -> 
+  matches route $ \(Tuple match matches) -> 
     maybe (pure unit) callback do
-          r <- toMsg check
-          rs <- traverse toMsg checks
+          r <- fromMatch match
+          rs <- traverse fromMatch matches
           pure $ Tuple r rs
 
+-- | Router is semigroup over `or`
+instance semigroupRouter :: Semigroup Router where
+  (<>) = or
+-- | Router is monoid with always failing router as `mempty`
+instance monoidRouter :: Monoid Router where
+  mempty = Router $ P.fail "mempty"
diff --git a/src/Routing/Parser.purs b/src/Routing/Parser.purs
index 03c75af..1b9d201 100644
--- a/src/Routing/Parser.purs
+++ b/src/Routing/Parser.purs
@@ -24,19 +24,22 @@ import qualified Data.StrMap as M
 
 
 -- | Ast of parsed route template
-data TemplateEl = Placeholder String | Key String | Ask [String]
+data TemplateEl = Placeholder String | Variable String | Query [String]
 -- | shortcut
 type Template = [TemplateEl]
 -- | shortcut 
 type StateObj = State (M.StrMap String)
 
+
+foreign import decodeURIComponent :: String -> String
+
 -- | Parses placeholder names
 name :: forall m. (Monad m) => P.ParserT String m String
 name = do
   strs <- many $ P.noneOf [":", "&", "?"]
   case strs of
     [] -> P.fail "empty name"
-    cs -> return (fold cs)
+    cs -> return $ decodeURIComponent (fold cs)
     
 -- | parses variables 
 variable :: forall m. (Monad m) => P.ParserT String m String
@@ -44,7 +47,7 @@ variable = do
   strs <- many $ P.noneOf [":", "&", "/", "?", "="]
   case strs of
     [] -> P.fail "empty var"
-    cs -> return (fold cs)
+    cs -> return $ decodeURIComponent (fold cs)
     
 -- | parses placeholder
 placeholder :: forall m. (Monad m) => P.ParserT String m TemplateEl
@@ -54,7 +57,7 @@ placeholder =  Placeholder <$> name
 colon :: forall m. (Monad m) => P.ParserT String m TemplateEl
 colon = do
   P.string ":"
-  Key <$> variable
+  Variable <$> variable
 
 -- | parses variables in `?foo&bar&baz`
 query :: forall m. (Monad m) => P.ParserT String m TemplateEl
@@ -64,7 +67,7 @@ query = do
     variable
   case strs of
     [] -> P.fail "not an query string"
-    qs -> pure $ Ask qs
+    qs -> pure $ Query qs
 
 -- | parses all template elements
 template :: forall m. (Monad m) => P.ParserT String m Template
@@ -84,33 +87,43 @@ parse template =
       get'' = get
       
     in case template of
+    -- ast is over 
     [] -> pure unit
-    
-    (Key str):ts -> do
+    (Variable str):ts -> do
+      -- lookup this variable setted in state
+      -- fail if it has been setted
       g <- lift $ get' str
       v <- variable
       case g of
         Nothing -> do
+          -- insert key val pair to state
           lift $ modify (M.insert str v)
           parse ts
-        _ -> P.fail $ "duplicated key '" <> str <> "' is unmatching"
+        _ -> P.fail $ "Parsing route template error: duplicated key " <>
+             show str 
         
-    (Ask strs):ts -> do
+    (Query strs):ts -> do
       P.string "?"
       res <- many $ do
+        -- consume "&" or nothing
         (P.try $ P.string "&") <|> pure ""
+        -- find one of template args 
         s <- P.choice $ P.try <<< P.string <$> strs
         P.string "="
+        -- check if this variable was setted before
         v <- variable
         g <- lift $ get' s
-        lift $ modify (M.insert s v)
         case g of
-          Nothing -> 
+          Nothing -> do
+            lift $ modify (M.insert s v)
             pure v
           _ -> 
-            P.fail "query contains duplicated keys"
+            P.fail $ "Parsing route template error: duplicated key" <>
+            show v <> " in query: " <> show strs 
+            
       parse ts
       
     (Placeholder str):ts -> do
+      -- consume placeholder
       P.string str
       parse ts
diff --git a/src/Routing/Setter.purs b/src/Routing/Setter.purs
index 2dc8e52..f9c109c 100644
--- a/src/Routing/Setter.purs
+++ b/src/Routing/Setter.purs
@@ -10,8 +10,11 @@ function setHash(hash) {
 }
 """ :: forall e. String -> Eff e Unit
 
+
+-- | Class of types that can be converted to hashes 
 class RouteState a where
   toHash :: a -> String
 
+-- | wrapper over `setHash` that uses `RouteState`
 setRouteState :: forall r e. (RouteState r) => r -> Eff e Unit
 setRouteState r = setHash $ toHash r
diff --git a/test/Test/Main.purs b/test/Test/Main.purs
index 20cc177..538a81a 100644
--- a/test/Test/Main.purs
+++ b/test/Test/Main.purs
@@ -14,7 +14,7 @@ import Debug.Foreign
 import Routing.Setter
 import Routing.Getter
 
-routing :: PErr Route
+routing :: PErr Router
 routing = do
   one <- route "notebook" "notebook?foo&bar"
   two <- route "file" "file/:id"
@@ -37,26 +37,26 @@ instance tstStTestState :: RouteState TestState where
                                    "&bar=" <> show bar
   toHash (FileState id read) = "file/" <> id <> if read then "read" else "write"
 
-instance tstRouteMsg :: RouteMsg Test where
-  toMsg (Tuple "write" _) = Just Write
-  toMsg (Tuple "read" _) = Just Read
-  toMsg (Tuple "file" map) = do
+instance tstRouteDiff :: RouteDiff Test where
+  fromMatch (Tuple "write" _) = Just Write
+  fromMatch (Tuple "read" _) = Just Read
+  fromMatch (Tuple "file" map) = do
     f <- lookup "id" map
     pure $ File f 
-  toMsg (Tuple "notebook" map) = do
+  fromMatch (Tuple "notebook" map) = do
     foo <- readFloat <$> lookup "foo" map
     bar <- readFloat <$> lookup "bar" map
     if isNaN foo || isNaN bar then
       Nothing
       else
       pure $ Notebook foo bar
-  toMsg _  = Nothing
+  fromMatch _  = Nothing
 
 
 main = do
   fprint $ do
     r <- routing
-    runRoute "notebook?foo=1&bar=2" r
+    runRouter "notebook?foo=1&bar=2" r
   let fp :: Tuple Test [Test] -> Eff _ Unit
       fp t = void $ fprint t
   case routing of

From 69277b45fba025830ad25cf9715f6db6f2e7c290 Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Wed, 18 Mar 2015 19:48:30 +0300
Subject: [PATCH 04/18] semiring

---
 src/Routing/Getter.purs | 21 +++++++++++++++++++--
 1 file changed, 19 insertions(+), 2 deletions(-)

diff --git a/src/Routing/Getter.purs b/src/Routing/Getter.purs
index f2ae4ce..851422d 100644
--- a/src/Routing/Getter.purs
+++ b/src/Routing/Getter.purs
@@ -83,8 +83,12 @@ contains (Router parent) (Router child) =
     lift $ put' M.empty
     c <- P.optionMaybe child
     pure $ case c of
-      Nothing -> Tuple pHead pTail
-      Just (Tuple cHead []) -> Tuple cHead (pHead:pTail)
+      -- when name == "" we don't include match results for
+      -- this router since it's one router
+      Just (Tuple cHead@(Tuple name params) []) | name /= "" ->
+        Tuple cHead (pHead:pTail)
+      _ -> Tuple pHead pTail
+
 
 -- | Main driver of routing 
 foreign import hashChanged """
@@ -149,9 +153,22 @@ routes route callback =
           rs <- traverse fromMatch matches
           pure $ Tuple r rs
 
+zeroR :: Router
+zeroR = Router $ P.fail "zero router always fails"
+
+oneR :: Router
+oneR = Router $ pure $ Tuple (Tuple "" M.empty) []
+
 -- | Router is semigroup over `or`
 instance semigroupRouter :: Semigroup Router where
   (<>) = or
 -- | Router is monoid with always failing router as `mempty`
 instance monoidRouter :: Monoid Router where
   mempty = Router $ P.fail "mempty"
+
+
+instance semiringRouter :: Semiring Router where
+  (+) = or
+  (*) = contains
+  zero = zeroR
+  one = oneR

From 88ab8dfafb82e4157fecedf22feea07b20c4ea88 Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Wed, 18 Mar 2015 23:16:26 +0300
Subject: [PATCH 05/18] removed version from bower.json

---
 bower.json | 1 -
 1 file changed, 1 deletion(-)

diff --git a/bower.json b/bower.json
index e19ae59..cf4fd99 100644
--- a/bower.json
+++ b/bower.json
@@ -1,6 +1,5 @@
 {
   "name": "purescript-routing",
-  "version": "0.1.0",
   "homepage": "https://github.com/slamdata/purescript-routing",
   "authors": [
     "Maxim Zimaliev <zimaliev@yandex.ru>"

From b1545b059de369066d037dbc7c835335d898ae2a Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Wed, 18 Mar 2015 23:17:54 +0300
Subject: [PATCH 06/18] removed version from package.json

---
 package.json | 1 -
 1 file changed, 1 deletion(-)

diff --git a/package.json b/package.json
index 832960d..4c6a38b 100644
--- a/package.json
+++ b/package.json
@@ -1,6 +1,5 @@
 {
     "name": "purescript-routing",
-    "version": "0.1.0",
     "description": "Routing lib for purescript",
     "private": true,
     "repository": {

From 822b84fe375f867786c855f737a250e4c50626e8 Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Fri, 20 Mar 2015 04:29:41 +0300
Subject: [PATCH 07/18] matches

---
 public/index.html   |   1 +
 test/Main.purs      | 165 ++++++++++++++++++++++++++++++++++++++++++++
 test/Test/Main.purs |   2 +-
 3 files changed, 167 insertions(+), 1 deletion(-)
 create mode 100644 public/index.html
 create mode 100644 test/Main.purs

diff --git a/public/index.html b/public/index.html
new file mode 100644
index 0000000..b63a548
--- /dev/null
+++ b/public/index.html
@@ -0,0 +1 @@
+<script src="./concated.js"></script>
diff --git a/test/Main.purs b/test/Main.purs
new file mode 100644
index 0000000..e24a129
--- /dev/null
+++ b/test/Main.purs
@@ -0,0 +1,165 @@
+module Main where
+
+import Control.Monad.Eff
+import Debug.Trace 
+
+import Control.Alt
+import Control.Alternative
+import Control.Apply
+import Control.Plus
+import Control.MonadPlus
+import Data.Traversable
+
+import Data.Tuple
+import Debug.Foreign
+import Data.Maybe
+import Data.Either
+import qualified Data.Array as A
+import qualified Data.StrMap as M
+import qualified Data.String as S 
+import Global
+
+class (MonadPlus f) <= Match f where
+  lit :: String -> f Unit
+  var :: f String
+  param :: String -> f String
+  fail :: forall a. String -> f a
+
+
+newtype I a = I (Route -> Either String (Tuple Route a))
+
+instance iMatch :: Match I where
+  lit input = I $ \route ->
+    case route of
+      (Path i):rs |i == input ->
+        Right $ Tuple rs unit
+      q@(Path _):_ -> let t = fprintUnsafe input in Left "not that"
+      _ -> Left "not a literal"
+  var = I $ \route ->
+    case route of
+      (Path input):rs -> Right $ Tuple rs input 
+      _ -> Left "not a var"
+  param key = I $ \route ->
+    case route of
+      (Query map):rs ->
+        case M.lookup key map of
+          Nothing -> Left "no param in query"
+          Just el -> Right $ Tuple ((Query <<< M.delete key $ map):rs) el
+      _ -> Left "not a query"
+  fail msg = I \_ -> Left msg
+
+
+instance iFunctor :: Functor I where
+  (<$>) fn (I r2e) = I $ \r -> do
+    Tuple rs a <- r2e r
+    return $ Tuple rs (fn a)
+
+instance iAlt :: Alt I where
+  (<|>) (I r2e1) (I r2e2) = I $ \r -> do
+    (r2e1 r) <|> (r2e2 r)
+
+instance iPlus :: Plus I where
+  empty = I $ \_ -> Left "empty"
+
+instance iAlternative :: Alternative I
+
+instance iApply :: Apply I where
+  (<*>) (I r2a2b) (I r2a) = I $ \route -> do
+    Tuple rs fn <- r2a2b route
+    Tuple rss a <- r2a rs
+    return $ Tuple rss (fn a)
+
+instance iApplicative :: Applicative I where
+  pure a = I $ \r -> Right $ Tuple r a
+
+instance iBind :: Bind I where
+  (>>=) (I r2a) a2ib = I $ \r -> do
+    Tuple rs a <- r2a r 
+    case a2ib a of
+      I res -> res rs
+
+instance iMonad :: Monad I
+instance iMonadPlus :: MonadPlus I
+
+-- Для начала нам похер каким образом построены пары имя-переменная
+-- поэтому мы можем тупо положить на то, что и как там у нас в каком-либо
+-- порядке организовано
+data RoutePart = Path String | Query (M.StrMap String)
+
+type Route = [RoutePart]
+
+tryQueryify :: RoutePart -> RoutePart
+tryQueryify source@(Path string) = fromMaybe source $ do
+  guard $ S.take 1 string == "?"
+  let parts = S.split "&" $ S.drop 1 string
+  Query <$> M.fromList <$> traverse onePartToKeyVal parts
+  where onePartToKeyVal :: String -> Maybe (Tuple String String) 
+        onePartToKeyVal input = do 
+          let keyVal = S.split "=" input
+          if A.length keyVal > 2 then Nothing
+            else 
+            Tuple <$> (A.head keyVal) <*> (keyVal A.!! 1)
+        
+tryQueryify q = q 
+
+parse :: String -> Route
+parse hash =
+  tryQueryify <$> Path <$> S.split "/" hash
+
+
+
+
+{-
+num :: String -> I Number
+num input = 
+  let res = readFloat input in
+  I $ \route -> case isNaN res of
+    true -> Left "not a number"
+    false -> Right $ Tuple route res
+-}
+num :: forall f. (Match f) => String -> f Number
+num input =
+  let res = readFloat input in
+  case isNaN res of
+    true -> fail "not a number" 
+    false -> return res
+
+bool :: forall f. (Match f) => String -> f Boolean
+bool input =
+  case input of
+    "true" -> pure true
+    "false" -> pure false
+    _ -> fail "not a boolean"
+
+{-
+bool :: String -> I Boolean
+bool input = I $ \route ->
+  case input of
+    "true" -> Right $ Tuple route true
+    "false" -> Right $ Tuple route false
+    _ -> Left "not a boolean"
+  -}
+
+
+--match :: forall a. (forall f. (Match f) => f a) -> Route -> Either String a
+
+runMatch :: forall a. I a -> Route -> Either String a
+runMatch (I fn) route = snd <$> fn route
+
+matchHash :: forall a. I a -> String -> Either String a
+matchHash matcher hash = runMatch matcher $ parse hash
+
+data FooBar = Foo Number | Bar Boolean String
+
+routing :: I FooBar
+--routing :: forall f. (Match f) => f FooBar
+routing =
+  Foo <$> (lit "foo" *> (var >>= num))
+  <|>
+  Bar <$> (lit "bar" *> (var >>= bool)) <*> (param "baz")
+
+main = do
+  fprint $ parse "bar/asdf/?baz=12"
+--  fprint $ matchHash routing "bar/100/?foo=14&baz=12/foo/123"
+  fprint $ matchHash routing "bar/asdf/?baz=123"
+  fprint $ matchHash routing "foo/asdf/"
diff --git a/test/Test/Main.purs b/test/Test/Main.purs
index 538a81a..771321b 100644
--- a/test/Test/Main.purs
+++ b/test/Test/Main.purs
@@ -14,7 +14,7 @@ import Debug.Foreign
 import Routing.Setter
 import Routing.Getter
 
-routing :: PErr Router
+routing :: PErr Router 
 routing = do
   one <- route "notebook" "notebook?foo&bar"
   two <- route "file" "file/:id"

From ec40d4bc30a98075477547261a157aee1724868d Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Fri, 20 Mar 2015 17:44:30 +0300
Subject: [PATCH 08/18] before reworking Match to State

---
 bower.json                         |   7 +-
 src/Routing.purs                   |  44 ++++++++
 src/Routing/Getter.purs            | 174 -----------------------------
 src/Routing/Match.purs             |  80 +++++++++++++
 src/Routing/Match/Class.purs       |   9 ++
 src/Routing/Match/Combinators.purs |  18 +++
 src/Routing/Match/Error.purs       |  41 +++++++
 src/Routing/Parser.purs            | 139 ++++-------------------
 src/Routing/Types.purs             |   6 +
 test/Main.purs                     | 157 ++------------------------
 test/Test/Main.purs                |  68 -----------
 11 files changed, 231 insertions(+), 512 deletions(-)
 create mode 100644 src/Routing.purs
 delete mode 100644 src/Routing/Getter.purs
 create mode 100644 src/Routing/Match.purs
 create mode 100644 src/Routing/Match/Class.purs
 create mode 100644 src/Routing/Match/Combinators.purs
 create mode 100644 src/Routing/Match/Error.purs
 create mode 100644 src/Routing/Types.purs
 delete mode 100644 test/Test/Main.purs

diff --git a/bower.json b/bower.json
index cf4fd99..ddd0302 100644
--- a/bower.json
+++ b/bower.json
@@ -19,16 +19,15 @@
   ],
   "dependencies": {
     "purescript-strings": "~0.4.3",
-    "purescript-parsing": "~0.3.1",
     "purescript-maps": "~0.3.2",
-    "purescript-debug-foreign": "~0.0.4",
     "purescript-control": "~0.2.2",
     "purescript-transformers": "~0.5.1",
     "purescript-arrays": "~0.3.3",
-    "purescript-globals": "~0.1.5",
     "purescript-monoid": "~0.2.0"
   },
   "devDependencies": {
-    "purescript-timers": "~0.0.8"
+    "purescript-timers": "~0.0.8",
+    "purescript-debug-foreign": "~0.0.4",
+    "purescript-globals": "~0.1.5"
   }
 }
diff --git a/src/Routing.purs b/src/Routing.purs
new file mode 100644
index 0000000..4f04030
--- /dev/null
+++ b/src/Routing.purs
@@ -0,0 +1,44 @@
+module Routing where
+
+import Control.Monad.Eff
+import Data.Maybe
+import Data.Either
+import qualified Data.String.Regex as R
+
+import Routing.Parser
+import Routing.Match
+import Routing.Match.Error
+
+
+foreign import hashChanged """
+function hashChanged(handler) {
+  return function() {
+    var currentHash = document.location.hash;
+    handler("")(currentHash)();
+    window.addEventListener("hashchange", function(ev) {
+      handler(ev.oldURL)(ev.newURL)();
+    });
+  };
+}
+""" :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit 
+
+
+hashes :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit
+hashes cb =
+  hashChanged $ \old new -> do
+    cb (dropHash old) (dropHash new)
+  where dropHash h = R.replace (R.regex "^[^#]*#" R.noFlags) "" h
+
+foreign import log """
+function log(a) {return function() {console.log(a)}}
+""" :: forall a e. a -> Eff e Unit
+
+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 
+      fst = either (const Nothing) Just $ mr old
+  in either (const $ pure unit) (cb fst) $ mr new 
+
+
+matchHash :: forall a. Match a -> String -> Either RoutingError a
+matchHash matcher hash = runMatch matcher $ parse hash
diff --git a/src/Routing/Getter.purs b/src/Routing/Getter.purs
deleted file mode 100644
index 851422d..0000000
--- a/src/Routing/Getter.purs
+++ /dev/null
@@ -1,174 +0,0 @@
--- | Getting `hashchange` events and wraps 
--- | `oldURL` and `newURL` to RouteMatch
--- | or RouteDiff instances 
-module Routing.Getter (
-  route,
-  or,
-  contains,
-  runRouter,
-  hashes,
-  matches,
-  routes,
-  PErr(),
-  Router(),
-  RouteDiff,
-  fromMatch,
-  RouteMatch(),
-  RouteMatches()
-  ) where
-
-import Data.Either
-import Data.Maybe
-import Data.Tuple
-import Control.Monad.Eff
-import Control.Monad.State
-import Control.Monad.Trans
-import Control.Monad.State.Class
-import Control.Monad.Error
-import Data.Monoid
-import Control.Apply ((*>))
-import Control.Alt ((<|>))
-import Data.String.Regex (replace, noFlags, Regex(), regex)
-import Data.Array (findIndex, drop, take)
-import Data.Traversable (traverse)
-
-import qualified Data.StrMap as M
-import qualified Text.Parsing.Parser as P
-import qualified Text.Parsing.Parser.Combinators as P
-
-import Routing.Parser (parse, template, StateObj())
-
--- | Shortcut for parser
-type RouteParser = P.ParserT String StateObj RouteMatches
--- | Main data produced by matching hash
--- | Tuple routeName mappedTemplateArgumentsValues
-type RouteMatch = Tuple String (M.StrMap String)
--- | nonempty list of matches
-type RouteMatches = Tuple RouteMatch [RouteMatch]
--- | Shortcut for parsing errors
-type PErr a = Either P.ParseError a
--- | 
-newtype Router = Router RouteParser
-
--- | check if `s` matches router
-runRouter :: String -> Router -> PErr RouteMatches
-runRouter s (Router p) =
-  evalState (P.runParserT s p) M.empty 
-
--- | define router by name and template
-route :: String -> String -> PErr Router
-route name templateStr = do
-  parser <- parse <$> P.runParser templateStr template
-  let p = parser *> lift get >>= \res ->
-        pure $ Tuple (Tuple name res) []
-  pure $ Router p
-  
--- | construct router from two routers
--- | will match first **or** second
-or :: Router -> Router -> Router
-or (Router one) (Router two) =
-  Router $ one <|> two
-
--- | construct router from two routers
--- | will try to match first router and
--- | if it matches try to match second
--- | produced result of matching first if
--- | second fails or aggregated result otherwise
-contains :: Router -> Router -> Router
-contains (Router parent) (Router child) =
-  let put' :: M.StrMap String -> StateObj Unit
-      put' = put 
-  in Router $ do
-    Tuple pHead pTail <- parent
-    lift $ put' M.empty
-    c <- P.optionMaybe child
-    pure $ case c of
-      -- when name == "" we don't include match results for
-      -- this router since it's one router
-      Just (Tuple cHead@(Tuple name params) []) | name /= "" ->
-        Tuple cHead (pHead:pTail)
-      _ -> Tuple pHead pTail
-
-
--- | Main driver of routing 
-foreign import hashChanged """
-function hashChanged(handler) {
-  return function() {
-    var currentHash = document.location.hash;
-    handler("")(currentHash)();
-    window.addEventListener("hashchange", function(ev) {
-      handler(ev.oldURL)(ev.newURL)();
-    });
-  };
-}
-""" :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit
-
--- | stream of hashes without hash symbol
-hashes :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit
-hashes cb =
-  hashChanged $ \old new -> do
-    cb (dropHash old) (dropHash new)
-  where dropHash h = replace (regex "^[^#]+#" noFlags) "" h
-
--- | Class of types that can be produced by matching
--- | diffs of hashes
-class RouteDiff a where 
-  fromMatch :: RouteMatch -> Maybe a
-
--- | Tuple name argValMap is just RouteMatch
-instance strMap :: RouteDiff (Tuple String (M.StrMap String)) where
-  fromMatch = Just
-
--- | Stream of `RouteMatch`es 
-matches :: forall e. Router -> (RouteMatches -> Eff e Unit) -> Eff e Unit
-matches route callback =  
-  hashes $ \old new -> do
-    let diff = do
-          -- Get old url matches 
-          Tuple headOld olds <- runRouter old route
-          -- Get new url matches
-          Tuple headNew news <- runRouter new route
-          -- if new url is substate of old url
-          case findIndex ((==) headOld) news of
-            -1 -> pure $ Tuple headNew news
-            -- find depth of substate and return only new part 
-            i -> if drop i news == (headOld:olds) then
-                   pure $ Tuple headNew (take i news)
-                   else
-                   pure $ Tuple headNew news 
-    case diff of
-      -- If router matches hash then callback
-      Right matches -> callback matches
-      -- Otherwise do nothing
-      _ -> pure unit
-
--- Stream of decoded messages. i.e. in case of
--- purescript-halogen `i` from `HTML a i`
-routes :: forall e a. (RouteDiff a) =>
-          Router -> (Tuple a [a] -> Eff e Unit) -> Eff e Unit
-routes route callback =
-  matches route $ \(Tuple match matches) -> 
-    maybe (pure unit) callback do
-          r <- fromMatch match
-          rs <- traverse fromMatch matches
-          pure $ Tuple r rs
-
-zeroR :: Router
-zeroR = Router $ P.fail "zero router always fails"
-
-oneR :: Router
-oneR = Router $ pure $ Tuple (Tuple "" M.empty) []
-
--- | Router is semigroup over `or`
-instance semigroupRouter :: Semigroup Router where
-  (<>) = or
--- | Router is monoid with always failing router as `mempty`
-instance monoidRouter :: Monoid Router where
-  mempty = Router $ P.fail "mempty"
-
-
-instance semiringRouter :: Semiring Router where
-  (+) = or
-  (*) = contains
-  zero = zeroR
-  one = oneR
diff --git a/src/Routing/Match.purs b/src/Routing/Match.purs
new file mode 100644
index 0000000..1e714bc
--- /dev/null
+++ b/src/Routing/Match.purs
@@ -0,0 +1,80 @@
+module Routing.Match where
+
+import Data.Either
+import Data.Tuple
+import Data.Maybe
+import Control.Alt
+import Control.Plus
+import Control.Apply
+import Control.MonadPlus
+import Control.Alternative
+import Control.Monad.Error 
+import qualified Data.StrMap as M
+
+import Routing.Parser
+import Routing.Types
+import Routing.Match.Class
+import Routing.Match.Error
+
+newtype Match a = Match (Route -> Either RoutingError (Tuple Route a))
+
+instance matchMatchClass :: MatchClass Match where
+  lit input = Match $ \route ->
+    case route of
+      -- TODO: check if (Path input):rs works probably ps bug.
+      (Path i):rs |i == input ->
+        Right $ Tuple rs unit
+      (Path _):_ -> Left <<< strMsg $ "expected path part \"" <> input <> "\""
+      _ -> Left <<< strMsg $ "expected path part - found query"
+  var = Match $ \route ->
+    case route of
+      (Path input):rs -> Right $ Tuple rs input 
+      _ -> Left <<< strMsg $ "expected simple var - found query"
+
+  param key = Match $ \route ->
+    case route of
+      (Query map):rs ->
+        case M.lookup key map of
+          Nothing -> Left <<< strMsg $ "key " <> key <> " not found in query"
+          Just el -> Right $ Tuple ((Query <<< M.delete key $ map):rs) el
+      _ -> Left <<< strMsg $ "expected query - found path"
+  fail msg = Match \_ -> Left $ strMsg msg
+
+
+instance matchFunctor :: Functor Match where
+  (<$>) fn (Match r2e) = Match $ \r -> do
+    Tuple rs a <- r2e r
+    pure $ Tuple rs (fn a)
+
+instance matchAlt :: Alt Match where
+  (<|>) (Match r2e1) (Match r2e2) = Match $ \r -> do
+    (r2e1 r) <|> (r2e2 r)
+
+instance matchPlus :: Plus Match where
+  empty = Match $ const $ Left noMsg
+
+instance matchAlternative :: Alternative Match
+
+instance matchApply :: Apply Match where
+  (<*>) (Match r2a2b) (Match r2a) = Match $ \r -> do
+    Tuple rs fn <- r2a2b r
+    Tuple rss a <- r2a rs
+    pure $ Tuple rss (fn a)
+
+instance matchApplicative :: Applicative Match where
+  pure a = Match \r -> Right $ Tuple r a
+
+instance matchBind :: Bind Match where
+  (>>=) (Match r2a) a2mb = Match $ \r -> do
+    Tuple rs a <- r2a r
+    case a2mb a of
+      Match res -> res rs
+
+instance matchMonad :: Monad Match
+instance matchMonadPlus :: MonadPlus Match
+
+
+runMatch :: forall a. Match a -> Route -> Either RoutingError a
+runMatch (Match fn) route = snd <$> fn route
+                   
+    
diff --git a/src/Routing/Match/Class.purs b/src/Routing/Match/Class.purs
new file mode 100644
index 0000000..4abc477
--- /dev/null
+++ b/src/Routing/Match/Class.purs
@@ -0,0 +1,9 @@
+module Routing.Match.Class where
+
+import Control.MonadPlus
+
+class (MonadPlus f) <= MatchClass f where
+  lit :: String -> f Unit
+  var :: f String
+  param :: String -> f String
+  fail :: forall a. String -> f a
diff --git a/src/Routing/Match/Combinators.purs b/src/Routing/Match/Combinators.purs
new file mode 100644
index 0000000..db3e1e3
--- /dev/null
+++ b/src/Routing/Match/Combinators.purs
@@ -0,0 +1,18 @@
+module Routing.Match.Combinators where
+
+import Routing.Match.Class
+import Global (readFloat, isNaN)
+
+num :: forall f. (MatchClass f) => String -> f Number
+num input =
+  let res = readFloat input in
+  case isNaN res of
+    true -> fail "not a number" 
+    false -> return res
+
+bool :: forall f. (MatchClass f) => String -> f Boolean
+bool input =
+  case input of
+    "true" -> pure true
+    "false" -> pure false
+    _ -> fail "not a boolean"
diff --git a/src/Routing/Match/Error.purs b/src/Routing/Match/Error.purs
new file mode 100644
index 0000000..a833a16
--- /dev/null
+++ b/src/Routing/Match/Error.purs
@@ -0,0 +1,41 @@
+module Routing.Match.Error where
+
+import Data.Monoid
+import Data.Traversable 
+import Data.Array
+import Control.Monad.Error 
+
+newtype RoutingError = RoutingError [[String]]
+
+orRE :: RoutingError -> RoutingError -> RoutingError
+orRE (RoutingError errs1) (RoutingError errs2) =
+  RoutingError $ errs1 <> errs2
+
+zeroRE :: RoutingError
+zeroRE = RoutingError []
+
+andRE :: RoutingError -> RoutingError -> RoutingError
+andRE (RoutingError errs1) (RoutingError errs2) =
+  RoutingError $ do
+    e1 <- errs1
+    e2 <- errs2
+    pure $ e1 <> e2
+
+oneRE :: RoutingError
+oneRE = RoutingError [[]]
+
+
+instance routingErrorSemigroup :: Semigroup RoutingError  where
+  (<>) = andRE 
+instance routingErrorMonoid :: Monoid RoutingError where
+  mempty = oneRE
+
+instance routingErrorSemiring :: Semiring RoutingError where
+  one = oneRE
+  zero = zeroRE
+  (+) = orRE
+  (*) = andRE
+
+instance routingErrorError :: Error RoutingError where
+  noMsg = zeroRE
+  strMsg msg = RoutingError [[msg]]
diff --git a/src/Routing/Parser.purs b/src/Routing/Parser.purs
index 1b9d201..be1e65d 100644
--- a/src/Routing/Parser.purs
+++ b/src/Routing/Parser.purs
@@ -1,129 +1,30 @@
 module Routing.Parser (
-  parse,
-  template,
-  StateObj(),
-  TemplateEl(..),
-  Template()
+  parse
   ) where
 
+import Control.MonadPlus
 import Data.Maybe
-import Data.Either
-
-import Control.Alternative (many)
-import Control.Alt ((<|>))
-import Data.Foldable (fold, foldl, sequence_, traverse_)
-import Data.Traversable (sequence, traverse)
-import Control.Monad.State 
-import Control.Monad.Trans
-import Control.Monad.State.Class
-
-import qualified Text.Parsing.Parser as P
-import qualified Text.Parsing.Parser.Combinators as P
-import qualified Text.Parsing.Parser.String as P
+import Data.Tuple
+import Data.Traversable (traverse) 
 import qualified Data.StrMap as M
+import qualified Data.String as S
+import qualified Data.Array as A
 
+import Routing.Types
 
--- | Ast of parsed route template
-data TemplateEl = Placeholder String | Variable String | Query [String]
--- | shortcut
-type Template = [TemplateEl]
--- | shortcut 
-type StateObj = State (M.StrMap String)
-
-
-foreign import decodeURIComponent :: String -> String
-
--- | Parses placeholder names
-name :: forall m. (Monad m) => P.ParserT String m String
-name = do
-  strs <- many $ P.noneOf [":", "&", "?"]
-  case strs of
-    [] -> P.fail "empty name"
-    cs -> return $ decodeURIComponent (fold cs)
-    
--- | parses variables 
-variable :: forall m. (Monad m) => P.ParserT String m String
-variable = do
-  strs <- many $ P.noneOf [":", "&", "/", "?", "="]
-  case strs of
-    [] -> P.fail "empty var"
-    cs -> return $ decodeURIComponent (fold cs)
-    
--- | parses placeholder
-placeholder :: forall m. (Monad m) => P.ParserT String m TemplateEl
-placeholder =  Placeholder <$> name 
-
--- | parses variables in `:foo`
-colon :: forall m. (Monad m) => P.ParserT String m TemplateEl
-colon = do
-  P.string ":"
-  Variable <$> variable
-
--- | parses variables in `?foo&bar&baz`
-query :: forall m. (Monad m) => P.ParserT String m TemplateEl
-query = do
-  strs <- many $ do
-    P.string "&" <|> P.string "?"
-    variable
-  case strs of
-    [] -> P.fail "not an query string"
-    qs -> pure $ Query qs
 
--- | parses all template elements
-template :: forall m. (Monad m) => P.ParserT String m Template
-template = many $ P.choice [
-  P.try placeholder,
-  P.try query,
-  P.try colon]
+tryQuery :: RoutePart -> RoutePart
+tryQuery source@(Path string) = fromMaybe source $ do
+  guard $ S.take 1 string == "?"
+  let parts = S.split "&" $ S.drop 1 string
+  Query <$> M.fromList <$> traverse part2tuple parts
+  where 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 :: String -> Route
+parse hash = tryQuery <$> Path <$> S.split "/" hash
 
--- | Produce parsers of uri from template strings
-parse :: Template -> P.ParserT String StateObj Unit
-parse template =
-  -- type hints
-  let get' :: String -> StateObj (Maybe String)
-      get' str = gets (M.lookup str)
-      get'' :: StateObj (M.StrMap String)
-      get'' = get
-      
-    in case template of
-    -- ast is over 
-    [] -> pure unit
-    (Variable str):ts -> do
-      -- lookup this variable setted in state
-      -- fail if it has been setted
-      g <- lift $ get' str
-      v <- variable
-      case g of
-        Nothing -> do
-          -- insert key val pair to state
-          lift $ modify (M.insert str v)
-          parse ts
-        _ -> P.fail $ "Parsing route template error: duplicated key " <>
-             show str 
-        
-    (Query strs):ts -> do
-      P.string "?"
-      res <- many $ do
-        -- consume "&" or nothing
-        (P.try $ P.string "&") <|> pure ""
-        -- find one of template args 
-        s <- P.choice $ P.try <<< P.string <$> strs
-        P.string "="
-        -- check if this variable was setted before
-        v <- variable
-        g <- lift $ get' s
-        case g of
-          Nothing -> do
-            lift $ modify (M.insert s v)
-            pure v
-          _ -> 
-            P.fail $ "Parsing route template error: duplicated key" <>
-            show v <> " in query: " <> show strs 
-            
-      parse ts
-      
-    (Placeholder str):ts -> do
-      -- consume placeholder
-      P.string str
-      parse ts
diff --git a/src/Routing/Types.purs b/src/Routing/Types.purs
new file mode 100644
index 0000000..0b45023
--- /dev/null
+++ b/src/Routing/Types.purs
@@ -0,0 +1,6 @@
+module Routing.Types where
+
+import qualified Data.StrMap as M
+
+data RoutePart = Path String | Query (M.StrMap String)
+type Route = [RoutePart]
diff --git a/test/Main.purs b/test/Main.purs
index e24a129..c3d5193 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -2,164 +2,27 @@ module Main where
 
 import Control.Monad.Eff
 import Debug.Trace 
-
 import Control.Alt
-import Control.Alternative
 import Control.Apply
-import Control.Plus
-import Control.MonadPlus
-import Data.Traversable
-
-import Data.Tuple
 import Debug.Foreign
-import Data.Maybe
-import Data.Either
-import qualified Data.Array as A
-import qualified Data.StrMap as M
-import qualified Data.String as S 
-import Global
-
-class (MonadPlus f) <= Match f where
-  lit :: String -> f Unit
-  var :: f String
-  param :: String -> f String
-  fail :: forall a. String -> f a
-
-
-newtype I a = I (Route -> Either String (Tuple Route a))
-
-instance iMatch :: Match I where
-  lit input = I $ \route ->
-    case route of
-      (Path i):rs |i == input ->
-        Right $ Tuple rs unit
-      q@(Path _):_ -> let t = fprintUnsafe input in Left "not that"
-      _ -> Left "not a literal"
-  var = I $ \route ->
-    case route of
-      (Path input):rs -> Right $ Tuple rs input 
-      _ -> Left "not a var"
-  param key = I $ \route ->
-    case route of
-      (Query map):rs ->
-        case M.lookup key map of
-          Nothing -> Left "no param in query"
-          Just el -> Right $ Tuple ((Query <<< M.delete key $ map):rs) el
-      _ -> Left "not a query"
-  fail msg = I \_ -> Left msg
-
-
-instance iFunctor :: Functor I where
-  (<$>) fn (I r2e) = I $ \r -> do
-    Tuple rs a <- r2e r
-    return $ Tuple rs (fn a)
-
-instance iAlt :: Alt I where
-  (<|>) (I r2e1) (I r2e2) = I $ \r -> do
-    (r2e1 r) <|> (r2e2 r)
-
-instance iPlus :: Plus I where
-  empty = I $ \_ -> Left "empty"
-
-instance iAlternative :: Alternative I
-
-instance iApply :: Apply I where
-  (<*>) (I r2a2b) (I r2a) = I $ \route -> do
-    Tuple rs fn <- r2a2b route
-    Tuple rss a <- r2a rs
-    return $ Tuple rss (fn a)
-
-instance iApplicative :: Applicative I where
-  pure a = I $ \r -> Right $ Tuple r a
-
-instance iBind :: Bind I where
-  (>>=) (I r2a) a2ib = I $ \r -> do
-    Tuple rs a <- r2a r 
-    case a2ib a of
-      I res -> res rs
 
-instance iMonad :: Monad I
-instance iMonadPlus :: MonadPlus I
 
--- Для начала нам похер каким образом построены пары имя-переменная
--- поэтому мы можем тупо положить на то, что и как там у нас в каком-либо
--- порядке организовано
-data RoutePart = Path String | Query (M.StrMap String)
-
-type Route = [RoutePart]
-
-tryQueryify :: RoutePart -> RoutePart
-tryQueryify source@(Path string) = fromMaybe source $ do
-  guard $ S.take 1 string == "?"
-  let parts = S.split "&" $ S.drop 1 string
-  Query <$> M.fromList <$> traverse onePartToKeyVal parts
-  where onePartToKeyVal :: String -> Maybe (Tuple String String) 
-        onePartToKeyVal input = do 
-          let keyVal = S.split "=" input
-          if A.length keyVal > 2 then Nothing
-            else 
-            Tuple <$> (A.head keyVal) <*> (keyVal A.!! 1)
-        
-tryQueryify q = q 
-
-parse :: String -> Route
-parse hash =
-  tryQueryify <$> Path <$> S.split "/" hash
-
-
-
-
-{-
-num :: String -> I Number
-num input = 
-  let res = readFloat input in
-  I $ \route -> case isNaN res of
-    true -> Left "not a number"
-    false -> Right $ Tuple route res
--}
-num :: forall f. (Match f) => String -> f Number
-num input =
-  let res = readFloat input in
-  case isNaN res of
-    true -> fail "not a number" 
-    false -> return res
-
-bool :: forall f. (Match f) => String -> f Boolean
-bool input =
-  case input of
-    "true" -> pure true
-    "false" -> pure false
-    _ -> fail "not a boolean"
-
-{-
-bool :: String -> I Boolean
-bool input = I $ \route ->
-  case input of
-    "true" -> Right $ Tuple route true
-    "false" -> Right $ Tuple route false
-    _ -> Left "not a boolean"
-  -}
-
-
---match :: forall a. (forall f. (Match f) => f a) -> Route -> Either String a
-
-runMatch :: forall a. I a -> Route -> Either String a
-runMatch (I fn) route = snd <$> fn route
-
-matchHash :: forall a. I a -> String -> Either String a
-matchHash matcher hash = runMatch matcher $ parse hash
+import Routing
+import Routing.Match
+import Routing.Match.Class
+import Routing.Match.Combinators
 
 data FooBar = Foo Number | Bar Boolean String
 
-routing :: I FooBar
---routing :: forall f. (Match f) => f FooBar
+routing :: Match FooBar
 routing =
   Foo <$> (lit "foo" *> (var >>= num))
   <|>
   Bar <$> (lit "bar" *> (var >>= bool)) <*> (param "baz")
 
 main = do
-  fprint $ parse "bar/asdf/?baz=12"
---  fprint $ matchHash routing "bar/100/?foo=14&baz=12/foo/123"
-  fprint $ matchHash routing "bar/asdf/?baz=123"
-  fprint $ matchHash routing "foo/asdf/"
+  fprint $ matchHash routing "foo/asdf"
+  matches routing $ \old new -> void $ do
+    fprint old
+    fprint new
+
diff --git a/test/Test/Main.purs b/test/Test/Main.purs
deleted file mode 100644
index 771321b..0000000
--- a/test/Test/Main.purs
+++ /dev/null
@@ -1,68 +0,0 @@
-module Test.Main where
-
-import Control.Monad.Eff
-import Data.Tuple
-import Data.Array
-import Data.Either
-import Data.Maybe
-import Data.StrMap (lookup)
-import Global
-
-import Debug.Trace
-import Debug.Foreign
-
-import Routing.Setter
-import Routing.Getter
-
-routing :: PErr Router 
-routing = do
-  one <- route "notebook" "notebook?foo&bar"
-  two <- route "file" "file/:id"
-  three <- route "read" "/read"
-  four <- route "write" "/write"
-  pure $ one `or` (two `contains` (three `or` four))
-  
-data Test =
-  Notebook Number Number 
-  | File String
-  | Write
-  | Read
-
-data TestState
-  = NotebookState Number Number
-  | FileState String Boolean
-
-instance tstStTestState :: RouteState TestState where
-  toHash (NotebookState foo bar) = "notebook?foo=" <> show foo <>
-                                   "&bar=" <> show bar
-  toHash (FileState id read) = "file/" <> id <> if read then "read" else "write"
-
-instance tstRouteDiff :: RouteDiff Test where
-  fromMatch (Tuple "write" _) = Just Write
-  fromMatch (Tuple "read" _) = Just Read
-  fromMatch (Tuple "file" map) = do
-    f <- lookup "id" map
-    pure $ File f 
-  fromMatch (Tuple "notebook" map) = do
-    foo <- readFloat <$> lookup "foo" map
-    bar <- readFloat <$> lookup "bar" map
-    if isNaN foo || isNaN bar then
-      Nothing
-      else
-      pure $ Notebook foo bar
-  fromMatch _  = Nothing
-
-
-main = do
-  fprint $ do
-    r <- routing
-    runRouter "notebook?foo=1&bar=2" r
-  let fp :: Tuple Test [Test] -> Eff _ Unit
-      fp t = void $ fprint t
-  case routing of
-    Right r -> do
-      routes r $ \r -> void do
-        fp r
-        setRouteState $ NotebookState 123 234
-    _ -> pure unit
-                      

From fdd33ea247bbb8f64a20cc274886296dfd058422 Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Fri, 20 Mar 2015 17:45:04 +0300
Subject: [PATCH 09/18] docs

---
 MODULES.md | 216 +++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 162 insertions(+), 54 deletions(-)

diff --git a/MODULES.md b/MODULES.md
index 3160a99..34e5bc7 100644
--- a/MODULES.md
+++ b/MODULES.md
@@ -1,154 +1,143 @@
 # Module Documentation
 
-## Module Routing.Getter
+## Module Routing
 
-
-
-#### `Check`
+#### `hashChanged`
 
 ``` purescript
-type Check = Tuple String (M.StrMap String)
+hashChanged :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit
 ```
 
 
-#### `Checks`
+#### `hashes`
 
 ``` purescript
-type Checks = Tuple Check [Check]
+hashes :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit
 ```
 
 
-#### `PErr`
+#### `log`
 
 ``` purescript
-type PErr a = Either P.ParseError a
+log :: forall a e. a -> Eff e Unit
 ```
 
 
-#### `Route`
+#### `matches`
 
 ``` purescript
-newtype Route
+matches :: forall e a. Match a -> (Maybe a -> a -> Eff e Unit) -> Eff e Unit
 ```
 
 
-#### `runRoute`
+#### `matchHash`
 
 ``` purescript
-runRoute :: String -> Route -> PErr Checks
+matchHash :: forall a. Match a -> String -> Either RoutingError a
 ```
 
 
-#### `route`
 
-``` purescript
-route :: String -> String -> PErr Route
-```
+## Module Routing.Match
 
-
-#### `or`
+#### `Match`
 
 ``` purescript
-or :: Route -> Route -> Route
+newtype Match a
+  = Match (Route -> Either RoutingError (Tuple Route a))
 ```
 
 
-#### `contains`
+#### `matchMatchClass`
 
 ``` purescript
-contains :: Route -> Route -> Route
+instance matchMatchClass :: MatchClass Match
 ```
 
 
-#### `hashes`
+#### `matchFunctor`
 
 ``` purescript
-hashes :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit
+instance matchFunctor :: Functor Match
 ```
 
 
-#### `RouteMsg`
+#### `matchAlt`
 
 ``` purescript
-class RouteMsg a where
-  toMsg :: Check -> Maybe a
+instance matchAlt :: Alt Match
 ```
 
 
-#### `strMap`
+#### `matchPlus`
 
 ``` purescript
-instance strMap :: RouteMsg (Tuple String (M.StrMap String))
+instance matchPlus :: Plus Match
 ```
 
 
-#### `checks`
+#### `matchAlternative`
 
 ``` purescript
-checks :: forall e. Route -> (Checks -> Eff e Unit) -> Eff e Unit
+instance matchAlternative :: Alternative Match
 ```
 
 
-#### `routes`
+#### `matchApply`
 
 ``` purescript
-routes :: forall e a. (RouteMsg a) => Route -> (Tuple a [a] -> Eff e Unit) -> Eff e Unit
+instance matchApply :: Apply Match
 ```
 
 
+#### `matchApplicative`
 
-## Module Routing.Parser
-
+``` purescript
+instance matchApplicative :: Applicative Match
+```
 
 
-#### `TemplateEl`
+#### `matchBind`
 
 ``` purescript
-data TemplateEl
-  = Placeholder String
-  | Key String
-  | Ask [String]
+instance matchBind :: Bind Match
 ```
 
-Ast of parsed route template
 
-#### `Template`
+#### `matchMonad`
 
 ``` purescript
-type Template = [TemplateEl]
+instance matchMonad :: Monad Match
 ```
 
-shortcut
 
-#### `StateObj`
+#### `matchMonadPlus`
 
 ``` purescript
-type StateObj = State (M.StrMap String)
+instance matchMonadPlus :: MonadPlus Match
 ```
 
-shortcut 
 
-#### `template`
+#### `runMatch`
 
 ``` purescript
-template :: forall m. (Monad m) => P.ParserT String m Template
+runMatch :: forall a. Match a -> Route -> Either RoutingError a
 ```
 
-parses all template elements
+
+
+## Module Routing.Parser
 
 #### `parse`
 
 ``` purescript
-parse :: Template -> P.ParserT String StateObj Unit
+parse :: String -> Route
 ```
 
-Produce parsers of uri from template strings
 
 
 ## Module Routing.Setter
 
-
-
 #### `setHash`
 
 ``` purescript
@@ -163,6 +152,7 @@ class RouteState a where
   toHash :: a -> String
 ```
 
+Class of types that can be converted to hashes 
 
 #### `setRouteState`
 
@@ -170,6 +160,124 @@ class RouteState a where
 setRouteState :: forall r e. (RouteState r) => r -> Eff e Unit
 ```
 
+wrapper over `setHash` that uses `RouteState`
+
+
+## Module Routing.Types
+
+#### `RoutePart`
+
+``` purescript
+data RoutePart
+  = Path String
+  | Query (M.StrMap String)
+```
+
+
+#### `Route`
+
+``` purescript
+type Route = [RoutePart]
+```
+
+
+
+## Module Routing.Match.Class
+
+#### `MatchClass`
+
+``` purescript
+class (MonadPlus f) <= MatchClass f where
+  lit :: String -> f Unit
+  var :: f String
+  param :: String -> f String
+  fail :: forall a. String -> f a
+```
+
+
+
+## Module Routing.Match.Combinators
+
+#### `num`
+
+``` purescript
+num :: forall f. (MatchClass f) => String -> f Number
+```
+
+
+#### `bool`
+
+``` purescript
+bool :: forall f. (MatchClass f) => String -> f Boolean
+```
+
+
+
+## Module Routing.Match.Error
+
+#### `RoutingError`
+
+``` purescript
+newtype RoutingError
+  = RoutingError [[String]]
+```
+
+
+#### `orRE`
+
+``` purescript
+orRE :: RoutingError -> RoutingError -> RoutingError
+```
+
+
+#### `zeroRE`
+
+``` purescript
+zeroRE :: RoutingError
+```
+
+
+#### `andRE`
+
+``` purescript
+andRE :: RoutingError -> RoutingError -> RoutingError
+```
+
+
+#### `oneRE`
+
+``` purescript
+oneRE :: RoutingError
+```
+
+
+#### `routingErrorSemigroup`
+
+``` purescript
+instance routingErrorSemigroup :: Semigroup RoutingError
+```
+
+
+#### `routingErrorMonoid`
+
+``` purescript
+instance routingErrorMonoid :: Monoid RoutingError
+```
+
+
+#### `routingErrorSemiring`
+
+``` purescript
+instance routingErrorSemiring :: Semiring RoutingError
+```
+
+
+#### `routingErrorError`
+
+``` purescript
+instance routingErrorError :: Error RoutingError
+```
+
 
 
 

From e85829a55741f0ede79cdaa4d61b72e3e6ca0f84 Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Fri, 20 Mar 2015 18:21:49 +0300
Subject: [PATCH 10/18] back to string errors, state is too ugly

---
 MODULES.md                   | 73 ++----------------------------------
 src/Routing.purs             |  4 +-
 src/Routing/Match.purs       |  5 +--
 src/Routing/Match/Error.purs | 41 --------------------
 4 files changed, 6 insertions(+), 117 deletions(-)
 delete mode 100644 src/Routing/Match/Error.purs

diff --git a/MODULES.md b/MODULES.md
index 34e5bc7..d1f41df 100644
--- a/MODULES.md
+++ b/MODULES.md
@@ -33,7 +33,7 @@ matches :: forall e a. Match a -> (Maybe a -> a -> Eff e Unit) -> Eff e Unit
 #### `matchHash`
 
 ``` purescript
-matchHash :: forall a. Match a -> String -> Either RoutingError a
+matchHash :: forall a. Match a -> String -> Either String a
 ```
 
 
@@ -44,7 +44,7 @@ matchHash :: forall a. Match a -> String -> Either RoutingError a
 
 ``` purescript
 newtype Match a
-  = Match (Route -> Either RoutingError (Tuple Route a))
+  = Match (Route -> Either String (Tuple Route a))
 ```
 
 
@@ -121,7 +121,7 @@ instance matchMonadPlus :: MonadPlus Match
 #### `runMatch`
 
 ``` purescript
-runMatch :: forall a. Match a -> Route -> Either RoutingError a
+runMatch :: forall a. Match a -> Route -> Either String a
 ```
 
 
@@ -213,71 +213,4 @@ bool :: forall f. (MatchClass f) => String -> f Boolean
 
 
 
-## Module Routing.Match.Error
-
-#### `RoutingError`
-
-``` purescript
-newtype RoutingError
-  = RoutingError [[String]]
-```
-
-
-#### `orRE`
-
-``` purescript
-orRE :: RoutingError -> RoutingError -> RoutingError
-```
-
-
-#### `zeroRE`
-
-``` purescript
-zeroRE :: RoutingError
-```
-
-
-#### `andRE`
-
-``` purescript
-andRE :: RoutingError -> RoutingError -> RoutingError
-```
-
-
-#### `oneRE`
-
-``` purescript
-oneRE :: RoutingError
-```
-
-
-#### `routingErrorSemigroup`
-
-``` purescript
-instance routingErrorSemigroup :: Semigroup RoutingError
-```
-
-
-#### `routingErrorMonoid`
-
-``` purescript
-instance routingErrorMonoid :: Monoid RoutingError
-```
-
-
-#### `routingErrorSemiring`
-
-``` purescript
-instance routingErrorSemiring :: Semiring RoutingError
-```
-
-
-#### `routingErrorError`
-
-``` purescript
-instance routingErrorError :: Error RoutingError
-```
-
-
-
 
diff --git a/src/Routing.purs b/src/Routing.purs
index 4f04030..af6f44a 100644
--- a/src/Routing.purs
+++ b/src/Routing.purs
@@ -7,8 +7,6 @@ import qualified Data.String.Regex as R
 
 import Routing.Parser
 import Routing.Match
-import Routing.Match.Error
-
 
 foreign import hashChanged """
 function hashChanged(handler) {
@@ -40,5 +38,5 @@ matches routing cb = hashes $ \old new ->
   in either (const $ pure unit) (cb fst) $ mr new 
 
 
-matchHash :: forall a. Match a -> String -> Either RoutingError a
+matchHash :: forall a. Match a -> String -> Either String a
 matchHash matcher hash = runMatch matcher $ parse hash
diff --git a/src/Routing/Match.purs b/src/Routing/Match.purs
index 1e714bc..72a3406 100644
--- a/src/Routing/Match.purs
+++ b/src/Routing/Match.purs
@@ -14,9 +14,8 @@ import qualified Data.StrMap as M
 import Routing.Parser
 import Routing.Types
 import Routing.Match.Class
-import Routing.Match.Error
 
-newtype Match a = Match (Route -> Either RoutingError (Tuple Route a))
+newtype Match a = Match (Route -> Either String (Tuple Route a))
 
 instance matchMatchClass :: MatchClass Match where
   lit input = Match $ \route ->
@@ -74,7 +73,7 @@ instance matchMonad :: Monad Match
 instance matchMonadPlus :: MonadPlus Match
 
 
-runMatch :: forall a. Match a -> Route -> Either RoutingError a
+runMatch :: forall a. Match a -> Route -> Either String a
 runMatch (Match fn) route = snd <$> fn route
                    
     
diff --git a/src/Routing/Match/Error.purs b/src/Routing/Match/Error.purs
deleted file mode 100644
index a833a16..0000000
--- a/src/Routing/Match/Error.purs
+++ /dev/null
@@ -1,41 +0,0 @@
-module Routing.Match.Error where
-
-import Data.Monoid
-import Data.Traversable 
-import Data.Array
-import Control.Monad.Error 
-
-newtype RoutingError = RoutingError [[String]]
-
-orRE :: RoutingError -> RoutingError -> RoutingError
-orRE (RoutingError errs1) (RoutingError errs2) =
-  RoutingError $ errs1 <> errs2
-
-zeroRE :: RoutingError
-zeroRE = RoutingError []
-
-andRE :: RoutingError -> RoutingError -> RoutingError
-andRE (RoutingError errs1) (RoutingError errs2) =
-  RoutingError $ do
-    e1 <- errs1
-    e2 <- errs2
-    pure $ e1 <> e2
-
-oneRE :: RoutingError
-oneRE = RoutingError [[]]
-
-
-instance routingErrorSemigroup :: Semigroup RoutingError  where
-  (<>) = andRE 
-instance routingErrorMonoid :: Monoid RoutingError where
-  mempty = oneRE
-
-instance routingErrorSemiring :: Semiring RoutingError where
-  one = oneRE
-  zero = zeroRE
-  (+) = orRE
-  (*) = andRE
-
-instance routingErrorError :: Error RoutingError where
-  noMsg = zeroRE
-  strMsg msg = RoutingError [[msg]]

From 2c8689d3c1ebbdd7781741daf30c12b59e1ebafa Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Fri, 20 Mar 2015 18:24:24 +0300
Subject: [PATCH 11/18] removed log

---
 MODULES.md       | 7 -------
 src/Routing.purs | 3 ---
 2 files changed, 10 deletions(-)

diff --git a/MODULES.md b/MODULES.md
index d1f41df..f49c346 100644
--- a/MODULES.md
+++ b/MODULES.md
@@ -16,13 +16,6 @@ hashes :: forall e. (String -> String -> Eff e Unit) -> Eff e Unit
 ```
 
 
-#### `log`
-
-``` purescript
-log :: forall a e. a -> Eff e Unit
-```
-
-
 #### `matches`
 
 ``` purescript
diff --git a/src/Routing.purs b/src/Routing.purs
index af6f44a..87a728c 100644
--- a/src/Routing.purs
+++ b/src/Routing.purs
@@ -27,9 +27,6 @@ hashes cb =
     cb (dropHash old) (dropHash new)
   where dropHash h = R.replace (R.regex "^[^#]*#" R.noFlags) "" h
 
-foreign import log """
-function log(a) {return function() {console.log(a)}}
-""" :: forall a e. a -> Eff e Unit
 
 matches :: forall e a. Match a -> (Maybe a -> a -> Eff e Unit) -> Eff e Unit
 matches routing cb = hashes $ \old new -> 

From 556d2c8d820caecdeb3a8758671dfc4db86a1595 Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Fri, 20 Mar 2015 18:25:15 +0300
Subject: [PATCH 12/18] removed readme

---
 README.md | 56 -------------------------------------------------------
 1 file changed, 56 deletions(-)

diff --git a/README.md b/README.md
index 0f6d3c5..b099750 100644
--- a/README.md
+++ b/README.md
@@ -2,59 +2,3 @@
 
 [![Build Status](https://travis-ci.org/cryogenian/purescript-routing.svg?branch=master)](https://travis-ci.org/cryogenian/purescript-routing)
 
-Library to handle hash routing for purescript
-
-define route:
-
-```purescript
-routing :: PErr Route
-routing = do
-  notebook <- route "notebook" "notebook?foo&bar"
-  file <- route "file" "file/:id"
-  read <- route "read" "/read"
-  write <- route "write" "/write"
-  pure $ notebook `or` (file `contains` (read `or` write))
-  ```
-  
-It will match
-* `notebook?foo=12&bar=23` and `notebook?bar=12&foo=123`
-* `file/123` 
-* `file/123/write` 
-* `file/123/read` 
-
-When hash changes from something to `file/123/read` messages of `file` routing
-and `read` will be produced. When hash changes from `file/123` to `file/123/read` 
-only one message will be produced. 
-
-To get this messages it's necessary to define instance of `RouteDiff` i.e.
-```purescript
-instance tstRouteDiff :: RouteDiff Test where
-  fromMatch (Tuple "write" _) = Just Write
-  fromMatch (Tuple "read" _) = Just Read
-  fromMatch (Tuple "file" map) = do
-    f <- lookup "id" map
-    pure $ File f 
-  fromMatch (Tuple "notebook" map) = do
-    foo <- readFloat <$> lookup "foo" map
-    bar <- readFloat <$> lookup "bar" map
-    if isNaN foo || isNaN bar then
-      Nothing
-      else
-      pure $ Notebook foo bar
-  fromMatch _  = Nothing
-```
-
-then you can to use it with something like that 
-```purescript
-main = do
-  let fp :: Tuple Test [Test] -> Eff _ Unit
-      fp t = void $ fprint t
-  case routing of
-    Right r -> do
-      routes r $ \r -> void do
-        fp r
-    _ -> pure unit
-```
-
-If you have a state of application you can define instance of `RouteState` then 
-you can use `setRouteState` to update hash. 

From af8b057847a9667d13430809cbf1c2213a7ac228 Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Fri, 20 Mar 2015 18:35:06 +0300
Subject: [PATCH 13/18] forgot about decodeURIComponent

---
 src/Routing/Parser.purs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/Routing/Parser.purs b/src/Routing/Parser.purs
index be1e65d..53997d4 100644
--- a/src/Routing/Parser.purs
+++ b/src/Routing/Parser.purs
@@ -25,6 +25,8 @@ 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 <$> Path <$> S.split "/" hash
+parse hash = tryQuery <$> Path <$> decodeURIComponent <$> S.split "/" hash
 

From b6ad56780fdbbbc5b579541e94a7cd1f14a6ac18 Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Sat, 21 Mar 2015 00:58:34 +0300
Subject: [PATCH 14/18] removed bind, added num and bool, renamed var, switched
 to List

---
 src/Routing/Match.purs             | 45 ++++++++++++++++++++----------
 src/Routing/Match/Class.purs       |  8 ++++--
 src/Routing/Match/Combinators.purs | 18 ------------
 src/Routing/Parser.purs            |  8 ++++--
 src/Routing/Types.purs             |  3 +-
 test/Main.purs                     |  5 ++--
 6 files changed, 46 insertions(+), 41 deletions(-)
 delete mode 100644 src/Routing/Match/Combinators.purs

diff --git a/src/Routing/Match.purs b/src/Routing/Match.purs
index 72a3406..3b0ac80 100644
--- a/src/Routing/Match.purs
+++ b/src/Routing/Match.purs
@@ -3,13 +3,14 @@ module Routing.Match where
 import Data.Either
 import Data.Tuple
 import Data.Maybe
+import Data.List
 import Control.Alt
 import Control.Plus
 import Control.Apply
-import Control.MonadPlus
 import Control.Alternative
 import Control.Monad.Error 
 import qualified Data.StrMap as M
+import Global (readFloat, isNaN)
 
 import Routing.Parser
 import Routing.Types
@@ -21,24 +22,46 @@ instance matchMatchClass :: MatchClass Match where
   lit input = Match $ \route ->
     case route of
       -- TODO: check if (Path input):rs works probably ps bug.
-      (Path i):rs |i == input ->
+      Cons (Path i) rs | i == input ->
         Right $ Tuple rs unit
-      (Path _):_ -> Left <<< strMsg $ "expected path part \"" <> input <> "\""
+      Cons (Path _) _ -> 
+        Left <<< strMsg $ "expected path part \"" <> input <> "\""
       _ -> Left <<< strMsg $ "expected path part - found query"
-  var = Match $ \route ->
+  num = Match $ \route ->
     case route of
-      (Path input):rs -> Right $ Tuple rs input 
+      Cons (Path input) rs -> 
+        let res = readFloat input in
+        if isNaN res then Left <<< strMsg $ "expected numeric var"
+        else Right $ Tuple rs res
+      _ -> Left <<< strMsg $ "expected numeric var"
+
+  bool = Match $ \route ->
+    case route of
+      Cons (Path input) rs | input == "true" ->
+        Right $ Tuple rs true
+      Cons (Path input) rs | input == "false" -> 
+        Right $ Tuple rs false
+      _ -> Left <<< strMsg $ "expected boolean var"
+
+  str = Match $ \route ->
+    case route of
+      Cons (Path input) rs -> 
+        Right $ Tuple rs input 
       _ -> Left <<< strMsg $ "expected simple var - found query"
 
+
+
+
   param key = Match $ \route ->
     case route of
-      (Query map):rs ->
+      Cons (Query map) rs ->
         case M.lookup key map of
           Nothing -> Left <<< strMsg $ "key " <> key <> " not found in query"
-          Just el -> Right $ Tuple ((Query <<< M.delete key $ map):rs) el
+          Just el -> Right $ Tuple (Cons (Query <<< M.delete key $ map) rs) el
       _ -> Left <<< strMsg $ "expected query - found path"
   fail msg = Match \_ -> Left $ strMsg msg
 
+  
 
 instance matchFunctor :: Functor Match where
   (<$>) fn (Match r2e) = Match $ \r -> do
@@ -63,14 +86,8 @@ instance matchApply :: Apply Match where
 instance matchApplicative :: Applicative Match where
   pure a = Match \r -> Right $ Tuple r a
 
-instance matchBind :: Bind Match where
-  (>>=) (Match r2a) a2mb = Match $ \r -> do
-    Tuple rs a <- r2a r
-    case a2mb a of
-      Match res -> res rs
 
-instance matchMonad :: Monad Match
-instance matchMonadPlus :: MonadPlus Match
+
 
 
 runMatch :: forall a. Match a -> Route -> Either String a
diff --git a/src/Routing/Match/Class.purs b/src/Routing/Match/Class.purs
index 4abc477..e8cea9a 100644
--- a/src/Routing/Match/Class.purs
+++ b/src/Routing/Match/Class.purs
@@ -1,9 +1,11 @@
 module Routing.Match.Class where
 
-import Control.MonadPlus
+import Control.Alternative
 
-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
diff --git a/src/Routing/Match/Combinators.purs b/src/Routing/Match/Combinators.purs
deleted file mode 100644
index db3e1e3..0000000
--- a/src/Routing/Match/Combinators.purs
+++ /dev/null
@@ -1,18 +0,0 @@
-module Routing.Match.Combinators where
-
-import Routing.Match.Class
-import Global (readFloat, isNaN)
-
-num :: forall f. (MatchClass f) => String -> f Number
-num input =
-  let res = readFloat input in
-  case isNaN res of
-    true -> fail "not a number" 
-    false -> return res
-
-bool :: forall f. (MatchClass f) => String -> f Boolean
-bool input =
-  case input of
-    "true" -> pure true
-    "false" -> pure false
-    _ -> fail "not a boolean"
diff --git a/src/Routing/Parser.purs b/src/Routing/Parser.purs
index 53997d4..b3b8d4a 100644
--- a/src/Routing/Parser.purs
+++ b/src/Routing/Parser.purs
@@ -5,6 +5,7 @@ module Routing.Parser (
 import Control.MonadPlus
 import Data.Maybe
 import Data.Tuple
+import Data.List
 import Data.Traversable (traverse) 
 import qualified Data.StrMap as M
 import qualified Data.String as S
@@ -17,7 +18,7 @@ tryQuery :: RoutePart -> RoutePart
 tryQuery source@(Path string) = fromMaybe source $ do
   guard $ S.take 1 string == "?"
   let parts = S.split "&" $ S.drop 1 string
-  Query <$> M.fromList <$> traverse part2tuple parts
+  Query <$> M.fromList  <$> traverse part2tuple parts
   where part2tuple :: String -> Maybe (Tuple String String)
         part2tuple input = do
           let keyVal = S.split "=" input
@@ -28,5 +29,8 @@ tryQuery q = q
 foreign import decodeURIComponent :: String -> String
 
 parse :: String -> Route
-parse hash = tryQuery <$> Path <$> decodeURIComponent <$> S.split "/" hash
+parse hash = tryQuery <$>
+             Path <$>
+             decodeURIComponent <$>
+             fromArray (S.split "/" hash)
 
diff --git a/src/Routing/Types.purs b/src/Routing/Types.purs
index 0b45023..917aa16 100644
--- a/src/Routing/Types.purs
+++ b/src/Routing/Types.purs
@@ -1,6 +1,7 @@
 module Routing.Types where
 
 import qualified Data.StrMap as M
+import Data.List
 
 data RoutePart = Path String | Query (M.StrMap String)
-type Route = [RoutePart]
+type Route = List RoutePart
diff --git a/test/Main.purs b/test/Main.purs
index c3d5193..efe72f0 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -10,15 +10,14 @@ import Debug.Foreign
 import Routing
 import Routing.Match
 import Routing.Match.Class
-import Routing.Match.Combinators
 
 data FooBar = Foo Number | Bar Boolean String
 
 routing :: Match FooBar
 routing =
-  Foo <$> (lit "foo" *> (var >>= num))
+  Foo <$> (lit "foo" *> num)
   <|>
-  Bar <$> (lit "bar" *> (var >>= bool)) <*> (param "baz")
+  Bar <$> (lit "bar" *> bool) <*> (param "baz")
 
 main = do
   fprint $ matchHash routing "foo/asdf"

From b5b4e5527b7b813902414092574318fe08315b08 Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Mon, 23 Mar 2015 16:30:22 +0300
Subject: [PATCH 15/18] alt-validation

---
 src/Data/Semiring/Free.purs  | 51 +++++++++++++++++++
 src/Data/Validation/Alt.purs | 25 +++++++++
 src/Routing/Match.purs       | 98 +++++++++++++++++++++---------------
 src/Routing/Match/Error.purs | 31 ++++++++++++
 test/Main.purs               |  2 +-
 5 files changed, 166 insertions(+), 41 deletions(-)
 create mode 100644 src/Data/Semiring/Free.purs
 create mode 100644 src/Data/Validation/Alt.purs
 create mode 100644 src/Routing/Match/Error.purs

diff --git a/src/Data/Semiring/Free.purs b/src/Data/Semiring/Free.purs
new file mode 100644
index 0000000..30f8b12
--- /dev/null
+++ b/src/Data/Semiring/Free.purs
@@ -0,0 +1,51 @@
+module Data.Semiring.Free 
+  ( Free()
+  , runFree 
+  , free
+  , liftFree
+  , lowerFree
+  ) where
+ 
+import Data.Array
+import Data.Foldable (foldl)
+ 
+-- | The free `Semiring` for a type `a`.
+newtype Free a = Free [[a]]
+ 
+-- | Unpack a value of type `Free a`.
+runFree :: forall a. Free a -> [[a]]
+runFree (Free xs) = xs
+ 
+-- | Lift a value of type `a` to a value of type `Free a`
+free :: forall a. a -> Free a
+free a = Free [[a]]
+ 
+-- | `Free` is left adjoint to the forgetful functor from `Semiring`s to types.
+liftFree :: forall a s. (Semiring s) => (a -> s) -> Free a -> s
+liftFree f (Free xss) = sum (map (product <<< map f) xss)
+  where
+  sum = foldl (+) zero
+  product = foldl (*) one
+ 
+-- | `Free` is left adjoint to the forgetful functor from `Semiring`s to types.
+lowerFree :: forall a s. (Semiring s) => (Free a -> s) -> a -> s
+lowerFree f a = f (free a)
+ 
+instance showFree :: (Show a) => Show (Free a) where
+  show (Free xss) = "(Free " <> show xss <> ")"
+ 
+instance eqFree :: (Eq a) => Eq (Free a) where
+  (==) (Free xss) (Free yss) = xss == yss
+  (/=) (Free xss) (Free yss) = xss /= yss
+ 
+instance ordFree :: (Ord a) => Ord (Free a) where
+  compare (Free xss) (Free yss) = compare xss yss
+ 
+instance semiringFree :: Semiring (Free a) where
+  (+) (Free xss) (Free yss) = Free (xss <> yss)
+  zero = Free []
+  (*) (Free xss) (Free yss) = Free do
+    xs <- xss
+    ys <- yss
+    return (xs <> ys)
+  one = Free [[]]
diff --git a/src/Data/Validation/Alt.purs b/src/Data/Validation/Alt.purs
new file mode 100644
index 0000000..4b01fb4
--- /dev/null
+++ b/src/Data/Validation/Alt.purs
@@ -0,0 +1,25 @@
+-- | Alt validation over semiring
+module Data.Validation.Alt where
+
+import Control.Alt
+import Control.Apply
+
+data V err res = Valid res | Invalid err
+
+instance functorV :: Functor (V err)  where
+  (<$>) _ (Invalid err) = Invalid err
+  (<$>) f (Valid result) = Valid (f result)
+
+instance applyV :: (Semiring err) => Apply (V err)  where
+  (<*>) (Invalid err1) (Invalid err2) = Invalid (err1 * err2)
+  (<*>) (Invalid err) _ = Invalid err
+  (<*>) _ (Invalid err) = Invalid err
+  (<*>) (Valid f) (Valid x) = Valid (f x)
+
+instance applicativeV :: (Semiring err) => Applicative (V err) where
+  pure = Valid
+
+instance altV :: (Semiring err) => Alt (V err) where
+  (<|>) (Invalid err1) (Invalid err2) = Invalid (err1 + err2)
+  (<|>) (Invalid _) a = a
+  (<|>) (Valid a) _ = Valid a 
diff --git a/src/Routing/Match.purs b/src/Routing/Match.purs
index 3b0ac80..b603588 100644
--- a/src/Routing/Match.purs
+++ b/src/Routing/Match.purs
@@ -11,86 +11,104 @@ import Control.Alternative
 import Control.Monad.Error 
 import qualified Data.StrMap as M
 import Global (readFloat, isNaN)
+import Data.Semiring.Free
+import Data.Foldable
+import qualified Data.Array as A 
+import Data.Validation.Alt
 
 import Routing.Parser
 import Routing.Types
 import Routing.Match.Class
+import Routing.Match.Error
 
-newtype Match a = Match (Route -> Either String (Tuple Route a))
+newtype Match a = Match (Route -> V (Free MatchError) (Tuple Route a)) 
 
 instance matchMatchClass :: MatchClass Match where
   lit input = Match $ \route ->
     case route of
-      -- TODO: check if (Path input):rs works probably ps bug.
       Cons (Path i) rs | i == input ->
-        Right $ Tuple rs unit
-      Cons (Path _) _ -> 
-        Left <<< strMsg $ "expected path part \"" <> input <> "\""
-      _ -> Left <<< strMsg $ "expected path part - found query"
+        Valid $ Tuple rs unit
+      Cons (Path _) rs ->
+        Invalid $ free $  UnexpectedPath input
+      _ ->
+        Invalid $ free ExpectedPathPart
   num = Match $ \route ->
     case route of
       Cons (Path input) rs -> 
         let res = readFloat input in
-        if isNaN res then Left <<< strMsg $ "expected numeric var"
-        else Right $ Tuple rs res
-      _ -> Left <<< strMsg $ "expected numeric var"
+        if isNaN res then
+          Invalid $ free ExpectedNumber
+        else
+          Valid $ Tuple rs res 
+      _ ->
+        Invalid $ free ExpectedNumber
 
   bool = Match $ \route ->
     case route of
       Cons (Path input) rs | input == "true" ->
-        Right $ Tuple rs true
-      Cons (Path input) rs | input == "false" -> 
-        Right $ Tuple rs false
-      _ -> Left <<< strMsg $ "expected boolean var"
+        Valid $ Tuple rs true 
+      Cons (Path input) rs | input == "false" ->
+        Valid $ Tuple rs false 
+      _ ->
+        Invalid $ free ExpectedBoolean
 
   str = Match $ \route ->
     case route of
-      Cons (Path input) rs -> 
-        Right $ Tuple rs input 
-      _ -> Left <<< strMsg $ "expected simple var - found query"
-
-
-
+      Cons (Path input) rs ->
+        Valid $ Tuple rs input
+      _ ->
+        Invalid $ free ExpectedString
 
   param key = Match $ \route ->
     case route of
       Cons (Query map) rs ->
         case M.lookup key map of
-          Nothing -> Left <<< strMsg $ "key " <> key <> " not found in query"
-          Just el -> Right $ Tuple (Cons (Query <<< M.delete key $ map) rs) el
-      _ -> Left <<< strMsg $ "expected query - found path"
-  fail msg = Match \_ -> Left $ strMsg msg
-
-  
+          Nothing ->
+            Invalid $ free $ KeyNotFound key
+          Just el ->
+            Valid $ Tuple (Cons (Query <<< M.delete key $ map) rs) el
+      _ ->
+        Invalid $ free ExpectedQuery
+  fail msg = Match \_ ->
+    Invalid $ free $ Fail msg
 
 instance matchFunctor :: Functor Match where
-  (<$>) fn (Match r2e) = Match $ \r -> do
-    Tuple rs a <- r2e r
-    pure $ Tuple rs (fn a)
+  (<$>) fn (Match r2e) = Match $ \r ->
+    case r2e r of
+      Invalid a -> Invalid a
+      Valid (Tuple rs a) -> Valid (Tuple rs (fn a))
+
 
 instance matchAlt :: Alt Match where
   (<|>) (Match r2e1) (Match r2e2) = Match $ \r -> do
     (r2e1 r) <|> (r2e2 r)
-
 instance matchPlus :: Plus Match where
-  empty = Match $ const $ Left noMsg
+  empty = Match $ const $ Invalid one
 
 instance matchAlternative :: Alternative Match
 
 instance matchApply :: Apply Match where
   (<*>) (Match r2a2b) (Match r2a) = Match $ \r -> do
-    Tuple rs fn <- r2a2b r
-    Tuple rss a <- r2a rs
-    pure $ Tuple rss (fn a)
+    case r2a2b r of
+      Invalid err ->
+        case r2a r of
+          Invalid err' -> Invalid (err * err')
+          _ -> Invalid err
+      Valid (Tuple rs a2b)  ->
+        case r2a rs of -- `rs` here not r, so we can't use `<*>` from `V`
+          Invalid err -> Invalid err
+          Valid (Tuple rss a) -> Valid $ Tuple rss (a2b a)
 
 instance matchApplicative :: Applicative Match where
-  pure a = Match \r -> Right $ Tuple r a
-
-
-
-
+  pure a = Match \r -> pure $ Tuple r a
 
+-- 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
-runMatch (Match fn) route = snd <$> fn route
-                   
+runMatch (Match fn) route =
+  case fn route of
+    Valid res -> Right $ snd res
+    Invalid errs -> Left $ foldl (\b a -> a <> "\n" <> b) "" do
+      es <- A.reverse <$> runFree errs
+      pure $ foldl (\b a -> a <> ";" <> b) "" $ showMatchError <$>  es
     
diff --git a/src/Routing/Match/Error.purs b/src/Routing/Match/Error.purs
new file mode 100644
index 0000000..766c325
--- /dev/null
+++ b/src/Routing/Match/Error.purs
@@ -0,0 +1,31 @@
+module Routing.Match.Error where
+
+data MatchError
+  -- expected other path part
+  = UnexpectedPath String
+    -- expected "true" or "false"
+  | ExpectedBoolean
+    -- expected numeric literal
+  | ExpectedNumber
+    -- expected string literal (found query probably or eol) 
+  | ExpectedString
+    -- expected query found path part or eol
+  | ExpectedQuery
+    -- expected path part found query or eol
+  | ExpectedPathPart
+    -- there is no such key in query
+  | KeyNotFound String
+    -- custom fail
+  | Fail String 
+
+showMatchError :: MatchError -> String
+showMatchError err =
+  case err of
+    UnexpectedPath str -> "expected path part: " <> str
+    KeyNotFound str -> "key: " <> str <> " has not found in query part"
+    ExpectedQuery -> "expected query - found path"
+    ExpectedNumber -> "expected number"
+    ExpectedBoolean -> "expected boolean"
+    ExpectedString -> "expected string var"
+    ExpectedPathPart -> "expected path part, found query"
+    Fail str -> "match error: " <> str
diff --git a/test/Main.purs b/test/Main.purs
index efe72f0..f5518d1 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -20,7 +20,7 @@ routing =
   Bar <$> (lit "bar" *> bool) <*> (param "baz")
 
 main = do
-  fprint $ matchHash routing "foo/asdf"
+  fprint $ matchHash routing "food/asdf"
   matches routing $ \old new -> void $ do
     fprint old
     fprint new

From c87587dd168e173ab845cfd8cedb9a3cbcdcc969 Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Mon, 23 Mar 2015 20:32:21 +0300
Subject: [PATCH 16/18] since Validation constructors are hidden, rewrite cases
 in Match. Deleted Match folder

---
 bower.json                   |  4 ++-
 src/Data/Semiring/Free.purs  | 51 ---------------------------
 src/Data/Validation/Alt.purs | 25 -------------
 src/Routing/Match.purs       | 68 +++++++++++++++++-------------------
 4 files changed, 35 insertions(+), 113 deletions(-)
 delete mode 100644 src/Data/Semiring/Free.purs
 delete mode 100644 src/Data/Validation/Alt.purs

diff --git a/bower.json b/bower.json
index ddd0302..c9cc9ce 100644
--- a/bower.json
+++ b/bower.json
@@ -23,7 +23,9 @@
     "purescript-control": "~0.2.2",
     "purescript-transformers": "~0.5.1",
     "purescript-arrays": "~0.3.3",
-    "purescript-monoid": "~0.2.0"
+    "purescript-monoid": "~0.2.0",
+    "purescript-validation": "https://github.com/cryogenian/purescript-validation.git#master",
+    "purescript-semirings": "https://github.com/cryogenian/purescript-semirings.git"
   },
   "devDependencies": {
     "purescript-timers": "~0.0.8",
diff --git a/src/Data/Semiring/Free.purs b/src/Data/Semiring/Free.purs
deleted file mode 100644
index 30f8b12..0000000
--- a/src/Data/Semiring/Free.purs
+++ /dev/null
@@ -1,51 +0,0 @@
-module Data.Semiring.Free 
-  ( Free()
-  , runFree 
-  , free
-  , liftFree
-  , lowerFree
-  ) where
- 
-import Data.Array
-import Data.Foldable (foldl)
- 
--- | The free `Semiring` for a type `a`.
-newtype Free a = Free [[a]]
- 
--- | Unpack a value of type `Free a`.
-runFree :: forall a. Free a -> [[a]]
-runFree (Free xs) = xs
- 
--- | Lift a value of type `a` to a value of type `Free a`
-free :: forall a. a -> Free a
-free a = Free [[a]]
- 
--- | `Free` is left adjoint to the forgetful functor from `Semiring`s to types.
-liftFree :: forall a s. (Semiring s) => (a -> s) -> Free a -> s
-liftFree f (Free xss) = sum (map (product <<< map f) xss)
-  where
-  sum = foldl (+) zero
-  product = foldl (*) one
- 
--- | `Free` is left adjoint to the forgetful functor from `Semiring`s to types.
-lowerFree :: forall a s. (Semiring s) => (Free a -> s) -> a -> s
-lowerFree f a = f (free a)
- 
-instance showFree :: (Show a) => Show (Free a) where
-  show (Free xss) = "(Free " <> show xss <> ")"
- 
-instance eqFree :: (Eq a) => Eq (Free a) where
-  (==) (Free xss) (Free yss) = xss == yss
-  (/=) (Free xss) (Free yss) = xss /= yss
- 
-instance ordFree :: (Ord a) => Ord (Free a) where
-  compare (Free xss) (Free yss) = compare xss yss
- 
-instance semiringFree :: Semiring (Free a) where
-  (+) (Free xss) (Free yss) = Free (xss <> yss)
-  zero = Free []
-  (*) (Free xss) (Free yss) = Free do
-    xs <- xss
-    ys <- yss
-    return (xs <> ys)
-  one = Free [[]]
diff --git a/src/Data/Validation/Alt.purs b/src/Data/Validation/Alt.purs
deleted file mode 100644
index 4b01fb4..0000000
--- a/src/Data/Validation/Alt.purs
+++ /dev/null
@@ -1,25 +0,0 @@
--- | Alt validation over semiring
-module Data.Validation.Alt where
-
-import Control.Alt
-import Control.Apply
-
-data V err res = Valid res | Invalid err
-
-instance functorV :: Functor (V err)  where
-  (<$>) _ (Invalid err) = Invalid err
-  (<$>) f (Valid result) = Valid (f result)
-
-instance applyV :: (Semiring err) => Apply (V err)  where
-  (<*>) (Invalid err1) (Invalid err2) = Invalid (err1 * err2)
-  (<*>) (Invalid err) _ = Invalid err
-  (<*>) _ (Invalid err) = Invalid err
-  (<*>) (Valid f) (Valid x) = Valid (f x)
-
-instance applicativeV :: (Semiring err) => Applicative (V err) where
-  pure = Valid
-
-instance altV :: (Semiring err) => Alt (V err) where
-  (<|>) (Invalid err1) (Invalid err2) = Invalid (err1 + err2)
-  (<|>) (Invalid _) a = a
-  (<|>) (Valid a) _ = Valid a 
diff --git a/src/Routing/Match.purs b/src/Routing/Match.purs
index b603588..419ebd4 100644
--- a/src/Routing/Match.purs
+++ b/src/Routing/Match.purs
@@ -14,7 +14,7 @@ import Global (readFloat, isNaN)
 import Data.Semiring.Free
 import Data.Foldable
 import qualified Data.Array as A 
-import Data.Validation.Alt
+import Data.Validation.Semiring
 
 import Routing.Parser
 import Routing.Types
@@ -27,77 +27,71 @@ instance matchMatchClass :: MatchClass Match where
   lit input = Match $ \route ->
     case route of
       Cons (Path i) rs | i == input ->
-        Valid $ Tuple rs unit
+        pure $ Tuple rs unit
       Cons (Path _) rs ->
-        Invalid $ free $  UnexpectedPath input
+        invalid $ free $  UnexpectedPath input
       _ ->
-        Invalid $ free ExpectedPathPart
+        invalid $ free ExpectedPathPart
   num = Match $ \route ->
     case route of
       Cons (Path input) rs -> 
         let res = readFloat input in
         if isNaN res then
-          Invalid $ free ExpectedNumber
+          invalid $ free ExpectedNumber
         else
-          Valid $ Tuple rs res 
+          pure $ Tuple rs res 
       _ ->
-        Invalid $ free ExpectedNumber
+        invalid $ free ExpectedNumber
 
   bool = Match $ \route ->
     case route of
       Cons (Path input) rs | input == "true" ->
-        Valid $ Tuple rs true 
+        pure $ Tuple rs true 
       Cons (Path input) rs | input == "false" ->
-        Valid $ Tuple rs false 
+        pure $ Tuple rs false 
       _ ->
-        Invalid $ free ExpectedBoolean
+        invalid $ free ExpectedBoolean
 
   str = Match $ \route ->
     case route of
       Cons (Path input) rs ->
-        Valid $ Tuple rs input
+        pure $ Tuple rs input
       _ ->
-        Invalid $ free ExpectedString
+        invalid $ free ExpectedString
 
   param key = Match $ \route ->
     case route of
       Cons (Query map) rs ->
         case M.lookup key map of
           Nothing ->
-            Invalid $ free $ KeyNotFound key
+            invalid $ free $ KeyNotFound key
           Just el ->
-            Valid $ Tuple (Cons (Query <<< M.delete key $ map) rs) el
+            pure $ Tuple (Cons (Query <<< M.delete key $ map) rs) el
       _ ->
-        Invalid $ free ExpectedQuery
+        invalid $ free ExpectedQuery
   fail msg = Match \_ ->
-    Invalid $ free $ Fail msg
+    invalid $ free $ Fail msg
 
 instance matchFunctor :: Functor Match where
   (<$>) fn (Match r2e) = Match $ \r ->
-    case r2e r of
-      Invalid a -> Invalid a
-      Valid (Tuple rs a) -> Valid (Tuple rs (fn a))
-
+    runV invalid (\(Tuple rs a) -> pure $ Tuple rs (fn a)) $ r2e r
 
 instance matchAlt :: Alt Match where
   (<|>) (Match r2e1) (Match r2e2) = Match $ \r -> do
     (r2e1 r) <|> (r2e2 r)
+    
 instance matchPlus :: Plus Match where
-  empty = Match $ const $ Invalid one
+  empty = Match $ const $ invalid one
 
 instance matchAlternative :: Alternative Match
 
 instance matchApply :: Apply Match where
-  (<*>) (Match r2a2b) (Match r2a) = Match $ \r -> do
-    case r2a2b r of
-      Invalid err ->
-        case r2a r of
-          Invalid err' -> Invalid (err * err')
-          _ -> Invalid err
-      Valid (Tuple rs a2b)  ->
-        case r2a rs of -- `rs` here not r, so we can't use `<*>` from `V`
-          Invalid err -> Invalid err
-          Valid (Tuple rss a) -> Valid $ Tuple rss (a2b a)
+  (<*>) (Match r2a2b) (Match r2a) = 
+    Match $ (\r -> runV (processFnErr r) processFnRes (r2a2b r))
+    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
@@ -106,9 +100,11 @@ instance matchApplicative :: Applicative Match where
 -- [[String]] -fold with semicolon-> [String] -fold with newline-> String 
 runMatch :: forall a. Match a -> Route -> Either String a
 runMatch (Match fn) route =
-  case fn route of
-    Valid res -> Right $ snd res
-    Invalid errs -> Left $ foldl (\b a -> a <> "\n" <> b) "" do
-      es <- A.reverse <$> runFree errs
-      pure $ foldl (\b a -> a <> ";" <> b) "" $ showMatchError <$>  es
+  runV foldErrors (Right <<< snd) $ fn route
+  where foldErrors errs = Left $ 
+          foldl (\b a -> a <> "\n" <> b) "" do
+            es <- A.reverse <$> runFree errs
+            pure $ foldl (\b a -> a <> ";" <> b) "" $ showMatchError <$>  es
+
+
     

From 032975e81bc7fc2ca7e6acb8562d622ed9290ebf Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Mon, 23 Mar 2015 21:22:53 +0300
Subject: [PATCH 17/18] moved to central deps

---
 bower.json | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/bower.json b/bower.json
index c9cc9ce..7d18aed 100644
--- a/bower.json
+++ b/bower.json
@@ -24,8 +24,8 @@
     "purescript-transformers": "~0.5.1",
     "purescript-arrays": "~0.3.3",
     "purescript-monoid": "~0.2.0",
-    "purescript-validation": "https://github.com/cryogenian/purescript-validation.git#master",
-    "purescript-semirings": "https://github.com/cryogenian/purescript-semirings.git"
+    "purescript-validation": "~0.1.1",
+    "purescript-semirings": "https://github.com/purescript/purescript-semirings.git#~0.1.1"
   },
   "devDependencies": {
     "purescript-timers": "~0.0.8",

From 99d05aefa2eba7e748c8fe68e70e14470ca0dba1 Mon Sep 17 00:00:00 2001
From: Maxim Zimaliev <zimaliev@yandex.ru>
Date: Mon, 23 Mar 2015 21:55:12 +0300
Subject: [PATCH 18/18] done

---
 bower.json | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/bower.json b/bower.json
index 7d18aed..fbecab6 100644
--- a/bower.json
+++ b/bower.json
@@ -25,7 +25,7 @@
     "purescript-arrays": "~0.3.3",
     "purescript-monoid": "~0.2.0",
     "purescript-validation": "~0.1.1",
-    "purescript-semirings": "https://github.com/purescript/purescript-semirings.git#~0.1.1"
+    "purescript-semirings": "~0.1.1"
   },
   "devDependencies": {
     "purescript-timers": "~0.0.8",