Permalink
Browse files

Merge branch 'enumerator'

  • Loading branch information...
2 parents 5e4850d + d7e7d6d commit b298f8eddd8470e2fd2bb580940ff4bf546b0fe2 @gregorycollins gregorycollins committed Dec 5, 2010
View
@@ -118,7 +118,7 @@ Library
build-depends:
array >= 0.2 && <0.4,
attoparsec >= 0.8.1 && < 0.9,
- attoparsec-iteratee >= 0.1.1 && <0.2,
+ attoparsec-enumerator >= 0.2.0.1 && < 0.3,
base >= 4 && < 5,
binary >=0.5 && <0.6,
bytestring,
@@ -128,10 +128,10 @@ Library
containers,
directory-tree,
dlist >= 0.5 && < 0.6,
+ enumerator == 0.4.*,
filepath,
- iteratee >= 0.3.1 && <0.4,
MonadCatchIO-transformers >= 0.2.1 && < 0.3,
- monads-fd < 0.1.0.3,
+ mtl == 2.0.*,
murmur-hash >= 0.1 && < 0.2,
network == 2.2.1.*,
old-locale,
@@ -50,7 +50,7 @@ import Data.List
import Data.Monoid
import Prelude hiding (catch)
import Snap.Types
-import Snap.Iteratee ((>.), enumBS)
+import Snap.Iteratee ((>==>), enumBS)
import System.Console.GetOpt
import System.Environment hiding (getEnv)
#ifndef PORTABLE
@@ -195,7 +195,7 @@ defaultConfig = Config
finishWith $ setContentType "text/plain; charset=utf-8"
. setContentLength (fromIntegral $ B.length msg)
. setResponseStatus 500 "Internal Server Error"
- . modifyResponseBody (>. enumBS msg)
+ . modifyResponseBody (>==> enumBS msg)
$ emptyResponse
, other = Nothing
}
@@ -8,7 +8,7 @@ module Snap.Internal.Http.Parser
( IRequest(..)
, parseRequest
, readChunkedTransferEncoding
- , parserToIteratee
+ , iterParser
, parseCookie
, parseUrlEncoded
, writeChunkedTransferEncoding
@@ -20,9 +20,9 @@ module Snap.Internal.Http.Parser
import Control.Applicative
import Control.Arrow (second)
import Control.Monad (liftM)
-import "monads-fd" Control.Monad.Trans
+import Control.Monad.Trans
import Data.Attoparsec hiding (many, Result(..))
-import Data.Attoparsec.Iteratee
+import Data.Attoparsec.Enumerator
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
@@ -34,17 +34,19 @@ import Data.DList (DList)
import qualified Data.DList as D
import Data.List (foldl')
import Data.Int
-import Data.Iteratee.WrappedByteString
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import qualified Data.Vector.Unboxed as Vec
import Data.Vector.Unboxed (Vector)
import Data.Word (Word8, Word64)
-import Prelude hiding (take, takeWhile)
+import Prelude hiding (head, take, takeWhile)
+import qualified Prelude
------------------------------------------------------------------------------
-import Snap.Internal.Http.Types hiding (Enumerator)
-import Snap.Iteratee hiding (take, foldl', filter)
+import Snap.Internal.Http.Types
+import Snap.Internal.Debug
+import Snap.Internal.Iteratee.Debug
+import Snap.Iteratee hiding (map, take)
------------------------------------------------------------------------------
@@ -70,18 +72,17 @@ instance Show IRequest where
------------------------------------------------------------------------------
-parseRequest :: (Monad m) => Iteratee m (Maybe IRequest)
-parseRequest = parserToIteratee pRequest
+parseRequest :: (Monad m) => Iteratee ByteString m (Maybe IRequest)
+parseRequest = iterParser pRequest
------------------------------------------------------------------------------
-readChunkedTransferEncoding :: (Monad m) =>
- Iteratee m a
- -> m (Iteratee m a)
-readChunkedTransferEncoding iter = do
- i <- chunkParserToEnumerator (parserToIteratee pGetTransferChunk)
- iter
- return i
+readChunkedTransferEncoding :: (MonadIO m) =>
+ Enumeratee ByteString ByteString m a
+readChunkedTransferEncoding =
+ chunkParserToEnumeratee $
+ iterateeDebugWrapper "pGetTransferChunk" $
+ iterParser pGetTransferChunk
------------------------------------------------------------------------------
@@ -108,6 +109,8 @@ toHex n' = s
-- chunked transfer-encoding. Example usage:
--
--
+-- > FIXME this text is now wrong
+--
-- > > (writeChunkedTransferEncoding
-- > (enumLBS (L.fromChunks ["foo","bar","quux"]))
-- > stream2stream) >>=
@@ -116,98 +119,91 @@ toHex n' = s
-- >
-- > Chunk "a\r\nfoobarquux\r\n0\r\n\r\n" Empty
--
-writeChunkedTransferEncoding :: Enumerator IO a
-writeChunkedTransferEncoding it = do
- let out = wrap it
- return out
+writeChunkedTransferEncoding :: Enumeratee ByteString ByteString IO a
+writeChunkedTransferEncoding = checkDone start
where
- wrap iter = bufIt (0,D.empty) iter
+ start = bufIt 0 D.empty
bufSiz = 16284
sendOut :: DList ByteString
- -> Iteratee IO a
- -> IO (Iteratee IO a)
- sendOut dl iter = do
+ -> (Stream ByteString -> Iteratee ByteString IO a)
+ -> Iteratee ByteString IO (Step ByteString IO a)
+ sendOut dl k = do
let chunks = D.toList dl
let bs = L.fromChunks chunks
let n = L.length bs
if n == 0
- then return iter
+ then return $ Continue k
else do
let o = L.concat [ L.fromChunks [ toHex (toEnum . fromEnum $ n)
, "\r\n" ]
, bs
, "\r\n" ]
- enumLBS o iter
-
+ lift $ runIteratee $ enumLBS o (Continue k)
- bufIt (n,dl) iter = IterateeG $ \s -> do
- case s of
- (EOF Nothing) -> do
- i' <- sendOut dl iter
- j <- liftM liftI $ runIter i' (Chunk (WrapBS "0\r\n\r\n"))
- runIter j (EOF Nothing)
- (EOF e) -> return $ Cont undefined e
+
+ bufIt :: Int
+ -> DList ByteString
+ -> (Stream ByteString -> Iteratee ByteString IO a)
+ -> Iteratee ByteString IO (Step ByteString IO a)
+ bufIt n dl k = do
+ mbS <- head
+ case mbS of
+ Nothing -> do
+ step <- sendOut dl k
+ step' <- lift $ runIteratee $ enumBS "0\r\n\r\n" step
+ lift $ runIteratee $ enumEOF step'
- (Chunk (WrapBS x)) -> do
- let m = S.length x
+ (Just s) -> do
+ let m = S.length s
- if m == 0
- then return $ Cont (bufIt (n,dl) iter) Nothing
- else do
- let n' = m + n
- let dl' = D.snoc dl x
+ if m == 0
+ then bufIt n dl k
+ else do
+ let n' = m + n
+ let dl' = D.snoc dl s
- if n' > bufSiz
- then do
- i' <- sendOut dl' iter
- return $ Cont (bufIt (0,D.empty) i') Nothing
- else return $ Cont (bufIt (n',dl') iter) Nothing
+ if n' > bufSiz
+ then do
+ step <- sendOut dl' k
+ checkDone start step
+ else bufIt n' dl' k
------------------------------------------------------------------------------
-chunkParserToEnumerator :: (Monad m) =>
- Iteratee m (Maybe ByteString)
- -> Iteratee m a
- -> m (Iteratee m a)
-chunkParserToEnumerator getChunk client = return $ do
+chunkParserToEnumeratee :: (MonadIO m) =>
+ Iteratee ByteString m (Maybe ByteString)
+ -> Enumeratee ByteString ByteString m a
+chunkParserToEnumeratee getChunk client = do
+ debug $ "chunkParserToEnumeratee: getting chunk"
mbB <- getChunk
- maybe (finishIt client) (sendBS client) mbB
-
- where
- sendBS iter s = do
- v <- lift $ runIter iter (Chunk $ toWrap $ L.fromChunks [s])
+ debug $ "chunkParserToEnumeratee: getChunk was " ++ show mbB
+ mbX <- peek
+ debug $ "chunkParserToEnumeratee: .. and peek is " ++ show mbX
- case v of
- (Done _ (EOF (Just e))) -> throwErr e
- (Done x _) -> return x
+ maybe finishIt sendBS mbB
- (Cont _ (Just e)) -> throwErr e
-
- (Cont k Nothing) -> joinIM $
- chunkParserToEnumerator getChunk k
-
- finishIt iter = do
- e <- lift $ sendEof iter
-
- case e of
- Left x -> throwErr x
- Right x -> return x
+ where
+ whatWasReturn (Continue _) = "continue"
+ whatWasReturn (Yield _ z) = "yield, with remainder " ++ show z
+ whatWasReturn (Error e) = "error, with " ++ show e
- sendEof iter = do
- v <- runIter iter (EOF Nothing)
+ sendBS s = do
+ step' <- lift $ runIteratee $ enumBS s client
+ debug $ "chunkParserToEnumeratee: after sending "
+ ++ show s ++ ", return was "
+ ++ whatWasReturn step'
+ mbX <- peek
+ debug $ "chunkParserToEnumeratee: .. and peek is " ++ show mbX
+ chunkParserToEnumeratee getChunk step'
- return $ case v of
- (Done _ (EOF (Just e))) -> Left e
- (Done x _) -> Right x
- (Cont _ (Just e)) -> Left e
- (Cont _ _) -> Left $ Err $ "divergent iteratee"
+ finishIt = lift $ runIteratee $ enumEOF client
------------------------------------------------------------------------------
@@ -252,7 +248,8 @@ pSpaces = takeWhile (isSpace . w2c)
------------------------------------------------------------------------------
-- | Parser for the internal request data type.
pRequest :: Parser (Maybe IRequest)
-pRequest = (Just <$> pRequest') <|> (endOfInput *> pure Nothing)
+pRequest = (Just <$> pRequest') <|>
+ (option "" crlf *> endOfInput *> pure Nothing)
------------------------------------------------------------------------------
Oops, something went wrong.

0 comments on commit b298f8e

Please sign in to comment.