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-core".
The branch, master has been updated
via 302d098fb66b83a2afbfe7e9a72a947a62890c5e (commit)
from 2e78d4b0ab1548dec424d6782d0c4b13cb32dd6a (commit)
Summary of changes:
src/Snap/Iteratee.hs | 45 ++++++++++++++++++++++++++----------
test/suite/Snap/Iteratee/Tests.hs | 12 +++++----
2 files changed, 39 insertions(+), 18 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 302d098fb66b83a2afbfe7e9a72a947a62890c5e
Author: Gregory Collins <[email protected]>
Date: Wed May 26 23:25:59 2010 -0400
Return an 'escape value' from unsafeBufferIteratee
diff --git a/src/Snap/Iteratee.hs b/src/Snap/Iteratee.hs
index 8be62d3..8a6495c 100644
--- a/src/Snap/Iteratee.hs
+++ b/src/Snap/Iteratee.hs
@@ -47,7 +47,11 @@ import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Unsafe as S
import qualified Data.ByteString.Lazy as L
+import Data.IORef
import Data.Iteratee
+#ifdef WIN32
+import Data.Iteratee.IO (enumHandle)
+#endif
import qualified Data.Iteratee.Base.StreamChunk as SC
import Data.Iteratee.WrappedByteString
import Data.Monoid (mappend)
@@ -161,15 +165,30 @@ bufferIteratee = return . go (D.empty,0)
-- socket) it'll get changed out from underneath you, breaking referential
-- transparency. Use with caution!
--
-unsafeBufferIteratee :: Enumerator IO a
+-- The IORef returned can be set to True to "cancel" buffering. We added this
+-- so that transfer-encoding: chunked (which needs its own buffer and therefore
+-- doesn't need /its/ output buffered) can switch the outer buffer off.
+--
+unsafeBufferIteratee :: Iteratee IO a -> IO (Iteratee IO a, IORef Bool)
unsafeBufferIteratee iteratee = do
buf <- mallocForeignPtrBytes bufsiz
- return $ go 0 buf iteratee
+ esc <- newIORef False
+ return $! (go esc 0 buf iteratee, esc)
where
bufsiz = 8192
- go bytesSoFar buf iter = IterateeG $! f bytesSoFar buf iter
+ go esc bytesSoFar buf iter = IterateeG $! checkRef esc bytesSoFar buf iter
+
+ checkRef esc bytesSoFar buf iter ch = do
+ quit <- readIORef esc
+ if quit
+ then if bytesSoFar /= 0
+ then do
+ i <- liftM liftI $ sendBuf bytesSoFar buf iter
+ runIter i $ ch
+ else runIter iter ch
+ else f esc bytesSoFar buf iter ch
sendBuf n buf iter = withForeignPtr buf $ \ptr -> do
s <- S.unsafePackCStringLen (ptr, n)
@@ -178,9 +197,9 @@ unsafeBufferIteratee iteratee = do
copy c@(EOF _) = c
copy (Chunk (WrapBS s)) = Chunk $ WrapBS $ S.copy s
- f _ _ iter ch@(EOF (Just _)) = runIter iter ch
+ f _ _ _ iter ch@(EOF (Just _)) = runIter iter ch
- f !n buf iter ch@(EOF Nothing) =
+ f _ !n buf iter ch@(EOF Nothing) =
if n == 0
then runIter iter ch
else do
@@ -190,22 +209,22 @@ unsafeBufferIteratee iteratee = do
Cont i (Just e) -> return $ Cont i (Just e)
Cont i Nothing -> runIter i ch
- f !n buf iter (Chunk (WrapBS s)) = do
+ f esc !n buf iter (Chunk (WrapBS s)) = do
let m = S.length s
if m+n > bufsiz
- then overflow n buf iter s m
- else copyAndCont n buf iter s m
+ then overflow esc n buf iter s m
+ else copyAndCont esc n buf iter s m
- copyAndCont n buf iter s m = do
+ copyAndCont esc n buf iter s m = do
S.unsafeUseAsCStringLen s $ \(p,sz) ->
withForeignPtr buf $ \bufp -> do
let b' = plusPtr bufp n
copyBytes b' p sz
- return $ Cont (go (n+m) buf iter) Nothing
+ return $ Cont (go esc (n+m) buf iter) Nothing
- overflow n buf iter s m = do
+ overflow esc n buf iter s m = do
let rest = bufsiz - n
let m2 = m - rest
let (s1,s2) = S.splitAt rest s
@@ -229,8 +248,8 @@ unsafeBufferIteratee iteratee = do
case iv' of
Done x r -> return $ Done x (copy r)
Cont i' (Just e) -> return $ Cont i' (Just e)
- Cont i' Nothing -> return $ Cont (go 0 buf i')
Nothing
- else copyAndCont 0 buf i s2 m2
+ Cont i' Nothing -> return $ Cont (go esc 0 buf i')
Nothing
+ else copyAndCont esc 0 buf i s2 m2
------------------------------------------------------------------------------
diff --git a/test/suite/Snap/Iteratee/Tests.hs
b/test/suite/Snap/Iteratee/Tests.hs
index cc9c927..4116252 100644
--- a/test/suite/Snap/Iteratee/Tests.hs
+++ b/test/suite/Snap/Iteratee/Tests.hs
@@ -140,8 +140,8 @@ copyingStream2stream = IterateeG (step mempty)
bufferAndRun :: Iteratee IO a -> L.ByteString -> IO a
bufferAndRun ii s = do
- i <- unsafeBufferIteratee ii
- iter <- enumLBS s i
+ (i,_) <- unsafeBufferIteratee ii
+ iter <- enumLBS s i
run iter
@@ -162,7 +162,7 @@ testUnsafeBuffer2 :: Test
testUnsafeBuffer2 = testCase "testUnsafeBuffer2" prop
where
prop = do
- i <- unsafeBufferIteratee $ drop 4 >> copyingStream2stream
+ (i,_) <- unsafeBufferIteratee $ drop 4 >> copyingStream2stream
s <- enumLBS "abcdefgh" i >>= run >>= return . fromWrap
H.assertEqual "s == 'efgh'" "efgh" s
@@ -187,11 +187,13 @@ testUnsafeBuffer4 = testProperty "testUnsafeBuffer4" $
monadicIO $ forAllM arbitrary prop
where
prop s = do
- i <- liftQ $ unsafeBufferIteratee (copyingStream2stream >> throwErr
(Err "foo"))
+ (i,_) <- liftQ $
+ unsafeBufferIteratee (copyingStream2stream >> throwErr (Err
"foo"))
i' <- liftQ $ enumLBS s i
expectException $ run i'
- j <- liftQ $ unsafeBufferIteratee (throwErr (Err "foo") >>
copyingStream2stream)
+ (j,_) <- liftQ $
+ unsafeBufferIteratee (throwErr (Err "foo") >>
copyingStream2stream)
j' <- liftQ $ enumLBS s j
expectException $ run j'
-----------------------------------------------------------------------
hooks/post-receive
--
snap-core
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
