Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

Add a separate map for captured variables. #174

Open
wants to merge 3 commits into from

2 participants

@favonia

See Issue #168 for discussion.

favonia added some commits
@gregorycollins

Did you ever manage to do a set of comparative benchmarks here?

@favonia

Yes. Sorry for the delay. Please see my comments in Issue #168.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Feb 18, 2013
  1. @favonia
  2. @favonia

    Modifying existing test cases for the new field.

    favonia authored
    Modifying existing test cases for the new field.
    No new test cases have been added yet, though.
  3. @favonia

    New tests for the new map.

    favonia authored
This page is out of date. Refresh to see the latest.
View
14 src/Snap/Internal/Http/Types.hs
@@ -280,9 +280,12 @@ data Request = Request
-- | Returns the parameters mapping for this 'Request'. \"Parameters\"
-- are automatically decoded from the URI's query string and @POST@ body
-- and entered into this mapping. The 'rqParams' value is thus a union of
- -- 'rqQueryParams' and 'rqPostParams'.
+ -- 'rqCaptureParams', 'rqQueryParams' and 'rqPostParams'.
, rqParams :: Params
+ -- | The parameter mapping from variable capturing.
+ , rqCaptureParams :: Params
+
-- | The parameter mapping decoded from the URI's query string.
, rqQueryParams :: Params
@@ -502,6 +505,15 @@ rqQueryParam k rq = Map.lookup k $ rqQueryParams rq
------------------------------------------------------------------------------
+-- | Looks up the value(s) for the given catured variable.
+rqCaptureParam :: ByteString -- ^ parameter name to look up
+ -> Request -- ^ HTTP request
+ -> Maybe [ByteString]
+rqCaptureParam k rq = Map.lookup k $ rqCaptureParams rq
+{-# INLINE rqCaptureParam #-}
+
+
+------------------------------------------------------------------------------
-- | Modifies the parameters mapping (which is a @Map ByteString ByteString@)
-- in a 'Request' using the given function.
rqModifyParams :: (Params -> Params) -> Request -> Request
View
4 src/Snap/Internal/Routing.hs
@@ -233,7 +233,9 @@ route' pre !ctx _ !params (Action action) =
where
ctx' = B.intercalate (B.pack [c2w '/']) (reverse ctx)
updateParams req = req
- { rqParams = Map.unionWith (++) params (rqParams req) }
+ { rqParams = Map.unionWith (++) params (rqParams req)
+ , rqCaptureParams = Map.unionWith (++) params (rqCaptureParams req)
+ }
route' pre !ctx [] !params (Capture _ _ fb) =
route' pre ctx [] params fb
View
1  src/Snap/Internal/Test/RequestBuilder.hs
@@ -96,6 +96,7 @@ mkDefaultRequest = do
Map.empty
Map.empty
Map.empty
+ Map.empty
------------------------------------------------------------------------------
View
7 src/Snap/Internal/Types.hs
@@ -1074,6 +1074,13 @@ getQueryParams = getRequest >>= return . rqQueryParams
------------------------------------------------------------------------------
+-- | See 'rqParams'. Convenience function to return 'Params' from the
+-- 'Request' inside of a 'MonadSnap' instance.
+getCaptureParams :: MonadSnap m => m Params
+getCaptureParams = getRequest >>= return . rqCaptureParams
+
+
+------------------------------------------------------------------------------
-- | Gets the HTTP 'Cookie' with the specified name.
getCookie :: MonadSnap m
=> ByteString
View
10 test/suite/Snap/Core/Tests.hs
@@ -102,7 +102,7 @@ mkRequest uri = do
return $! Request "foo" 80 "127.0.0.1" 999 "foo" 1000 "foo" False H.empty
enum Nothing GET (1,1) [] uri "/"
- (S.concat ["/",uri]) "" Map.empty Map.empty Map.empty
+ (S.concat ["/",uri]) "" Map.empty Map.empty Map.empty Map.empty
mkRequestQuery :: ByteString -> ByteString -> [ByteString] -> IO Request
@@ -114,7 +114,7 @@ mkRequestQuery uri k v = do
return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False H.empty
enum Nothing GET (1,1) [] uri "/"
- (S.concat ["/",uri,"?",q]) q mp mp Map.empty
+ (S.concat ["/",uri,"?",q]) q mp Map.empty mp Map.empty
mkZomgRq :: IO Request
@@ -123,7 +123,7 @@ mkZomgRq = do
return $ Request "foo" 80 "127.0.0.1" 999 "foo" 1000 "foo" False H.empty
enum Nothing GET (1,1) [] "/" "/" "/" ""
- Map.empty Map.empty Map.empty
+ Map.empty Map.empty Map.empty Map.empty
mkMethodRq :: Method -> IO Request
mkMethodRq m = do
@@ -131,7 +131,7 @@ mkMethodRq m = do
return $ Request "foo" 80 "127.0.0.1" 999 "foo" 1000 "foo" False H.empty
enum Nothing m (1,1) [] "/" "/" "/" ""
- Map.empty Map.empty Map.empty
+ Map.empty Map.empty Map.empty Map.empty
mkIpHeaderRq :: IO Request
mkIpHeaderRq = do
@@ -150,7 +150,7 @@ mkRqWithEnum e = do
enum <- newIORef $ SomeEnumerator e
return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False H.empty
enum Nothing GET (1,1) [] "/" "/" "/" ""
- Map.empty Map.empty Map.empty
+ Map.empty Map.empty Map.empty Map.empty
testCatchIO :: Test
testCatchIO = testCase "types/catchIO" $ do
View
2  test/suite/Snap/Internal/Http/Types/Tests.hs
@@ -38,7 +38,7 @@ mkRq = do
enum <- newIORef (SomeEnumerator $ enumBS "")
return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False H.empty
enum Nothing GET (1,1) [] "/" "/" "/" ""
- Map.empty Map.empty Map.empty
+ Map.empty Map.empty Map.empty Map.empty
testFormatLogTime :: Test
View
29 test/suite/Snap/Internal/Routing/Tests.hs
@@ -57,6 +57,8 @@ tests = [ testRouting1
, testRouteUrlDecode
, testRouteUrlEncodedPath
, testRouteEmptyCapture
+ , testRouteNestedCaptures1
+ , testRouteNestedCaptures2
]
@@ -136,9 +138,20 @@ routesEmptyCapture = route [ ("foo/:id", fooCapture) ]
------------------------------------------------------------------------------
+routesNestedCaptures1 :: Snap (Maybe [ByteString])
+routesNestedCaptures1 = route [ ("foo/:id", route [ (":id", dumpCapture "id") ] ) ]
+
+
+------------------------------------------------------------------------------
+routesNestedCaptures2 :: Snap (Maybe [ByteString])
+routesNestedCaptures2 = route [ ("foo/:id", route [ (":id", dumpParam "id") ] ) ]
+
+
+------------------------------------------------------------------------------
topTop, topFoo, fooBar, fooCapture, getRqPathInfo, bar,
getRqContextPath, barQuux, dblA, zabc, topCapture,
fooCapture2 :: Snap ByteString
+dumpCapture, dumpParam :: ByteString -> Snap (Maybe [ByteString])
dblA = do
ma <- getParam "a"
@@ -172,6 +185,8 @@ getRqPathInfo = liftM rqPathInfo getRequest
getRqContextPath = liftM rqContextPath getRequest
barQuux = return "barQuux"
bar = return "bar"
+dumpCapture str = liftM (rqCaptureParam str) getRequest
+dumpParam str = liftM (rqParam str) getRequest
-----------
@@ -414,3 +429,17 @@ testRouteEmptyCapture = testCase "route/emptyCapture" $ do
where
expected = "ZOMG_OK"
m = routesEmptyCapture <|> return expected
+
+
+------------------------------------------------------------------------------
+testRouteNestedCaptures1 :: Test
+testRouteNestedCaptures1 = testCase "route/nestedCaptures1" $ do
+ r <- go routesNestedCaptures1 "/foo/outer/inner"
+ assertEqual "nested captures (rqCaptureParams)" (Just ["inner", "outer"]) r
+
+
+------------------------------------------------------------------------------
+testRouteNestedCaptures2 :: Test
+testRouteNestedCaptures2 = testCase "route/nestedCaptures2" $ do
+ r <- go routesNestedCaptures2 "/foo/outer/inner"
+ assertEqual "nested captures (rqParams)" (Just ["inner", "outer"]) r
View
2  test/suite/Snap/Util/FileServe/Tests.hs
@@ -154,7 +154,7 @@ mkRequest uri = do
return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False H.empty
enum Nothing GET (1,1) [] pathPart "/"
(S.concat ["/",uri]) queryPart
- Map.empty Map.empty Map.empty
+ Map.empty Map.empty Map.empty Map.empty
where
(pathPart, queryPart) = breakQuery uri
View
4 test/suite/Snap/Util/FileUploads/Tests.hs
@@ -373,7 +373,7 @@ mkRequest body = do
return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False hdrs
enum Nothing POST (1,1) [] "/" "/"
- "/" "" Map.empty Map.empty Map.empty
+ "/" "" Map.empty Map.empty Map.empty Map.empty
------------------------------------------------------------------------------
@@ -388,7 +388,7 @@ mkDamagedRequest body = do
return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False hdrs
enum Nothing POST (1,1) [] "/" "/"
- "/" "" Map.empty Map.empty Map.empty
+ "/" "" Map.empty Map.empty Map.empty Map.empty
where
enum = enumBS (S.take (S.length body - 1) body) >==> dieNow
dieNow _ = throw TestException
View
12 test/suite/Snap/Util/GZip/Tests.hs
@@ -87,7 +87,7 @@ mkNoHeaders = do
return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False emptyHdrs
enum Nothing GET (1,1) [] "/" "/" "/" ""
- Map.empty Map.empty Map.empty
+ Map.empty Map.empty Map.empty Map.empty
mkGzipRq :: IO Request
@@ -96,7 +96,7 @@ mkGzipRq = do
return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False gzipHdrs
enum Nothing GET (1,1) [] "/" "/" "/" ""
- Map.empty Map.empty Map.empty
+ Map.empty Map.empty Map.empty Map.empty
mkXGzipRq :: IO Request
mkXGzipRq = do
@@ -104,7 +104,7 @@ mkXGzipRq = do
return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False xGzipHdrs
enum Nothing GET (1,1) [] "/" "/" "/" ""
- Map.empty Map.empty Map.empty
+ Map.empty Map.empty Map.empty Map.empty
@@ -115,7 +115,7 @@ mkDeflateRq = do
return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False deflateHdrs
enum Nothing GET (1,1) [] "/" "/" "/" ""
- Map.empty Map.empty Map.empty
+ Map.empty Map.empty Map.empty Map.empty
mkXDeflateRq :: IO Request
@@ -124,7 +124,7 @@ mkXDeflateRq = do
return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False xDeflateHdrs
enum Nothing GET (1,1) [] "/" "/" "/" ""
- Map.empty Map.empty Map.empty
+ Map.empty Map.empty Map.empty Map.empty
@@ -135,7 +135,7 @@ mkBadRq = do
return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False badHdrs
enum Nothing GET (1,1) [] "/" "/" "/" ""
- Map.empty Map.empty Map.empty
+ Map.empty Map.empty Map.empty Map.empty
------------------------------------------------------------------------------
Something went wrong with that request. Please try again.