snap-core 0.2.3 → 0.2.4
raw patch · 12 files changed
+403/−122 lines, 12 filesdep +directory-treedep +template-haskelldep +unix-compatdep −unix
Dependencies added: directory-tree, template-haskell, unix-compat
Dependencies removed: unix
Files
- CONTRIBUTORS +2/−0
- cbits/timefuncs.c +7/−1
- snap-core.cabal +16/−6
- src/Snap/Internal/Debug.hs +1/−1
- src/Snap/Internal/Http/Types.hs +68/−23
- src/Snap/Internal/Types.hs +1/−1
- src/Snap/Iteratee.hs +167/−12
- src/Snap/Starter.hs +29/−72
- src/Snap/Util/FileServe.hs +2/−1
- src/Snap/Util/GZip.hs +1/−1
- test/snap-core-testsuite.cabal +13/−4
- test/suite/Snap/Iteratee/Tests.hs +96/−0
CONTRIBUTORS view
@@ -1,4 +1,6 @@ Doug Beardsley <mightybyte@gmail.com> Gregory Collins <greg@gregorycollins.net> Shu-yu Guo <shu@rfrn.org>+Carl Howells James Sanders <jimmyjazz14@gmail.com>+Jacob Stanley <jystic@jystic.com>
cbits/timefuncs.c view
@@ -11,11 +11,17 @@ time_t c_parse_http_time(char* s) { struct tm dest; strptime(s, "%a, %d %b %Y %H:%M:%S GMT", &dest);- return mktime(&dest);+ return timegm(&dest); } void c_format_http_time(time_t src, char* dest) { struct tm t; gmtime_r(&src, &t); strftime(dest, 40, "%a, %d %b %Y %H:%M:%S GMT", &t);+}++void c_format_log_time(time_t src, char* dest) {+ struct tm t;+ localtime_r(&src, &t);+ strftime(dest, 40, "%d/%b/%Y:%H:%M:%S %z", &t); }
snap-core.cabal view
@@ -1,5 +1,5 @@ name: snap-core-version: 0.2.3+version: 0.2.4 synopsis: Snap: A Haskell Web Framework (Core) description:@@ -100,6 +100,11 @@ be evaluated but not printed. Default: False +Flag portable+ Description: Compile in cross-platform mode. No platform-specific code or+ optimizations such as C routines will be used.+ Default: False+ Library hs-source-dirs: src @@ -109,8 +114,12 @@ if flag(testsuite) cpp-options: -DDEBUG_TEST - c-sources: cbits/timefuncs.c- include-dirs: cbits+ if flag(portable) || os(windows)+ cpp-options: -DPORTABLE+ else+ c-sources: cbits/timefuncs.c+ include-dirs: cbits+ build-depends: bytestring-mmap >= 0.2.1 && <0.3 exposed-modules: Data.CIByteString,@@ -130,7 +139,6 @@ attoparsec >= 0.8.0.2 && < 0.9, base >= 4 && < 5, bytestring,- bytestring-mmap >= 0.2.1 && <0.3, bytestring-nums, cereal >= 0.2 && < 0.3, containers,@@ -145,7 +153,7 @@ text >= 0.7.1 && <0.8, time, transformers,- unix,+ unix-compat, zlib ghc-prof-options: -prof -auto-all@@ -168,6 +176,7 @@ cereal >= 0.2 && < 0.3, containers, directory,+ directory-tree, dlist >= 0.5 && < 0.6, filepath, haskell98,@@ -175,10 +184,11 @@ monads-fd, old-locale, old-time,+ template-haskell, text >= 0.7.1 && <0.8, time, transformers,- unix,+ unix-compat, zlib ghc-prof-options: -prof -auto-all
src/Snap/Internal/Debug.hs view
@@ -37,7 +37,7 @@ ------------------------------------------------------------------------------ _debugMVar :: MVar () _debugMVar = unsafePerformIO $ newMVar ()-+{-# NOINLINE _debugMVar #-} ------------------------------------------------------------------------------ debug :: (MonadIO m) => String -> m ()
src/Snap/Internal/Http/Types.hs view
@@ -5,6 +5,7 @@ -- unsafe/encapsulation-breaking ones) are re-exported from "Snap.Types". {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-}@@ -24,6 +25,7 @@ import Data.ByteString.Internal (c2w,w2c) import qualified Data.ByteString.Nums.Careless.Hex as Cvt import qualified Data.ByteString as S+import qualified Data.ByteString.Unsafe as S import Data.Char import Data.DList (DList) import qualified Data.DList as DL@@ -36,30 +38,42 @@ import Data.Time.Format import Data.Word import Foreign hiding (new)-import Foreign.C.String import Foreign.C.Types import Prelude hiding (take) import System.Locale (defaultTimeLocale) ++#ifdef PORTABLE+import Data.Time.LocalTime+import Data.Time.Clock.POSIX+#else+import Foreign.C.String+#endif+ ------------------------------------------------------------------------------ import Data.CIByteString import qualified Snap.Iteratee as I +#ifndef PORTABLE+ ------------------------------------------------------------------------------+-- foreign imports from cbits+ foreign import ccall unsafe "set_c_locale" set_c_locale :: IO () -------------------------------------------------------------------------------- foreign import ccall unsafe "c_parse_http_time" c_parse_http_time :: CString -> IO CTime -------------------------------------------------------------------------------- foreign import ccall unsafe "c_format_http_time" c_format_http_time :: CTime -> CString -> IO () +foreign import ccall unsafe "c_format_log_time"+ c_format_log_time :: CTime -> CString -> IO ()++#endif+ ------------------------------------------------------------------------------ type Enumerator a = I.Enumerator IO a @@ -502,31 +516,62 @@ ------------------------------------------------------------------------------ -- HTTP dates -{---- | Converts a 'ClockTime' into an HTTP timestamp.-formatHttpTime :: UTCTime -> ByteString-formatHttpTime = fromStr . formatTime defaultTimeLocale "%a, %d %b %Y %X GMT"---- | Converts an HTTP timestamp into a 'UTCTime'.-parseHttpTime :: ByteString -> Maybe UTCTime-parseHttpTime s' =- parseTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S GMT" s- where- s = toStr s'--}- -- | Converts a 'CTime' into an HTTP timestamp. formatHttpTime :: CTime -> IO ByteString-formatHttpTime t = allocaBytes 40 $ \ptr -> do- c_format_http_time t ptr- S.packCString ptr +-- | Converts a 'CTime' into common log entry format.+formatLogTime :: CTime -> IO ByteString ------------------------------------------------------------------------------- -- | Converts an HTTP timestamp into a 'CTime'. parseHttpTime :: ByteString -> IO CTime-parseHttpTime s = S.useAsCString s $ \ptr ->++#ifdef PORTABLE++formatHttpTime = return . format . toUTCTime+ where+ format :: UTCTime -> ByteString+ format = fromStr . formatTime defaultTimeLocale "%a, %d %b %Y %X GMT"++ toUTCTime :: CTime -> UTCTime+ toUTCTime = posixSecondsToUTCTime . realToFrac++formatLogTime ctime = do+ t <- utcToLocalZonedTime $ toUTCTime ctime+ return $ format t++ where+ format :: ZonedTime -> ByteString+ format = fromStr . formatTime defaultTimeLocale "%d/%b/%Y:%H:%M:%S %z"++ toUTCTime :: CTime -> UTCTime+ toUTCTime = posixSecondsToUTCTime . realToFrac+++parseHttpTime = return . toCTime . parse . toStr+ where+ parse :: String -> Maybe UTCTime+ parse = parseTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S GMT"++ toCTime :: Maybe UTCTime -> CTime+ toCTime (Just t) = fromInteger $ truncate $ utcTimeToPOSIXSeconds t+ toCTime Nothing = fromInteger 0++#else++formatLogTime t = do+ ptr <- mallocBytes 40+ c_format_log_time t ptr+ S.unsafePackMallocCString ptr++formatHttpTime t = do+ ptr <- mallocBytes 40+ c_format_http_time t ptr+ S.unsafePackMallocCString ptr++parseHttpTime s = S.unsafeUseAsCString s $ \ptr -> c_parse_http_time ptr++#endif ------------------------------------------------------------------------------
src/Snap/Internal/Types.hs view
@@ -84,7 +84,7 @@ ------------------------------------------------------------------------------ newtype Snap a = Snap { unSnap :: StateT SnapState (Iteratee IO) (Maybe (Either Response a))-}+} deriving Typeable ------------------------------------------------------------------------------
src/Snap/Iteratee.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -36,23 +37,40 @@ , takeNoMoreThan , countBytes , bufferIteratee+ , mkIterateeBuffer+ , unsafeBufferIterateeWithBuffer+ , unsafeBufferIteratee ) where -------------------------------------------------------------------------------import Control.Exception (SomeException) 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.IORef import Data.Iteratee+#ifdef PORTABLE+import Data.Iteratee.IO (enumHandle)+#endif import qualified Data.Iteratee.Base.StreamChunk as SC import Data.Iteratee.WrappedByteString import Data.Monoid (mappend)-import Data.Word (Word8)+import Foreign+import Foreign.C.Types+import GHC.ForeignPtr import Prelude hiding (catch,drop)-import System.IO.Posix.MMap import qualified Data.DList as D++#ifdef PORTABLE+import Control.Monad.Trans (liftIO)+import System.IO+#else+import Control.Exception (SomeException)+import System.IO.Posix.MMap+#endif+ ------------------------------------------------------------------------------ type Stream = StreamG WrappedByteString Word8@@ -67,11 +85,11 @@ --catch :: Exception e => m a -> (e -> m a) -> m a catch m handler = IterateeG $ \str -> do ee <- try $ runIter m str- case ee of + case ee of (Left e) -> runIter (handler e) str (Right v) -> return v - --block :: m a -> m a + --block :: m a -> m a block m = IterateeG $ \str -> block $ runIter m str unblock m = IterateeG $ \str -> unblock $ runIter m str @@ -126,8 +144,8 @@ Cont i Nothing -> runIter i ch where big = toWrap $ L.fromChunks [S.concat $ D.toList dl]- - f (!dl,!n) iter (Chunk ws) =++ f (!dl,!n) iter (Chunk (WrapBS s)) = if n' > blocksize then do iterv <- runIter iter (Chunk big)@@ -137,14 +155,136 @@ Cont i Nothing -> return $ Cont (go (D.empty,0) i) Nothing else return $ Cont (go (dl',n') iter) Nothing where- s = S.concat $ L.toChunks $ fromWrap ws m = S.length s n' = n+m dl' = D.snoc dl s big = toWrap $ L.fromChunks [S.concat $ D.toList dl']- ++bUFSIZ :: Int+bUFSIZ = 8192+++-- | Creates a buffer to be passed into 'unsafeBufferIterateeWithBuffer'.+mkIterateeBuffer :: IO (ForeignPtr CChar)+mkIterateeBuffer = mallocPlainForeignPtrBytes bUFSIZ+ ------------------------------------------------------------------------------+-- | 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!+--+-- 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 iter = do+ buf <- mkIterateeBuffer+ unsafeBufferIterateeWithBuffer buf iter+++------------------------------------------------------------------------------+-- | 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!+--+-- This version accepts a buffer created by 'mkIterateeBuffer'.+--+-- 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.+--+unsafeBufferIterateeWithBuffer :: ForeignPtr CChar+ -> Iteratee IO a+ -> IO (Iteratee IO a, IORef Bool)+unsafeBufferIterateeWithBuffer buf iteratee = do+ esc <- newIORef False+ return $! (start esc iteratee, esc)++ where+ start esc iter = IterateeG $! checkRef esc iter+ go bytesSoFar iter =+ {-# SCC "unsafeBufferIteratee/go" #-}+ IterateeG $! f bytesSoFar iter++ checkRef esc iter ch = do+ quit <- readIORef esc+ if quit+ then runIter iter ch+ else f 0 iter ch++ sendBuf n iter =+ {-# SCC "unsafeBufferIteratee/sendBuf" #-}+ withForeignPtr buf $ \ptr -> do+ s <- S.unsafePackCStringLen (ptr, n)+ runIter iter $ Chunk $ WrapBS s++ copy c@(EOF _) = c+ copy (Chunk (WrapBS s)) = Chunk $ WrapBS $ S.copy s++ f _ iter ch@(EOF (Just _)) = runIter iter ch++ f !n iter ch@(EOF Nothing) =+ if n == 0+ then runIter iter ch+ else do+ iterv <- sendBuf n 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 iter (Chunk (WrapBS s)) = do+ let m = S.length s+ if m+n > bUFSIZ+ then overflow n iter s m+ else copyAndCont n iter s m++ copyAndCont n iter s m =+ {-# SCC "unsafeBufferIteratee/copyAndCont" #-} do+ S.unsafeUseAsCStringLen s $ \(p,sz) ->+ withForeignPtr buf $ \bufp -> do+ let b' = plusPtr bufp n+ copyBytes b' p sz++ return $ Cont (go (n+m) iter) Nothing+++ overflow n iter s m =+ {-# SCC "unsafeBufferIteratee/overflow" #-} 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 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 i') Nothing+ else copyAndCont 0 i s2 m2+++------------------------------------------------------------------------------ -- | Enumerates a strict bytestring. enumBS :: (Monad m) => ByteString -> Enumerator m a enumBS bs = enumPure1Chunk $ WrapBS bs@@ -156,9 +296,9 @@ enumLBS :: (Monad m) => L.ByteString -> Enumerator m a enumLBS lbs = el chunks where- el [] i = return i+ el [] i = liftM liftI $ runIter i (EOF Nothing) el (x:xs) i = do- i' <- enumBS x i+ i' <- liftM liftI $ runIter i (Chunk $ WrapBS x) el xs i' chunks = L.toChunks lbs@@ -251,11 +391,26 @@ ------------------------------------------------------------------------------ enumFile :: FilePath -> Iteratee IO a -> IO (Iteratee IO a)++#ifdef PORTABLE+ enumFile fp iter = do+ h <- liftIO $ openBinaryFile fp ReadMode+ i' <- enumHandle h iter+ return $ do+ x <- i'+ liftIO (hClose h)+ return x++#else++enumFile fp iter = do es <- (try $ liftM WrapBS $ unsafeMMapFile fp) :: IO (Either SomeException (WrappedByteString Word8))- + case es of (Left e) -> return $ throwErr $ Err $ "IO error" ++ show e (Right s) -> liftM liftI $ runIter iter $ Chunk s++#endif
src/Snap/Starter.hs view
@@ -1,14 +1,25 @@+{-# LANGUAGE TemplateHaskell #-} module Main where -------------------------------------------------------------------------------import System-import System.Directory-import System.Console.GetOpt-import System.FilePath.Posix+import Data.List+import qualified Data.Text as T+import System+import System.Directory+import System.Console.GetOpt+import System.FilePath ------------------------------------------------------------------------------ +import Snap.StarterTH + ------------------------------------------------------------------------------+-- Creates a value tDir :: ([String], [(String, String)])+$(buildData "tDirDefault" "default")+$(buildData "tDirBareBones" "barebones")+++------------------------------------------------------------------------------ usage :: String usage = unlines ["Usage:"@@ -26,6 +37,19 @@ deriving (Show, Eq) +setup :: String -> ([FilePath], [(String, String)]) -> IO ()+setup projName tDir = do+ mapM createDirectory (fst tDir)+ mapM_ write (snd tDir)+ where+ write (f,c) =+ if isSuffixOf "foo.cabal" f+ then writeFile (projName++".cabal") (insertProjName $ T.pack c)+ else writeFile f c+ insertProjName c = T.unpack $ T.replace+ (T.pack "projname")+ (T.pack projName) c+ ------------------------------------------------------------------------------ initProject :: [String] -> IO () initProject args = do@@ -59,9 +83,7 @@ cur <- getCurrentDirectory let dirs = splitDirectories cur projName = last dirs- writeFile (projName++".cabal") (cabalFile projName isBareBones)- createDirectory "src"- writeFile "src/Main.hs" (mainFile isBareBones)+ setup projName (if isBareBones then tDirBareBones else tDirDefault) ------------------------------------------------------------------------------@@ -72,69 +94,4 @@ ("init":args') -> initProject args' _ -> do putStrLn usage exitFailure----------------------------------------------------------------------------------cabalFile :: String -> Bool -> String-cabalFile projName isBareBones = unlines $- ["Name: "++projName- ,"Version: 0.1"- ,"Synopsis: Project Synopsis Here"- ,"Description: Project Description Here"- ,"License: AllRightsReserved"- ,"Author: Author"- ,"Maintainer: maintainer@example.com"- ,"Stability: Experimental"- ,"Category: Web"- ,"Build-type: Simple"- ,"Cabal-version: >=1.2"- ,""- ,"Executable "++projName- ," hs-source-dirs: src"- ," main-is: Main.hs"- ,""- ," Build-depends:"- ," base >= 4,"- ," haskell98,"- ," monads-fd >= 0.1 && <0.2,"- ," bytestring >= 0.9.1 && <0.10,"- ," snap-core >= 0.2 && <0.3,"- ," snap-server >= 0.2 && <0.3,"- ] ++ (if isBareBones then [] else [" heist >= 0.1 && <0.2,"]) ++- [" filepath >= 1.1 && <1.2"- ,""- ," ghc-options: -O2 -Wall -fwarn-tabs -funbox-strict-fields -threaded -fno-warn-unused-imports"- ]----------------------------------------------------------------------------------mainFile :: Bool -> String-mainFile isBareBones = unlines $- ["{-# LANGUAGE OverloadedStrings #-}"- ,"module Main where"- ,""- ,"import System"- ,"import Control.Applicative"- ,"import Control.Monad.Trans"- ,"import Snap.Http.Server"- ,"import Snap.Types"- ,"import Snap.Util.FileServe"- ] ++ (if isBareBones then [] else ["import Text.Templating.Heist"]) ++- [""- ,"site :: Snap ()"- ,"site ="- ," ifTop (writeBS \"hello world\") <|>"- ," fileServe \".\""- ,""- ,"main :: IO ()"- ,"main = do"- ," args <- getArgs"- ," let port = case args of"- ," [] -> 8000"- ," p:_ -> read p"- ," httpServe \"*\" port \"myserver\""- ," (Just \"access.log\")"- ," (Just \"error.log\")"- ," site"- ]
src/Snap/Util/FileServe.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -23,7 +24,7 @@ import Data.Maybe (fromMaybe) import System.Directory import System.FilePath-import System.Posix.Files+import System.PosixCompat.Files ------------------------------------------------------------------------------ import Snap.Types
src/Snap/Util/GZip.hs view
@@ -300,7 +300,7 @@ coding = string "*" <|> takeWhile isCodingChar - isCodingChar c = isAlpha_ascii c || c == '-'+ isCodingChar ch = isDigit ch || isAlpha_ascii ch || ch == '-' || ch == '_' float = takeWhile isDigit >> option () (char '.' >> takeWhile isDigit >> pure ())
test/snap-core-testsuite.cabal view
@@ -12,9 +12,12 @@ be evaluated but not printed. Default: False +Flag portable+ Description: Compile in cross-platform mode. No platform-specific code or+ optimizations such as C routines will be used.+ Default: False+ Executable testsuite- c-sources: ../cbits/timefuncs.c- include-dirs: ../cbits hs-source-dirs: ../src suite main-is: TestSuite.hs @@ -24,12 +27,18 @@ if flag(testsuite) cpp-options: -DDEBUG_TEST + if flag(portable) || os(windows)+ cpp-options: -DPORTABLE+ else+ c-sources: ../cbits/timefuncs.c+ include-dirs: ../cbits+ build-depends: bytestring-mmap >= 0.2.1 && <0.3+ build-depends: QuickCheck >= 2, attoparsec >= 0.8.0.2 && < 0.9, base >= 4 && < 5, bytestring,- bytestring-mmap >= 0.2.1 && <0.3, bytestring-nums, cereal >= 0.2 && < 0.3, containers,@@ -49,7 +58,7 @@ text >= 0.7.1 && <0.8, time, transformers,- unix,+ unix-compat, zlib ghc-options: -O2 -Wall -fhpc -fwarn-tabs -funbox-strict-fields -threaded
test/suite/Snap/Iteratee/Tests.hs view
@@ -11,6 +11,9 @@ 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 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 @@ , testBuffer2 , testBuffer3 , testBuffer4+ , testUnsafeBuffer+ , testUnsafeBuffer2+ , testUnsafeBuffer3+ , testUnsafeBuffer4+ , testUnsafeBuffer5 , testTakeExactly1 , testTakeExactly2 , testTakeExactly3@@ -113,6 +122,93 @@ k <- liftQ $ enumErr "foo" j 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