This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap-server".
The branch, enumerator-work has been updated
via 88c1bf257d1c35c29ba087263ffdc73535620635 (commit)
from 421c907b2befe00bbf2d7ae90e9d8d1c3eb3c9b8 (commit)
Summary of changes:
src/Snap/Internal/Http/Server/LibevBackend.hs | 3 +-
test/common/Test/Common/TestHandler.hs | 22 ++-
test/suite/Snap/Internal/Http/Parser/Tests.hs | 195 +++++++++----------------
3 files changed, 81 insertions(+), 139 deletions(-)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 88c1bf257d1c35c29ba087263ffdc73535620635
Author: Gregory Collins <[email protected]>
Date: Sun Nov 21 21:49:48 2010 +0100
Make a couple of the test files compile
diff --git a/src/Snap/Internal/Http/Server/LibevBackend.hs
b/src/Snap/Internal/Http/Server/LibevBackend.hs
index 03d7da4..eefc93a 100644
--- a/src/Snap/Internal/Http/Server/LibevBackend.hs
+++ b/src/Snap/Internal/Http/Server/LibevBackend.hs
@@ -124,7 +124,8 @@ sendFile c fp start sz = do
(closeFd)
(go start sz)
#else
- enumFilePartial fp (start,start+sz) (getWriteEnd c) >>= run
+ runIteratee (getWriteEnd c) >>=
+ run_ . enumFilePartial fp (start,start+sz)
return ()
#endif
diff --git a/test/common/Test/Common/TestHandler.hs
b/test/common/Test/Common/TestHandler.hs
index 72bfbcf..885354c 100644
--- a/test/common/Test/Common/TestHandler.hs
+++ b/test/common/Test/Common/TestHandler.hs
@@ -5,13 +5,14 @@ module Test.Common.TestHandler (testHandler) where
import Control.Monad
+import Control.Monad.Trans
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
-import Data.Iteratee.WrappedByteString
import Data.Maybe
import Snap.Iteratee hiding (Enumerator)
+import qualified Snap.Iteratee as I
import Snap.Types
import Snap.Http.Server
import Snap.Util.FileServe
@@ -32,18 +33,21 @@ echoUriHandler = do
echoHandler :: Snap ()
-echoHandler = transformRequestBody return
+echoHandler = transformRequestBody returnI
rot13Handler :: Snap ()
-rot13Handler = transformRequestBody $ return . f
+rot13Handler = transformRequestBody f
where
- f i = IterateeG $ \ch -> do
- case ch of
- (EOF _) -> runIter i ch
- (Chunk (WrapBS s)) -> do
- i' <- liftM liftI $ runIter i $ Chunk $ WrapBS $ rot13
s
- return $ Cont (f i') Nothing
+ f origStep = do
+ mbX <- I.head
+ maybe (enumEOF origStep)
+ (feedStep origStep)
+ mbX
+
+ feedStep origStep x = do
+ step <- lift $ runIteratee $ enumBS (rot13 x) origStep
+ f step
bigResponseHandler :: Snap ()
diff --git a/test/suite/Snap/Internal/Http/Parser/Tests.hs
b/test/suite/Snap/Internal/Http/Parser/Tests.hs
index f96a470..ae981d6 100644
--- a/test/suite/Snap/Internal/Http/Parser/Tests.hs
+++ b/test/suite/Snap/Internal/Http/Parser/Tests.hs
@@ -9,6 +9,7 @@ import qualified Control.Exception as E
import Control.Exception hiding (try, assert)
import Control.Monad
import Control.Monad.Identity
+import Control.Monad.Trans
import Control.Parallel.Strategies
import Data.Attoparsec hiding (Result(..))
import Data.ByteString (ByteString)
@@ -16,7 +17,6 @@ import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Internal (c2w)
import Data.IORef
-import Data.Iteratee.WrappedByteString
import Data.List
import qualified Data.Map as Map
import Data.Maybe (isNothing)
@@ -31,8 +31,8 @@ import Test.HUnit hiding (Test, path)
import Text.Printf
import Snap.Internal.Http.Parser
-import Snap.Internal.Http.Types hiding (Enumerator)
-import Snap.Iteratee hiding (foldl')
+import Snap.Internal.Http.Types
+import Snap.Iteratee hiding (map, sequence)
import qualified Snap.Iteratee as I
import Snap.Test.Common()
@@ -42,14 +42,11 @@ tests = [ testShow
, testCookie
, testChunked
, testBothChunked
- , testBothChunkedBuffered1
, testBothChunkedPipelined
, testBothChunkedEmpty
, testP2I
, testNull
, testPartial
- , testIterateeError
- , testIterateeError2
, testParseError
, testFormEncoded ]
@@ -66,8 +63,8 @@ testShow = testCase "show" $ do
testP2I :: Test
testP2I = testCase "parserToIteratee" $ do
- i <- enumBS "z" (parserToIteratee emptyParser)
- l <- run i
+ i <- liftM (enumBS "z") $ runIteratee (iterParser emptyParser)
+ l <- run_ i
assertEqual "should be foo" "foo" l
@@ -80,14 +77,14 @@ forceErr e = f `seq` (return ())
testNull :: Test
testNull = testCase "short parse" $ do
- f <- run (parseRequest)
+ f <- run_ (parseRequest)
assertBool "should be Nothing" $ isNothing f
testPartial :: Test
testPartial = testCase "partial parse" $ do
- i <- enumBS "GET / " parseRequest
- f <- E.try $ run i
+ i <- liftM (enumBS "GET / ") $ runIteratee parseRequest
+ f <- E.try $ run_ i
case f of (Left e) -> forceErr e
(Right x) -> assertFailure $ "expected exception, got " ++ show x
@@ -95,29 +92,9 @@ testPartial = testCase "partial parse" $ do
testParseError :: Test
testParseError = testCase "parse error" $ do
- i <- enumBS "ZZZZZZZZZZ" parseRequest
- f <- E.try $ run i
-
- case f of (Left e) -> forceErr e
- (Right x) -> assertFailure $ "expected exception, got " ++ show x
-
-
-introduceError :: (Monad m) => Enumerator m a
-introduceError iter = return $ IterateeG $ \_ ->
- runIter iter (EOF (Just (Err "EOF")))
-
-testIterateeError :: Test
-testIterateeError = testCase "iteratee error" $ do
- i <- liftM liftI $ runIter parseRequest (EOF (Just (Err "foo")))
- f <- E.try $ run i
-
- case f of (Left e) -> forceErr e
- (Right x) -> assertFailure $ "expected exception, got " ++ show x
-
-testIterateeError2 :: Test
-testIterateeError2 = testCase "iteratee error 2" $ do
- i <- (enumBS "GET / " >. introduceError) parseRequest
- f <- E.try $ run i
+ step <- runIteratee parseRequest
+ let i = enumBS "ZZZZZZZZZZ" step
+ f <- E.try $ run_ i
case f of (Left e) -> forceErr e
(Right x) -> assertFailure $ "expected exception, got " ++ show x
@@ -139,94 +116,38 @@ testChunked :: Test
testChunked = testProperty "chunked transfer encoding" prop_chunked
where
prop_chunked :: L.ByteString -> Bool
- prop_chunked s = runIdentity (run iter) == s
+ prop_chunked s = runIdentity (run_ iter) == s
where
enum = enumLBS (transferEncodingChunked s)
- iter :: Iteratee Identity L.ByteString
+ iter :: Iteratee ByteString Identity L.ByteString
iter = runIdentity $ do
- i <- (readChunkedTransferEncoding stream2stream) >>= enum
- return $ liftM fromWrap i
+ sstep <- runIteratee consume
+ step <- runIteratee $ joinI $
+ readChunkedTransferEncoding sstep
+ return $ liftM L.fromChunks $ enum step
testBothChunked :: Test
testBothChunked = testProperty "chunk . unchunk == id" $
monadicIO $ forAllM arbitrary prop
where
prop s = do
- it <- QC.run $ writeChunkedTransferEncoding stream2stream
+ sstep <- QC.run $ runIteratee stream2stream
+ let it = joinI $ writeChunkedTransferEncoding sstep
- bs <- QC.run $
- enumBS s it
- >>= run >>= return . unWrap
+ bs <- QC.run $ runIteratee it >>= run_ . enumBS s
let enum = enumBS bs
- iter <- do
- i <- (readChunkedTransferEncoding stream2stream) >>= enum
- return $ liftM unWrap i
+
+
+ x <- QC.run $
+ runIteratee (joinI $ readChunkedTransferEncoding sstep) >>=
+ run_ . enum
- x <- run iter
QC.assert $ s == x
-testBothChunkedBuffered1 :: Test
-testBothChunkedBuffered1 = testProperty "testBothChunkedBuffered2" $
- monadicIO prop
- where
- prop = do
- sz <- QC.pick (choose (1000,4000))
- s' <- QC.pick $ resize sz arbitrary
- ntimes <- QC.pick (choose (4,7))
-
- let e = enumLBS s'
- let n = fromEnum $ L.length s'
-
- let enum = foldl' (>.) (enumBS "") (replicate ntimes e)
-
- (bufi,_) <- QC.run $ bufferIteratee stream2stream
- iter' <- QC.run $ writeChunkedTransferEncoding bufi
- let iter = I.joinI $ I.take n iter'
- let iters = replicate ntimes iter
-
- let mothra = foldM (\s it -> it >>= \t -> return $ s `mappend` t)
- mempty
- iters
-
- bs <- QC.run $ enum mothra
- >>= run >>= return . unWrap
-
-
- ----------------------------------------------------------------------
- -- 2nd pass, cancellation
- let pcrlf = \s -> parserToIteratee $ string "\r\n" >> return s
- (inputIter2,esc) <- QC.run $ bufferIteratee stream2stream
- QC.run $ writeIORef esc True
-
- iter2' <- QC.run $ writeChunkedTransferEncoding inputIter2
- let iter2 = I.joinI $ I.take n iter2'
- let iters2 = replicate ntimes iter2
-
- let mothra2 = foldM (\s it -> it >>= \t -> return $ s `mappend` t)
- mempty
- iters2
-
-
- bs2 <- QC.run $ enum mothra2
- >>= run >>= return . unWrap
-
-
- let e2 = enumBS bs2
- iters' <- QC.run $
- replicateM ntimes $
- readChunkedTransferEncoding stream2stream
- let godzilla2 = sequence $ map (>>= pcrlf) iters'
- outiter2 <- QC.run $ e2 godzilla2
- x2 <- QC.run $ liftM (map unWrap) $ run outiter2
-
- QC.assert $
- (map (L.fromChunks . (:[])) x2) == (replicate ntimes s')
-
-
testBothChunkedPipelined :: Test
testBothChunkedPipelined = testProperty "testBothChunkedPipelined" $
@@ -241,11 +162,13 @@ testBothChunkedPipelined = testProperty
"testBothChunkedPipelined" $
let e = enumLBS s'
let n = fromEnum $ L.length s'
- let enum = foldl' (>.) (enumBS "") (replicate ntimes e)
+ let enum = foldl' (>==>) (enumBS "") (replicate ntimes e)
- (bufi,_) <- QC.run $ bufferIteratee stream2stream
+ bufi <- QC.run $
+ unsafeBufferIteratee copyingStream2Stream >>= runIteratee
- iter' <- QC.run $ writeChunkedTransferEncoding bufi
+ iter' <- QC.run $ runIteratee $ joinI $
+ writeChunkedTransferEncoding bufi
let iter = I.joinI $ I.take n iter'
let iters = replicate ntimes iter
@@ -253,21 +176,19 @@ testBothChunkedPipelined = testProperty
"testBothChunkedPipelined" $
mempty
iters
- bs <- QC.run $ enum mothra
- >>= run >>= return . unWrap
+ bs <- QC.run $ runIteratee mothra >>= run_ . enum
let e2 = enumBS bs
- let pcrlf = \s -> parserToIteratee $ string "\r\n" >> return s
+ let pcrlf = \s -> iterParser $ string "\r\n" >> return s
- iters <- QC.run $
- replicateM ntimes $
- readChunkedTransferEncoding stream2stream
+ sstep <- QC.run $ runIteratee stream2stream
+
+ let iters = replicate ntimes $ joinI $
+ readChunkedTransferEncoding sstep
let godzilla = sequence $ map (>>= pcrlf) iters
- iter <- QC.run $ e2 godzilla
-
- x <- QC.run $ liftM (map unWrap) $ run iter
+ x <- QC.run $ runIteratee godzilla >>= run_ . e2
QC.assert $
(map (L.fromChunks . (:[])) x) == (replicate ntimes s')
@@ -283,30 +204,32 @@ testBothChunkedEmpty = testCase "testBothChunkedEmpty"
prop
let n = fromEnum $ L.length s'
let ntimes = 5
- let enum = foldl' (>.) (enumBS "") (replicate ntimes e)
+ let enum = foldl' (>==>) (enumBS "") (replicate ntimes e)
- iter' <- writeChunkedTransferEncoding stream2stream
- let iter = I.joinI $ I.take n iter'
+ sstep <- runIteratee stream2stream
+
+ step <- runIteratee $
+ joinI $
+ writeChunkedTransferEncoding sstep
+ iter <- liftM returnI $ runIteratee $ joinI $ I.take n step
- let iters = replicate ntimes iter
+ let iters = replicate ntimes (iter :: Iteratee ByteString IO
ByteString)
let mothra = foldM (\s it -> it >>= \t -> return $ s `mappend` t)
mempty
iters
- bs <- enum mothra
- >>= run >>= return . unWrap
+ mothraStep <- runIteratee mothra
+ bs <- run_ $ enum mothraStep
let e2 = enumBS bs
- let pcrlf = \s -> parserToIteratee $ string "\r\n" >> return s
-
- iters <- replicateM ntimes $
- readChunkedTransferEncoding stream2stream
- let godzilla = sequence $ map (>>= pcrlf) iters
+ let pcrlf = \s -> iterParser $ string "\r\n" >> return s
- iter <- e2 godzilla
+ let iters = replicate ntimes $ joinI $
+ readChunkedTransferEncoding sstep
+ godzilla <- runIteratee $ sequence $ map (>>= pcrlf) iters
- x <- liftM (map unWrap) $ run iter
+ x <- run_ $ e2 godzilla
assertBool "empty chunked transfer" $
(map (L.fromChunks . (:[])) x) == (replicate ntimes s')
@@ -337,3 +260,17 @@ testFormEncoded = testCase "formEncoded" $ do
assertEqual "foo1" (Just ["bar1"] ) $ Map.lookup "foo1" mp
assertEqual "foo2" (Just ["bar2 baz2"]) $ Map.lookup "foo2" mp
assertEqual "foo3" (Just ["foo bar"] ) $ Map.lookup "foo3" mp
+
+
+
+
+copyingStream2Stream = go []
+ where
+ go l = do
+ mbx <- I.head
+ maybe (return $ S.concat $ reverse l)
+ (\x -> let !z = S.copy x in go (z:l))
+ mbx
+
+stream2stream :: (Monad m) => Iteratee ByteString m ByteString
+stream2stream = liftM S.concat consume
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
