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 2f1ef304c3b915559289434780903293b937b4b9 (commit)
from 8630c252ddb0feda31a59b60c8693014f174b9e8 (commit)
Summary of changes:
src/Snap/Iteratee.hs | 85 ++++++++++++++++++++++++++++++++-
test/suite/Snap/Iteratee/Tests.hs | 94 +++++++++++++++++++++++++++++++++++++
2 files changed, 177 insertions(+), 2 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 2f1ef304c3b915559289434780903293b937b4b9
Author: Gregory Collins <[email protected]>
Date: Mon May 24 11:53:59 2010 -0400
Add 'unsafeBufferIteratee'
diff --git a/src/Snap/Iteratee.hs b/src/Snap/Iteratee.hs
index 69b6fda..dcc6a0d 100644
--- a/src/Snap/Iteratee.hs
+++ b/src/Snap/Iteratee.hs
@@ -36,6 +36,7 @@ module Snap.Iteratee
, takeNoMoreThan
, countBytes
, bufferIteratee
+ , unsafeBufferIteratee
) where
------------------------------------------------------------------------------
@@ -44,12 +45,13 @@ import Control.Monad
import Control.Monad.CatchIO
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.Iteratee
import qualified Data.Iteratee.Base.StreamChunk as SC
import Data.Iteratee.WrappedByteString
import Data.Monoid (mappend)
-import Data.Word (Word8)
+import Foreign
import Prelude hiding (catch,drop)
import System.IO.Posix.MMap
import qualified Data.DList as D
@@ -142,8 +144,87 @@ bufferIteratee = return . go (D.empty,0)
n' = n+m
dl' = D.snoc dl s
big = toWrap $ L.fromChunks [S.concat $ D.toList dl']
-
+
+------------------------------------------------------------------------------
+-- | Buffers an iteratee, \"unsafely\". Here we use a fixed binary buffer which
+-- we'll re-use, meaning that if you hold on to any of the bytestring data
+-- passed into your iteratee (instead of, let's say, shoving it right out a
+-- socket) it'll get changed out from underneath you, breaking referential
+-- transparency. Use with caution!
+--
+unsafeBufferIteratee :: Enumerator IO a
+unsafeBufferIteratee iteratee = do
+ buf <- mallocForeignPtrBytes bufsiz
+ return $ go 0 buf iteratee
+
+ where
+ bufsiz = 8192
+
+ go bytesSoFar buf iter = IterateeG $! f bytesSoFar buf iter
+
+ sendBuf n buf iter = withForeignPtr buf $ \ptr -> do
+ s <- S.unsafePackCStringLen (ptr, n)
+ runIter iter $ Chunk $ WrapBS s
+
+ copy c@(EOF _) = c
+ copy c@(Chunk (WrapBS s)) = Chunk $ WrapBS $ S.copy s
+
+ f _ _ iter ch@(EOF (Just _)) = runIter iter ch
+
+ f !n buf iter ch@(EOF Nothing) =
+ if n == 0
+ then runIter iter ch
+ else do
+ iterv <- sendBuf n buf iter
+ case iterv of
+ Done x rest -> return $ Done x $ copy rest
+ Cont i (Just e) -> return $ Cont i (Just e)
+ Cont i Nothing -> runIter i ch
+
+ f !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
+
+ copyAndCont 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
+
+
+ overflow n buf iter s m = do
+ let rest = bufsiz - n
+ let m2 = m - rest
+ let (s1,s2) = S.splitAt rest s
+
+ S.unsafeUseAsCStringLen s1 $ \(p,_) ->
+ withForeignPtr buf $ \bufp -> do
+ let b' = plusPtr bufp n
+ copyBytes b' p rest
+
+ iv <- sendBuf bufsiz buf iter
+ case iv of
+ Done x r -> return $
+ Done x (copy r `mappend` (Chunk $ WrapBS s2))
+ Cont i (Just e) -> return $ Cont i (Just e)
+ Cont i Nothing -> do
+ -- check the size of the remainder; if it's bigger than the
+ -- buffer size then just send it
+ if m2 >= bufsiz
+ then do
+ iv' <- runIter i (Chunk $ WrapBS s2)
+ 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
+
+
------------------------------------------------------------------------------
-- | Enumerates a strict bytestring.
enumBS :: (Monad m) => ByteString -> Enumerator m a
diff --git a/test/suite/Snap/Iteratee/Tests.hs
b/test/suite/Snap/Iteratee/Tests.hs
index 882a6f7..cc9c927 100644
--- a/test/suite/Snap/Iteratee/Tests.hs
+++ b/test/suite/Snap/Iteratee/Tests.hs
@@ -11,6 +11,9 @@ import Control.Monad
import Control.Monad.Identity
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Monoid
+import Data.Iteratee.WrappedByteString
+import Data.Word
import Prelude hiding (drop, take)
import Test.Framework
import Test.Framework.Providers.QuickCheck2
@@ -19,6 +22,7 @@ import qualified Test.QuickCheck.Monadic as QC
import Test.QuickCheck.Monadic hiding (run)
import Test.Framework.Providers.HUnit
import qualified Test.HUnit as H
+import System.IO.Unsafe
import Snap.Iteratee
import Snap.Test.Common ()
@@ -41,6 +45,11 @@ tests = [ testEnumBS
, testBuffer2
, testBuffer3
, testBuffer4
+ , testUnsafeBuffer
+ , testUnsafeBuffer2
+ , testUnsafeBuffer3
+ , testUnsafeBuffer4
+ , testUnsafeBuffer5
, testTakeExactly1
, testTakeExactly2
, testTakeExactly3
@@ -115,6 +124,91 @@ testBuffer4 = testProperty "testBuffer4" $
expectException $ run k
+copyingStream2stream :: Iteratee IO (WrappedByteString Word8)
+copyingStream2stream = IterateeG (step mempty)
+ where
+ step acc (Chunk (WrapBS ls))
+ | S.null ls = return $ Cont (IterateeG (step acc)) Nothing
+ | otherwise = do
+ let !ls' = S.copy ls
+ let !bs' = WrapBS $! ls'
+ return $ Cont (IterateeG (step (acc `mappend` bs')))
+ Nothing
+
+ step acc str = return $ Done acc str
+
+
+bufferAndRun :: Iteratee IO a -> L.ByteString -> IO a
+bufferAndRun ii s = do
+ i <- unsafeBufferIteratee ii
+ iter <- enumLBS s i
+ run iter
+
+
+testUnsafeBuffer :: Test
+testUnsafeBuffer = testProperty "testUnsafeBuffer" $
+ monadicIO $ forAllM arbitrary prop
+ where
+ prop s = do
+ pre $ s /= L.empty
+ x <- liftQ $ bufferAndRun copyingStream2stream s'
+ assert $ fromWrap x == s'
+
+ where
+ s' = L.take 20000 $ L.cycle s
+
+
+testUnsafeBuffer2 :: Test
+testUnsafeBuffer2 = testCase "testUnsafeBuffer2" prop
+ where
+ prop = do
+ i <- unsafeBufferIteratee $ drop 4 >> copyingStream2stream
+
+ s <- enumLBS "abcdefgh" i >>= run >>= return . fromWrap
+ H.assertEqual "s == 'efgh'" "efgh" s
+
+
+testUnsafeBuffer3 :: Test
+testUnsafeBuffer3 = testProperty "testUnsafeBuffer3" $
+ monadicIO $ forAllM arbitrary prop
+ where
+ prop s = do
+ pre $ s /= L.empty
+ x <- liftQ $ bufferAndRun (ss >>= \x -> drop 1 >> return x) s'
+
+ assert $ fromWrap x == (L.take 19999 s')
+ where
+ s' = L.take 20000 $ L.cycle s
+ ss = joinI $ take 19999 copyingStream2stream
+
+
+testUnsafeBuffer4 :: Test
+testUnsafeBuffer4 = testProperty "testUnsafeBuffer4" $
+ monadicIO $ forAllM arbitrary prop
+ where
+ prop s = do
+ i <- liftQ $ unsafeBufferIteratee (copyingStream2stream >> throwErr
(Err "foo"))
+ i' <- liftQ $ enumLBS s i
+ expectException $ run i'
+
+ j <- liftQ $ unsafeBufferIteratee (throwErr (Err "foo") >>
copyingStream2stream)
+ j' <- liftQ $ enumLBS s j
+ expectException $ run j'
+
+ k <- liftQ $ enumErr "foo" j
+ expectException $ run k
+
+
+testUnsafeBuffer5 :: Test
+testUnsafeBuffer5 = testProperty "testUnsafeBuffer5" $
+ monadicIO $ forAllM arbitrary prop
+ where
+ prop s = do
+ pre $ s /= L.empty
+ x <- liftQ $ bufferAndRun copyingStream2stream s
+ assert $ fromWrap x == s
+
+
testTakeExactly1 :: Test
testTakeExactly1 = testProperty "short stream" $
monadicIO $ forAllM arbitrary prop
-----------------------------------------------------------------------
hooks/post-receive
--
snap-core
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
