From 3178a584d010929307c97b4927a9cbd020929722 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 28 Sep 2011 10:42:14 +0300 Subject: [PATCH] Initial yesod-routes, doesn't do much yet --- yesod-routes/LICENSE | 25 +++++++++++++++ yesod-routes/Setup.lhs | 7 ++++ yesod-routes/Yesod/Routes.hs | 57 +++++++++++++++++++++++++++++++++ yesod-routes/test/main.hs | 25 +++++++++++++++ yesod-routes/yesod-routes.cabal | 39 ++++++++++++++++++++++ 5 files changed, 153 insertions(+) create mode 100644 yesod-routes/LICENSE create mode 100755 yesod-routes/Setup.lhs create mode 100644 yesod-routes/Yesod/Routes.hs create mode 100644 yesod-routes/test/main.hs create mode 100644 yesod-routes/yesod-routes.cabal diff --git a/yesod-routes/LICENSE b/yesod-routes/LICENSE new file mode 100644 index 00000000..8643e5d8 --- /dev/null +++ b/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. diff --git a/yesod-routes/Setup.lhs b/yesod-routes/Setup.lhs new file mode 100755 index 00000000..06e2708f --- /dev/null +++ b/yesod-routes/Setup.lhs @@ -0,0 +1,7 @@ +#!/usr/bin/env runhaskell + +> module Main where +> import Distribution.Simple + +> main :: IO () +> main = defaultMain diff --git a/yesod-routes/Yesod/Routes.hs b/yesod-routes/Yesod/Routes.hs new file mode 100644 index 00000000..7a4816fd --- /dev/null +++ b/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 diff --git a/yesod-routes/test/main.hs b/yesod-routes/test/main.hs new file mode 100644 index 00000000..f2726638 --- /dev/null +++ b/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 diff --git a/yesod-routes/yesod-routes.cabal b/yesod-routes/yesod-routes.cabal new file mode 100644 index 00000000..6627ff50 --- /dev/null +++ b/yesod-routes/yesod-routes.cabal @@ -0,0 +1,39 @@ +name: yesod-routes +version: 0.0.0 +license: BSD3 +license-file: LICENSE +author: Michael Snoyman +maintainer: Michael Snoyman +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