netlines 0.3.0 → 0.4.0
raw patch · 2 files changed
+95/−45 lines, 2 filesdep +time
Dependencies added: time
Files
- Data/Enumerator/NetLines.hs +92/−43
- netlines.cabal +3/−2
Data/Enumerator/NetLines.hs view
@@ -7,7 +7,7 @@ -- -- Enumerator tools for working with text-based network protocols. -{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-} module Data.Enumerator.NetLines ( -- * Iteratees@@ -27,46 +27,102 @@ netSplitsBy, -- * Enumerators+ TimeoutError(..),+ enumHandleSession, enumHandleTimeout ) where import qualified Data.ByteString as B-import Control.Arrow import Control.ContStuff as Monad+import Control.Exception as Ex import Data.ByteString (ByteString) import Data.Enumerator as E+import Data.Time.Clock+import Data.Typeable import Data.Word import System.IO import System.IO.Error as IOErr +-- | Exception for timed out IO operations.++newtype TimeoutError = TimeoutError { timeoutErrorMessage :: String }+ deriving (Typeable)++instance Ex.Exception TimeoutError++instance Show TimeoutError where+ show (TimeoutError msg) = "Operation timed out: " ++ msg+++-- | Enumerate from a handle with the given buffer size (first+-- argument), read timeout in milliseconds (second argument) and session+-- timeout in milliseconds (third argument). If either timeout is+-- exceeded a 'TimeoutError' exception is thrown via 'throwError'.++enumHandleSession ::+ forall b m. MonadIO m =>+ Int -> Int -> Int -> Handle -> Enumerator ByteString m b+enumHandleSession bufSize readTime sessionTime h step = do+ startTime <- liftIO getCurrentTime+ loop startTime step++ where+ loop :: UTCTime -> Enumerator ByteString m b+ loop startTime (Continue k) = do+ now <- liftIO getCurrentTime+ let timeoutErr = TimeoutError "Reading from handle"+ diff = sessionTime - round (1000 * diffUTCTime now startTime)+ timeout = min diff readTime+ when (timeout <= 0) $ throwError timeoutErr+ mHaveInput <- liftIO $ IOErr.try (hWaitForInput h timeout)+ case mHaveInput of+ Left err+ | isEOFError err -> continue k+ | otherwise -> throwError err+ Right False -> throwError timeoutErr+ Right True -> do+ mStr <- liftIO $ IOErr.try (B.hGetNonBlocking h bufSize)+ str <- either throwError return mStr+ if B.null str+ then continue k+ else k (Chunks [str]) >>== loop startTime+ loop _ step = returnI step++ -- | Enumerate from a handle with the given buffer size (first argument) -- and timeout in milliseconds (second argument). If the timeout is--- exceeded an exception is thrown via 'throwError'.+-- exceeded a 'TimeoutError' exception is thrown via 'throwError'.+--+-- Note that this timeout is not a timeout for the whole enumeration,+-- but for each individual read operation. In other words, this timeout+-- protects against dead/unresponsive peers, but not against (perhaps+-- intentionally) slowly sending peers. -enumHandleTimeout :: forall b m. MonadIO m =>- Int -> Int -> Handle -> Enumerator ByteString m b+enumHandleTimeout ::+ forall b m. MonadIO m =>+ Int -> Int -> Handle -> Enumerator ByteString m b enumHandleTimeout bufSize timeout h = loop where loop :: Enumerator ByteString m b loop (Continue k) = do- mHaveInput <- liftIO $ IOErr.try (hWaitForInput h timeout)- case mHaveInput of- Left err- | isEOFError err -> continue k- | otherwise -> throwError err- Right False -> throwError $ userError "Handle timed out"- Right True -> do- mStr <- liftIO $ IOErr.try (B.hGetNonBlocking h bufSize)- str <- either throwError return mStr- if B.null str- then continue k- else k (Chunks [str]) >>== loop+ mHaveInput <- liftIO $ IOErr.try (hWaitForInput h timeout)+ case mHaveInput of+ Left err+ | isEOFError err -> continue k+ | otherwise -> throwError err+ Right False -> throwError $ TimeoutError "Reading from handle"+ Right True -> do+ mStr <- liftIO $ IOErr.try (B.hGetNonBlocking h bufSize)+ str <- either throwError return mStr+ if B.null str+ then continue k+ else k (Chunks [str]) >>== loop loop step = returnI step --- | Predicate for ASCII vertical whitespace.+-- | Predicate for ASCII whitespace. isSpace :: Word8 -> Bool isSpace n = n == 32 || (n >= 9 && n <= 13)@@ -77,6 +133,7 @@ netLine :: forall m. Monad m => Int -> Iteratee ByteString m (Maybe ByteString) netLine = nonEmpty . netLineEmpty + -- | Get the next line from the stream, length-limited by the given -- 'Int'. This iteratee is error-tolerant by using LF as the line -- terminator and simply ignoring all CR characters.@@ -104,36 +161,28 @@ netSplitBy :: forall m. Monad m =>- (Word8 -> Bool) ->- (Word8 -> Bool) ->- Int ->+ (Word8 -> Bool) -> (Word8 -> Bool) -> Int -> Iteratee ByteString m (Maybe ByteString) netSplitBy breakP filterP n =- continue (loop n)+ continue (loop n B.empty) where- loop :: Int -> Stream ByteString -> Iteratee ByteString m (Maybe ByteString)- loop _ EOF = return Nothing- loop n (Chunks []) = continue (loop n)- loop n (Chunks strs)- | B.null str = continue (loop n)- | otherwise = do- case (B.null line1, B.null line2') of- (True, True) -> yield Nothing EOF- (False, True) ->- case n of- 0 -> continue (loop 0)- _ -> seq pfx $- continue (loop (n - B.length pfx) >=>- maybe (yield (Just pfx) EOF)- (return . Just . B.append pfx))- (_, False) -> yield (Just pfx) (Chunks [line2])+ loop :: Int -> ByteString -> Stream ByteString ->+ Iteratee ByteString m (Maybe ByteString)+ loop _ line' EOF = yield (if B.null line' then Nothing else Just line') EOF+ loop 0 line' (Chunks _) = continue (loop 0 line')+ loop n line' (Chunks []) = continue (loop n line')+ loop n' line' (Chunks (str:strs)) =+ if B.null line2'+ then line `seq` loop n line (Chunks strs)+ else yield (Just line) (Chunks (line2:strs)) where- str = B.concat strs- (line1, line2') = B.break breakP str- (pfx, _) = first (B.filter filterP) $ B.splitAt n line1- line2 = B.tail line2'+ (line1', line2') = B.break breakP str+ line1 = B.filter filterP line1'+ line2 = B.tail line2'+ line = B.take n $ B.append line' line1+ n = max 0 (n' - B.length line1) -- | Split the stream using the supplied iteratee.@@ -179,7 +228,7 @@ netWordsEmpty = netSplitsBy . netWordEmpty --- | Apply the given iteratee, until it returns a nonempty line.+-- | Apply the given iteratee, until it returns a nonempty string. nonEmpty :: forall a m. Monad m =>
netlines.cabal view
@@ -1,5 +1,5 @@ Name: netlines-Version: 0.3.0+Version: 0.4.0 Category: Network Synopsis: Enumerator tools for text-based network protocols Maintainer: Ertugrul Söylemez <es@ertes.de>@@ -22,7 +22,8 @@ base >= 4 && < 5, bytestring >= 0.9.1.7, contstuff >= 1.2.4,- enumerator >= 0.4.7+ enumerator >= 0.4.7,+ time >= 1.2.0.3 GHC-Options: -W Exposed-modules: Data.Enumerator.NetLines