snap-core 0.6.0.1 → 0.7
raw patch · 13 files changed
+298/−104 lines, 13 filesdep ~attoparsecdep ~attoparsec-enumeratordep ~case-insensitive
Dependency ranges changed: attoparsec, attoparsec-enumerator, case-insensitive, regex-posix, time
Files
- CONTRIBUTORS +1/−0
- snap-core.cabal +9/−8
- src/Snap/Core.hs +2/−0
- src/Snap/Internal/Parsing.hs +13/−13
- src/Snap/Internal/Parsing/FastSet.hs +118/−0
- src/Snap/Internal/Routing.hs +56/−24
- src/Snap/Internal/Types.hs +16/−0
- src/Snap/Iteratee.hs +3/−2
- src/Snap/Util/FileServe.hs +1/−1
- src/Snap/Util/FileUploads.hs +1/−1
- src/Snap/Util/GZip.hs +2/−2
- test/snap-core-testsuite.cabal +3/−3
- test/suite/Snap/Internal/Routing/Tests.hs +73/−50
CONTRIBUTORS view
@@ -8,3 +8,4 @@ Jonas Kramer <jkramer@nex.scrapping.cc> Jurriën Stutterheim <j.stutterheim@me.com> Jasper Van der Jeugt <m@jaspervdj.be>+Bryan O'Sullivan <bos@serpentine.com>
snap-core.cabal view
@@ -1,5 +1,5 @@ name: snap-core-version: 0.6.0.1+version: 0.7 synopsis: Snap: A Haskell Web Framework (Core) description:@@ -45,7 +45,7 @@ build-type: Simple cabal-version: >= 1.6 homepage: http://snapframework.com/-category: Web+category: Web, Snap extra-source-files: test/suite/TestSuite.hs,@@ -91,7 +91,7 @@ logging, and this introduces a tiny amount of overhead (a call into a function pointer) because the calls to 'debug' cannot be inlined.- + Default: False @@ -128,6 +128,7 @@ other-modules: Snap.Internal.Instances, Snap.Internal.Iteratee.BoyerMooreHorspool,+ Snap.Internal.Parsing.FastSet, Snap.Internal.Routing, Snap.Internal.Types, Snap.Internal.Test.RequestBuilder,@@ -135,15 +136,15 @@ build-depends:- attoparsec >= 0.8.0.2 && < 0.10,- attoparsec-enumerator >= 0.2.0.3,+ attoparsec >= 0.10 && < 0.11,+ attoparsec-enumerator >= 0.3 && <0.4, base >= 4 && < 5, base16-bytestring <= 0.2, blaze-builder >= 0.2.1.4 && <0.4, blaze-builder-enumerator >= 0.2 && <0.3, bytestring, bytestring-nums,- case-insensitive >= 0.3 && < 0.4,+ case-insensitive >= 0.3 && < 0.5, containers, deepseq >= 1.1 && <1.3, directory,@@ -156,9 +157,9 @@ mwc-random >= 0.10 && <0.11, old-locale, old-time,- regex-posix <= 0.94.4,+ regex-posix <= 0.95.2, text >= 0.11 && <0.12,- time >= 1.0 && < 1.4,+ time >= 1.0 && < 1.5, transformers == 0.2.*, unix-compat >= 0.2 && <0.4, unordered-containers >= 0.1.4.3 && <0.2,
src/Snap/Core.hs view
@@ -33,7 +33,9 @@ -- ** Access to state , getRequest+ , getsRequest , getResponse+ , getsResponse , putRequest , putResponse , modifyRequest
src/Snap/Internal/Parsing.hs view
@@ -7,10 +7,8 @@ import Control.Applicative import Control.Arrow (first, second) import Control.Monad-import Data.Attoparsec.Char8 hiding (Done, many)-import qualified Data.Attoparsec.Char8 as Atto-import Data.Attoparsec.FastSet (FastSet)-import qualified Data.Attoparsec.FastSet as FS+import Data.Attoparsec.Types (IResult(..))+import Data.Attoparsec.Char8 import Data.Bits import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S@@ -34,15 +32,17 @@ ------------------------------------------------------------------------------ import Snap.Internal.Http.Types+import Snap.Internal.Parsing.FastSet (FastSet)+import qualified Snap.Internal.Parsing.FastSet as FS ------------------------------------------------------------------------------ fullyParse :: ByteString -> Parser a -> Either String a fullyParse s p = case r' of- (Fail _ _ e) -> Left e- (Partial _) -> Left "parse failed"- (Atto.Done _ x) -> Right x+ (Fail _ _ e) -> Left e+ (Partial _) -> Left "parse failed"+ (Done _ x) -> Right x where r = parse p s r' = feed r ""@@ -50,7 +50,7 @@ ------------------------------------------------------------------------------ parseNum :: Parser Int64-parseNum = liftM int $ Atto.takeWhile1 Atto.isDigit+parseNum = liftM int $ takeWhile1 isDigit ------------------------------------------------------------------------------@@ -257,8 +257,8 @@ where r = parse p s - toResult (Atto.Done _ c) = Just c- toResult _ = Nothing+ toResult (Done _ c) = Just c+ toResult _ = Nothing ------------------------------------------------------------------------------@@ -351,9 +351,9 @@ -------------------------------------------------------------------------------finish :: Atto.Result a -> Atto.Result a-finish (Atto.Partial f) = flip feed "" $ f ""-finish x = x+finish :: Result a -> Result a+finish (Partial f) = flip feed "" $ f ""+finish x = x
+ src/Snap/Internal/Parsing/FastSet.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE BangPatterns, MagicHash #-}++-----------------------------------------------------------------------------+-- |+-- Module : Snap.Internal.Parsing.FastSet+-- Copyright : Bryan O'Sullivan 2008+-- License : BSD3+-- +-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : unknown+--+-- Fast set membership tests for 'Word8' and 8-bit 'Char' values. The+-- set representation is unboxed for efficiency. For small sets, we+-- test for membership using a binary search. For larger sets, we use+-- a lookup table.+--+-- Note: this module copied here from the attoparsec source because it was made+-- private in version 0.10.+-- +-----------------------------------------------------------------------------+module Snap.Internal.Parsing.FastSet+ (+ -- * Data type+ FastSet+ -- * Construction+ , fromList+ , set+ -- * Lookup+ , memberChar+ , memberWord8+ -- * Debugging+ , fromSet+ -- * Handy interface+ , charClass+ ) where++import Data.Bits ((.&.), (.|.))+import Foreign.Storable (peekByteOff, pokeByteOff)+import GHC.Base (Int(I#), iShiftRA#, narrow8Word#, shiftL#)+import GHC.Word (Word8(W8#))+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Internal as I+import qualified Data.ByteString.Unsafe as U++data FastSet = Sorted { fromSet :: !B.ByteString }+ | Table { fromSet :: !B.ByteString }+ deriving (Eq, Ord)++instance Show FastSet where+ show (Sorted s) = "FastSet Sorted " ++ show (B8.unpack s)+ show (Table _) = "FastSet Table"++-- | The lower bound on the size of a lookup table. We choose this to+-- balance table density against performance.+tableCutoff :: Int+tableCutoff = 8++-- | Create a set.+set :: B.ByteString -> FastSet+set s | B.length s < tableCutoff = Sorted . B.sort $ s+ | otherwise = Table . mkTable $ s++fromList :: [Word8] -> FastSet+fromList = set . B.pack++data I = I {-# UNPACK #-} !Int {-# UNPACK #-} !Word8++shiftR :: Int -> Int -> Int+shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)++shiftL :: Word8 -> Int -> Word8+shiftL (W8# x#) (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#))++index :: Int -> I+index i = I (i `shiftR` 3) (1 `shiftL` (i .&. 7))+{-# INLINE index #-}++-- | Check the set for membership.+memberWord8 :: Word8 -> FastSet -> Bool+memberWord8 w (Table t) =+ let I byte bit = index (fromIntegral w)+ in U.unsafeIndex t byte .&. bit /= 0+memberWord8 w (Sorted s) = search 0 (B.length s - 1)+ where search lo hi+ | hi < lo = False+ | otherwise =+ let mid = (lo + hi) `div` 2+ in case compare w (U.unsafeIndex s mid) of+ GT -> search (mid + 1) hi+ LT -> search lo (mid - 1)+ _ -> True++-- | Check the set for membership. Only works with 8-bit characters:+-- characters above code point 255 will give wrong answers.+memberChar :: Char -> FastSet -> Bool+memberChar c = memberWord8 (I.c2w c)+{-# INLINE memberChar #-}++mkTable :: B.ByteString -> B.ByteString+mkTable s = I.unsafeCreate 32 $ \t -> do+ _ <- I.memset t 0 32+ U.unsafeUseAsCStringLen s $ \(p, l) ->+ let loop n | n == l = return ()+ | otherwise = do+ c <- peekByteOff p n :: IO Word8+ let I byte bit = index (fromIntegral c)+ prev <- peekByteOff t byte :: IO Word8+ pokeByteOff t byte (prev .|. bit)+ loop (n + 1)+ in loop 0++charClass :: String -> FastSet+charClass = set . B8.pack . go+ where go (a:'-':b:xs) = [a..b] ++ go xs+ go (x:xs) = x : go xs+ go _ = ""
src/Snap/Internal/Routing.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Rank2Types #-} module Snap.Internal.Routing where @@ -90,15 +91,19 @@ routeHeight r = case r of NoRoute -> 1 (Action _) -> 1- (Capture _ r' _) -> 1+routeHeight r'- (Dir rm _) -> 1+foldl max 1 (map routeHeight $ Map.elems rm)+ (Capture _ r' _) -> 1 + routeHeight r'+ (Dir rm _) -> 1 + foldl max 1 (map routeHeight $ Map.elems rm)+{-# INLINE routeHeight #-} ++------------------------------------------------------------------------------ routeEarliestNC :: Route a m -> Int -> Int routeEarliestNC r n = case r of NoRoute -> n (Action _) -> n (Capture _ r' _) -> routeEarliestNC r' n+1 (Dir _ _) -> n+{-# INLINE routeEarliestNC #-} ------------------------------------------------------------------------------@@ -150,12 +155,29 @@ -- > , ("article/:id", renderArticle) -- > , ("login", method POST doLogin) ] --+--+-- /URL decoding/+--+-- A short note about URL decoding: path matching and variable capture are done+-- on /decoded/ URLs, but the contents of 'rqContextPath' and 'rqPathInfo' will+-- contain the original encoded URL, i.e. what the user entered. For example,+-- in the following scenario:+--+-- > route [ ("a b c d/", foo ) ]+--+-- A request for \"@/a+b+c+d@\" will be sent to @foo@ with 'rqContextPath' set+-- to \"/a+b+c+d/\".+--+-- This behaviour changed as of Snap 0.6.1; previous versions had unspecified+-- (and buggy!) semantics here.+-- route :: MonadSnap m => [(ByteString, m a)] -> m a route rts = do- p <- getRequest >>= maybe pass return . urlDecode . rqPathInfo- route' (return ()) ([], splitPath p) Map.empty rts'+ p <- getsRequest rqPathInfo+ route' (return ()) [] (splitPath p) Map.empty rts' where rts' = mconcat (map pRoute rts)+{-# INLINE route #-} ------------------------------------------------------------------------------@@ -168,18 +190,19 @@ req <- getRequest let ctx = rqContextPath req let p = rqPathInfo req- p' <- maybe pass return $ urlDecode p let md = modifyRequest $ \r -> r {rqContextPath=ctx, rqPathInfo=p} - (route' md ([], splitPath p') Map.empty rts') <|> (md >> pass)+ (route' md [] (splitPath p) Map.empty rts') <|> (md >> pass) where rts' = mconcat (map pRoute rts)+{-# INLINE routeLocal #-} ------------------------------------------------------------------------------ splitPath :: ByteString -> [ByteString] splitPath = B.splitWith (== (c2w '/'))+{-# INLINE splitPath #-} ------------------------------------------------------------------------------@@ -190,16 +213,19 @@ f s rt = if B.head s == c2w ':' then Capture (B.tail s) rt NoRoute else Dir (Map.fromList [(s, rt)]) NoRoute+{-# INLINE pRoute #-} ------------------------------------------------------------------------------ route' :: MonadSnap m- => m ()- -> ([ByteString], [ByteString])+ => m () -- ^ action to run before we call the user handler+ -> [ByteString] -- ^ the \"context\"; the list of path segments we've+ -- already successfully matched, in reverse order+ -> [ByteString] -- ^ the list of path segments we haven't yet matched -> Params -> Route a m -> m a-route' pre (ctx, _) params (Action action) =+route' pre !ctx _ !params (Action action) = localRequest (updateContextPath (B.length ctx') . updateParams) (pre >> action) where@@ -207,20 +233,26 @@ updateParams req = req { rqParams = Map.unionWith (++) params (rqParams req) } -route' pre (ctx, []) params (Capture _ _ fb) =- route' pre (ctx, []) params fb-route' pre (ctx, cwd:rest) params (Capture p rt fb) =- (route' pre (cwd:ctx, rest) params' rt) <|>- (route' pre (ctx, cwd:rest) params fb)+route' pre !ctx [] !params (Capture _ _ fb) =+ route' pre ctx [] params fb++route' pre !ctx (cwd:rest) !params (Capture p rt fb) =+ m <|> (route' pre ctx (cwd:rest) params fb) where- params' = Map.insertWith (++) p [cwd] params+ m = do+ maybe pass+ (\cwd' -> let params' = Map.insertWith (++) p [cwd'] params+ in route' pre (cwd:ctx) rest params' rt)+ (urlDecode cwd)+ -route' pre (ctx, []) params (Dir _ fb) =- route' pre (ctx, []) params fb-route' pre (ctx, cwd:rest) params (Dir rtm fb) =- case Map.lookup cwd rtm of- Just rt -> (route' pre (cwd:ctx, rest) params rt) <|>- (route' pre (ctx, cwd:rest) params fb)- Nothing -> route' pre (ctx, cwd:rest) params fb+route' pre !ctx [] !params (Dir _ fb) =+ route' pre ctx [] params fb+route' pre !ctx (cwd:rest) !params (Dir rtm fb) = do+ cwd' <- maybe pass return $ urlDecode cwd+ case Map.lookup cwd' rtm of+ Just rt -> (route' pre (cwd:ctx) rest params rt) <|>+ (route' pre ctx (cwd:rest) params fb)+ Nothing -> route' pre ctx (cwd:rest) params fb -route' _ _ _ NoRoute = pass+route' _ _ _ _ NoRoute = pass
src/Snap/Internal/Types.hs view
@@ -540,10 +540,26 @@ ------------------------------------------------------------------------------+-- | Grabs something out of the 'Request' object, using the given projection+-- function. See 'gets'.+getsRequest :: MonadSnap m => (Request -> a) -> m a+getsRequest f = liftSnap $ liftM (f . _snapRequest) sget+{-# INLINE getsRequest #-}+++------------------------------------------------------------------------------ -- | Grabs the 'Response' object out of the 'Snap' monad. getResponse :: MonadSnap m => m Response getResponse = liftSnap $ liftM _snapResponse sget {-# INLINE getResponse #-}+++------------------------------------------------------------------------------+-- | Grabs something out of the 'Response' object, using the given projection+-- function. See 'gets'.+getsResponse :: MonadSnap m => (Response -> a) -> m a+getsResponse f = liftSnap $ liftM (f . _snapResponse) sget+{-# INLINE getsResponse #-} ------------------------------------------------------------------------------
src/Snap/Iteratee.hs view
@@ -687,8 +687,9 @@ unsafeEnumBuilderToByteString :: MonadIO m => Enumeratee Builder ByteString m a unsafeEnumBuilderToByteString =- builderToByteStringWith (reuseBufferStrategy (allocBuffer 65536))-+ builderToByteStringWith (reuseBufferStrategy (allocBuffer bufsize))+ where+ bufsize = (2::Int) ^ (14::Int) ------------------------------------------------------------------------------ enumByteStringToBuilder :: MonadIO m => Enumeratee ByteString Builder m a
src/Snap/Util/FileServe.hs view
@@ -32,7 +32,7 @@ import Control.Monad import Control.Monad.CatchIO import Control.Monad.Trans-import Data.Attoparsec.Char8 hiding (Done)+import Data.Attoparsec.Char8 import qualified Data.ByteString.Char8 as S import Data.ByteString.Char8 (ByteString) import Data.ByteString.Internal (c2w)
src/Snap/Util/FileUploads.hs view
@@ -72,7 +72,7 @@ import Control.Monad.CatchIO import Control.Monad.Trans import qualified Data.Attoparsec.Char8 as Atto-import Data.Attoparsec.Char8 hiding (many, Result(..))+import Data.Attoparsec.Char8 import Data.Attoparsec.Enumerator import qualified Data.ByteString.Char8 as S import Data.ByteString.Char8 (ByteString)
src/Snap/Util/GZip.hs view
@@ -11,11 +11,11 @@ import Blaze.ByteString.Builder import qualified Codec.Zlib.Enum as Z-import Control.Applicative hiding (many)+import Control.Applicative import Control.Exception import Control.Monad import Control.Monad.Trans-import Data.Attoparsec.Char8 hiding (Done)+import Data.Attoparsec.Char8 import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import qualified Data.Char as Char
test/snap-core-testsuite.cabal view
@@ -23,15 +23,15 @@ build-depends: QuickCheck >= 2.3.0.2,- attoparsec >= 0.8.1 && < 0.10,- attoparsec-enumerator >= 0.2.0.3,+ attoparsec >= 0.10 && < 0.11,+ attoparsec-enumerator >= 0.3, base >= 4 && < 5, base16-bytestring == 0.1.*, blaze-builder >= 0.2.1.4 && <0.4, blaze-builder-enumerator >= 0.2 && <0.3, bytestring, bytestring-nums,- case-insensitive >= 0.3 && < 0.4,+ case-insensitive >= 0.3 && < 0.5, cereal == 0.3.*, containers, deepseq >= 1.1 && <1.3,
test/suite/Snap/Internal/Routing/Tests.hs view
@@ -51,7 +51,10 @@ , testRouting26 , testRouting27 , testRouting28- , testRouteLocal ]+ , testRouteLocal+ , testRouteUrlDecode+ , testRouteUrlEncodedPath+ ] expectException :: IO a -> IO () expectException m = do@@ -77,18 +80,21 @@ dummy = const $ return () routes :: Snap ByteString-routes = route [ ("foo" , topFoo )- , ("foo/bar" , fooBar )- , ("foo/bar/baz" , fooBarBaz )- , ("foo/:id" , fooCapture)- , ("bar/:id" , fooCapture)- , ("bar/quux" , barQuux )- , ("bar" , bar )- , ("z/:a/:b/:c/d" , zabc ) ]+routes = route [ ("foo" , topFoo )+ , ("foo/bar" , fooBar )+ , ("foo/bar/baz" , getRqPathInfo )+ , ("foo/:id" , fooCapture )+ , ("bar/:id" , fooCapture )+ , ("herp/:derp/" , getRqPathInfo )+ , ("nerp/:derp/" , getRqContextPath)+ , ("a b c d" , return "OK" )+ , ("bar/quux" , barQuux )+ , ("bar" , bar )+ , ("z/:a/:b/:c/d" , zabc ) ] routesLocal :: Snap ByteString-routesLocal = routeLocal [ ("foo/bar/baz" , fooBarBaz )- , ("bar" , pass ) ]+routesLocal = routeLocal [ ("foo/bar/baz" , getRqPathInfo )+ , ("bar" , pass ) ] routes2 :: Snap ByteString routes2 = route [ ("" , topTop )@@ -119,8 +125,9 @@ , ("" , topTop ) ] -topTop, topFoo, fooBar, fooCapture, fooBarBaz, bar, barQuux :: Snap ByteString-dblA, zabc, topCapture, fooCapture2 :: Snap ByteString+topTop, topFoo, fooBar, fooCapture, getRqPathInfo, bar,+ getRqContextPath, barQuux, dblA, zabc, topCapture, + fooCapture2 :: Snap ByteString dblA = do ma <- getParam "a"@@ -145,158 +152,174 @@ mp <- getParam "foo" maybe pass return mp -topTop = return "topTop"-topFoo = return "topFoo"-fooBar = return "fooBar"-fooCapture = liftM (head . fromJust . rqParam "id") getRequest-fooCapture2 = liftM (head . fromJust . rqParam "id2") getRequest-fooBarBaz = liftM rqPathInfo getRequest-barQuux = return "barQuux"-bar = return "bar"+topTop = return "topTop"+topFoo = return "topFoo"+fooBar = return "fooBar"+fooCapture = liftM (head . fromJust . rqParam "id") getRequest+fooCapture2 = liftM (head . fromJust . rqParam "id2") getRequest+getRqPathInfo = liftM rqPathInfo getRequest+getRqContextPath = liftM rqContextPath getRequest+barQuux = return "barQuux"+bar = return "bar" -- TODO more useful test names testRouting1 :: Test-testRouting1 = testCase "routing1" $ do+testRouting1 = testCase "route/1" $ do r1 <- go routes "foo" assertEqual "/foo" "topFoo" r1 testRouting2 :: Test-testRouting2 = testCase "routing2" $ do+testRouting2 = testCase "route/2" $ do r2 <- go routes "foo/baz" assertEqual "/foo/baz" "baz" r2 testRouting3 :: Test-testRouting3 = testCase "routing3" $ do+testRouting3 = testCase "route/3" $ do expectException $ go routes "/xsaxsaxsax" testRouting4 :: Test-testRouting4 = testCase "routing4" $ do+testRouting4 = testCase "route/4" $ do r3 <- go routes "foo/bar" assertEqual "/foo/bar" "fooBar" r3 testRouting5 :: Test-testRouting5 = testCase "routing5" $ do+testRouting5 = testCase "route/5" $ do r4 <- go routes "foo/bar/baz/quux" assertEqual "/foo/bar/baz/quux" "quux" r4 testRouting6 :: Test-testRouting6 = testCase "routing6" $ do+testRouting6 = testCase "route/6" $ do r5 <- go routes "foo/bar/sproing" assertEqual "/foo/bar/sproing" "fooBar" r5 testRouting7 :: Test-testRouting7 = testCase "routing7" $ do+testRouting7 = testCase "route/7" $ do r <- go routes "bar" assertEqual "/bar" "bar" r testRouting8 :: Test-testRouting8 = testCase "routing8" $ do+testRouting8 = testCase "route/8" $ do r2 <- go routes "bar/quux" assertEqual "/bar/quux" "barQuux" r2 testRouting9 :: Test-testRouting9 = testCase "routing9" $ do+testRouting9 = testCase "route/9" $ do r3 <- go routes "bar/whatever" assertEqual "/bar/whatever" "whatever" r3 testRouting10 :: Test-testRouting10 = testCase "routing10" $ do+testRouting10 = testCase "route/10" $ do r4 <- go routes "bar/quux/whatever" assertEqual "/bar/quux/whatever" "barQuux" r4 testRouting11 :: Test-testRouting11 = testCase "routing11" $ do+testRouting11 = testCase "route/11" $ do r1 <- go routes2 "" assertEqual "/" "topTop" r1 testRouting12 :: Test-testRouting12 = testCase "routing12" $ do+testRouting12 = testCase "route/12" $ do r1 <- go routes2 "foo" assertEqual "/foo" "topFoo" r1 testRouting13 :: Test-testRouting13 = testCase "routing13" $ do+testRouting13 = testCase "route/13" $ do r1 <- go routes3 "zzzz" assertEqual "/zzzz" "zzzz" r1 testRouting14 :: Test-testRouting14 = testCase "routing14" $ do+testRouting14 = testCase "route/14" $ do r1 <- go routes3 "" assertEqual "/" "topTop" r1 testRouting15 :: Test-testRouting15 = testCase "routing15" $ do+testRouting15 = testCase "route/15" $ do r1 <- go routes4 "zzzz" assertEqual "/zzzz" "zzzz" r1 testRouting16 :: Test-testRouting16 = testCase "routing16" $ do+testRouting16 = testCase "route/16" $ do r1 <- go routes5 "" assertEqual "/" "topTop" r1 testRouting17 :: Test-testRouting17 = testCase "routing17" $ do+testRouting17 = testCase "route/17" $ do r1 <- go routes "z/a/b/c/d" assertEqual "/z/a/b/c/d" "ok" r1 testRouting18 :: Test-testRouting18 = testCase "routing18" $ do+testRouting18 = testCase "route/18" $ do r1 <- go routes6 "a/a" assertEqual "/a/a" "ok" r1 testRouting19 :: Test-testRouting19 = testCase "routing19" $ do+testRouting19 = testCase "route/19" $ do r1 <- go routes7 "foo" assertEqual "/foo" "topTop" r1 testRouting20 :: Test-testRouting20 = testCase "routing20" $ do+testRouting20 = testCase "route/20" $ do r1 <- go routes7 "foo/baz" assertEqual "/foo/baz" "baz" r1 testRouting21 :: Test-testRouting21 = testCase "routing21" $ do+testRouting21 = testCase "route/21" $ do r1 <- go routes7 "foo/baz/quux" assertEqual "/foo/baz/quux" "quux" r1 testRouting22 :: Test-testRouting22 = testCase "routing22" $ do+testRouting22 = testCase "route/22" $ do r1 <- go routes7 "fooo/baz" assertEqual "/fooo/baz" "topTop" r1 testRouting23 :: Test-testRouting23 = testCase "routing23" $ do+testRouting23 = testCase "route/23" $ do r1 <- go routes7 "fooo/baz/quux" assertEqual "/fooo/baz/quux" "quux" r1 testRouting24 :: Test-testRouting24 = testCase "routing24" $ do+testRouting24 = testCase "route/24" $ do r1 <- go routes7 "foooo/bar/bax" assertEqual "/foooo/bar/bax" "topTop" r1 testRouting25 :: Test-testRouting25 = testCase "routing25" $ do+testRouting25 = testCase "route/25" $ do r1 <- go routes7 "foooo/bar/baz" assertEqual "/foooo/bar/baz" "bar" r1 testRouting26 :: Test-testRouting26 = testCase "routing26" $ do+testRouting26 = testCase "route/26" $ do r1 <- go routes4 "foo/bar" assertEqual "capture union" "bar" r1 testRouting27 :: Test-testRouting27 = testCase "routing27" $ do+testRouting27 = testCase "route/27" $ do r1 <- go routes4 "foo" assertEqual "capture union" "foo" r1 testRouting28 :: Test-testRouting28 = testCase "routing28" $ do+testRouting28 = testCase "route/28" $ do r1 <- go routes4 "quux/baz" assertEqual "capture union" "quux" r1 +testRouteUrlDecode :: Test+testRouteUrlDecode = testCase "route/urlDecode" $ do+ r1 <- go routes "herp/%7Bderp%7D/"+ assertEqual "rqPathInfo on urldecode" "" r1+ r2 <- go routes "foo/%7Bderp%7D/"+ assertEqual "urldecoded capture" "{derp}" r2+ r3 <- go routes "nerp/%7Bderp%7D/"+ assertEqual "rqContextPath on urldecode" "/nerp/%7Bderp%7D/" r3++testRouteUrlEncodedPath :: Test+testRouteUrlEncodedPath = testCase "route/urlEncodedPath" $ do+ -- make sure path search urlDecodes.+ r1 <- go routes "a+b+c+d"+ assertEqual "urlEncoded search works" "OK" r1+ testRouteLocal :: Test-testRouteLocal = testCase "routeLocal" $ do+testRouteLocal = testCase "route/routeLocal" $ do r4 <- go routesLocal "foo/bar/baz/quux" assertEqual "/foo/bar/baz/quux" "foo/bar/baz/quux" r4 expectException $ go routesLocal "bar"