Initial yesod-routes, doesn't do much yet

yesod-routes/LICENSE

@@ -0,0 +1,25 @@
+The following license covers this documentation, and the source code, except
+where otherwise indicated.
+
+Copyright 2010, Michael Snoyman. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright notice,
+  this list of conditions and the following disclaimer in the documentation
+  and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

yesod-routes/Setup.lhs

@@ -0,0 +1,7 @@
+#!/usr/bin/env runhaskell
+
+> module Main where
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain

yesod-routes/Yesod/Routes.hs

@@ -0,0 +1,57 @@
+module Yesod.Routes
+    ( Piece (..)
+    , RouteHandler (..)
+    , toDispatch
+    , Dispatch
+    ) where
+
+import Data.Text (Text)
+import Web.ClientSession (Key)
+import Yesod.Core (Route)
+import qualified Data.Vector as V
+import Data.Maybe (fromMaybe)
+
+data Piece = StaticPiece Text | SinglePiece
+
+data RouteHandler sub master res = RouteHandler
+    { rhPieces :: [Piece]
+    , rhHasMulti :: Bool
+    , rhHandler :: Dispatch sub master res
+    }
+
+type Dispatch sub master res = sub -> Maybe Key -> [Text] -> master -> (Route sub -> Route master) -> Maybe res
+
+toDispatch :: [RouteHandler sub master res] -> Dispatch sub master res
+toDispatch rhs =
+    bcToDispatch bc
+  where
+    bc = toBC rhs
+
+bcToDispatch :: ByCount sub master res -> Dispatch sub master res
+bcToDispatch (ByCount vec rest) sub mkey ts master toMaster =
+    go rhs
+  where
+    len = length ts
+    rhs = fromMaybe rest $ vec V.!? len
+
+    go [] = Nothing
+    go (x:xs) = maybe (go xs) Just $ rhHandler x sub mkey ts master toMaster
+
+data ByCount sub master res = ByCount
+    { bcVector :: !(V.Vector [RouteHandler sub master res])
+    , bcRest :: ![RouteHandler sub master res]
+    }
+
+toBC :: [RouteHandler sub master res] -> ByCount sub master res
+toBC rhs =
+    ByCount
+        { bcVector = V.map (\i -> filter (canHaveLength i) rhs) $ V.enumFromN 0 (maxLen + 1)
+        , bcRest = filter rhHasMulti rhs
+        }
+  where
+    maxLen = maximum $ map (length . rhPieces) rhs
+
+    canHaveLength i rh =
+        len == i || (len < i && rhHasMulti rh)
+      where
+        len = length $ rhPieces rh

yesod-routes/test/main.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE OverloadedStrings #-}
+import Test.Hspec.Monadic
+import Test.Hspec.HUnit ()
+import Test.HUnit ((@?=))
+import Data.Text (Text)
+import Yesod.Routes
+
+data Dummy = Dummy
+
+result :: ([Text] -> Maybe Int) -> Dispatch sub master Int
+result f _ _ ts _ _ = f ts
+
+justRoot :: Dispatch Dummy Dummy Int
+justRoot = toDispatch
+    [ RouteHandler [] False $ result $ const $ Just 1
+    ]
+
+test :: Dispatch Dummy Dummy Int -> [Text] -> Maybe Int
+test dispatch ts = dispatch Dummy Nothing ts Dummy id
+
+main :: IO ()
+main = hspecX $ do
+    describe "justRoot" $ do
+        it "dispatches correctly" $ test justRoot [] @?= Just 1
+        it "fails correctly" $ test justRoot ["foo"] @?= Nothing

yesod-routes/yesod-routes.cabal

@@ -0,0 +1,39 @@
+name:            yesod-routes
+version:         0.0.0
+license:         BSD3
+license-file:    LICENSE
+author:          Michael Snoyman <michael@snoyman.com>
+maintainer:      Michael Snoyman <michael@snoyman.com>
+synopsis:        Efficient routing for Yesod.
+category:        Web, Yesod
+stability:       Stable
+cabal-version:   >= 1.8
+build-type:      Simple
+homepage:        http://www.yesodweb.com/
+
+library
+    build-depends:   base                      >= 4        && < 5
+                   , yesod-core                >= 0.9.3    && < 0.10
+                   , text                      >= 0.5      && < 0.12
+                   , vector                    >= 0.8      && < 0.10
+                   , clientsession             >= 0.7      && < 0.8
+
+    exposed-modules: Yesod.Routes
+    ghc-options:     -Wall
+
+test-suite runtests
+    type: exitcode-stdio-1.0
+    main-is: main.hs
+    hs-source-dirs: test
+
+    type: exitcode-stdio-1.0
+    build-depends: base                      >= 4.3      && < 5
+                 , yesod-routes
+                 , text                      >= 0.5      && < 0.12
+                 , HUnit                     >= 1.2      && < 1.3
+                 , hspec                     >= 0.6      && < 0.9
+    ghc-options:     -Wall
+
+source-repository head
+  type:     git
+  location: git://github.com/yesodweb/yesod.git