{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
module System.IO.Streams.ByteString
(
countInput
, countOutput
, fromByteString
, fromLazyByteString
, readExactly
, takeBytesWhile
, writeLazyByteString
, splitOn
, lines
, unlines
, words
, unwords
, giveBytes
, giveExactly
, takeBytes
, takeExactly
, throwIfConsumesMoreThan
, throwIfProducesMoreThan
, throwIfTooSlow
, MatchInfo(..)
, search
, RateTooSlowException
, ReadTooShortException
, TooManyBytesReadException
, TooManyBytesWrittenException
, TooFewBytesWrittenException
) where
import Control.Exception (Exception, throwIO)
import Control.Monad (when, (>=>))
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.ByteString.Unsafe as S
import Data.Char (isSpace)
import Data.Int (Int64)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Data.Typeable (Typeable)
import Prelude hiding (lines, read, unlines, unwords, words)
import System.IO.Streams.Combinators (filterM, intersperse, outputFoldM)
import System.IO.Streams.Internal (InputStream (..), OutputStream, makeInputStream, makeOutputStream, read, unRead, write)
import System.IO.Streams.Internal.Search (MatchInfo (..), search)
import System.IO.Streams.List (fromList, writeList)
{-# INLINE modifyRef #-}
modifyRef :: IORef a -> (a -> a) -> IO ()
modifyRef :: IORef a -> (a -> a) -> IO ()
modifyRef ref :: IORef a
ref f :: a -> a
f = do
a
x <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
ref
IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
ref (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$! a -> a
f a
x
writeLazyByteString :: L.ByteString
-> OutputStream ByteString
-> IO ()
writeLazyByteString :: ByteString -> OutputStream ByteString -> IO ()
writeLazyByteString = [ByteString] -> OutputStream ByteString -> IO ()
forall a. [a] -> OutputStream a -> IO ()
writeList ([ByteString] -> OutputStream ByteString -> IO ())
-> (ByteString -> [ByteString])
-> ByteString
-> OutputStream ByteString
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks
{-# INLINE writeLazyByteString #-}
fromByteString :: ByteString -> IO (InputStream ByteString)
fromByteString :: ByteString -> IO (InputStream ByteString)
fromByteString = [ByteString] -> IO (InputStream ByteString)
forall c. [c] -> IO (InputStream c)
fromList ([ByteString] -> IO (InputStream ByteString))
-> (ByteString -> [ByteString])
-> ByteString
-> IO (InputStream ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[])
fromLazyByteString :: L.ByteString -> IO (InputStream ByteString)
fromLazyByteString :: ByteString -> IO (InputStream ByteString)
fromLazyByteString = [ByteString] -> IO (InputStream ByteString)
forall c. [c] -> IO (InputStream c)
fromList ([ByteString] -> IO (InputStream ByteString))
-> (ByteString -> [ByteString])
-> ByteString
-> IO (InputStream ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks
countInput :: InputStream ByteString -> IO (InputStream ByteString, IO Int64)
countInput :: InputStream ByteString -> IO (InputStream ByteString, IO Int64)
countInput src :: InputStream ByteString
src = do
IORef Int64
ref <- Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
newIORef (0 :: Int64)
(InputStream ByteString, IO Int64)
-> IO (InputStream ByteString, IO Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return ((InputStream ByteString, IO Int64)
-> IO (InputStream ByteString, IO Int64))
-> (InputStream ByteString, IO Int64)
-> IO (InputStream ByteString, IO Int64)
forall a b. (a -> b) -> a -> b
$! (IO (Maybe ByteString)
-> (ByteString -> IO ()) -> InputStream ByteString
forall a. IO (Maybe a) -> (a -> IO ()) -> InputStream a
InputStream (IORef Int64 -> IO (Maybe ByteString)
forall a. Num a => IORef a -> IO (Maybe ByteString)
prod IORef Int64
ref) (IORef Int64 -> ByteString -> IO ()
forall a. Num a => IORef a -> ByteString -> IO ()
pb IORef Int64
ref), IORef Int64 -> IO Int64
forall a. IORef a -> IO a
readIORef IORef Int64
ref)
where
prod :: IORef a -> IO (Maybe ByteString)
prod ref :: IORef a
ref = InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
src IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe ByteString)
-> (ByteString -> IO (Maybe ByteString))
-> Maybe ByteString
-> IO (Maybe ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing) (\x :: ByteString
x -> do
IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyRef IORef a
ref (a -> a -> a
forall a. Num a => a -> a -> a
+ (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
x))
Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$! ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
x)
pb :: IORef a -> ByteString -> IO ()
pb ref :: IORef a
ref s :: ByteString
s = do
IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyRef IORef a
ref (\x :: a
x -> a
x a -> a -> a
forall a. Num a => a -> a -> a
- (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
s))
ByteString -> InputStream ByteString -> IO ()
forall a. a -> InputStream a -> IO ()
unRead ByteString
s InputStream ByteString
src
countOutput :: OutputStream ByteString
-> IO (OutputStream ByteString, IO Int64)
countOutput :: OutputStream ByteString -> IO (OutputStream ByteString, IO Int64)
countOutput = (Int64 -> ByteString -> IO Int64)
-> Int64
-> OutputStream ByteString
-> IO (OutputStream ByteString, IO Int64)
forall a b.
(a -> b -> IO a)
-> a -> OutputStream b -> IO (OutputStream b, IO a)
outputFoldM Int64 -> ByteString -> IO Int64
forall (m :: * -> *) a.
(Monad m, Num a, Enum a) =>
a -> ByteString -> m a
f 0
where
f :: a -> ByteString -> m a
f !a
count s :: ByteString
s = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
z
where
!c :: Int
c = ByteString -> Int
S.length ByteString
s
!z :: a
z = Int -> a
forall a. Enum a => Int -> a
toEnum Int
c a -> a -> a
forall a. Num a => a -> a -> a
+ a
count
takeBytes :: Int64
-> InputStream ByteString
-> IO (InputStream ByteString)
takeBytes :: Int64 -> InputStream ByteString -> IO (InputStream ByteString)
takeBytes k0 :: Int64
k0 = Int64
-> IO (Maybe ByteString)
-> InputStream ByteString
-> IO (InputStream ByteString)
takeBytes' Int64
k0 (Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing)
{-# INLINE takeBytes #-}
takeExactly :: Int64
-> InputStream ByteString
-> IO (InputStream ByteString)
takeExactly :: Int64 -> InputStream ByteString -> IO (InputStream ByteString)
takeExactly k0 :: Int64
k0 = Int64
-> IO (Maybe ByteString)
-> InputStream ByteString
-> IO (InputStream ByteString)
takeBytes' Int64
k0 (ReadTooShortException -> IO (Maybe ByteString)
forall e a. Exception e => e -> IO a
throwIO (ReadTooShortException -> IO (Maybe ByteString))
-> ReadTooShortException -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Int64 -> ReadTooShortException
ReadTooShortException Int64
k0)
{-# INLINE takeExactly #-}
takeBytes' :: Int64
-> IO (Maybe ByteString)
-> InputStream ByteString
-> IO (InputStream ByteString)
takeBytes' :: Int64
-> IO (Maybe ByteString)
-> InputStream ByteString
-> IO (InputStream ByteString)
takeBytes' k0 :: Int64
k0 h :: IO (Maybe ByteString)
h src :: InputStream ByteString
src = do
IORef Int64
kref <- Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
newIORef Int64
k0
InputStream ByteString -> IO (InputStream ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (InputStream ByteString -> IO (InputStream ByteString))
-> InputStream ByteString -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$! IO (Maybe ByteString)
-> (ByteString -> IO ()) -> InputStream ByteString
forall a. IO (Maybe a) -> (a -> IO ()) -> InputStream a
InputStream (IORef Int64 -> IO (Maybe ByteString)
forall a. Integral a => IORef a -> IO (Maybe ByteString)
prod IORef Int64
kref) (IORef Int64 -> ByteString -> IO ()
forall a. Num a => IORef a -> ByteString -> IO ()
pb IORef Int64
kref)
where
prod :: IORef a -> IO (Maybe ByteString)
prod kref :: IORef a
kref = do
a
k <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
kref
if a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
then Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
else InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
src IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe ByteString)
-> (ByteString -> IO (Maybe ByteString))
-> Maybe ByteString
-> IO (Maybe ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (Maybe ByteString)
h (a -> ByteString -> IO (Maybe ByteString)
chunk a
k)
where
chunk :: a -> ByteString -> IO (Maybe ByteString)
chunk k :: a
k s :: ByteString
s = do
let l :: a
l = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
s
let k' :: a
k' = a
k a -> a -> a
forall a. Num a => a -> a -> a
- a
l
if a
k' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
then let (a :: ByteString
a,b :: ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
k) ByteString
s
in do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
S.null ByteString
b) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> InputStream ByteString -> IO ()
forall a. a -> InputStream a -> IO ()
unRead ByteString
b InputStream ByteString
src
IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
kref 0
Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$! ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
a
else IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
kref a
k' IO () -> IO (Maybe ByteString) -> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
s)
pb :: IORef a -> ByteString -> IO ()
pb kref :: IORef a
kref s :: ByteString
s = do
IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyRef IORef a
kref (a -> a -> a
forall a. Num a => a -> a -> a
+ (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
s))
ByteString -> InputStream ByteString -> IO ()
forall a. a -> InputStream a -> IO ()
unRead ByteString
s InputStream ByteString
src
{-# INLINE takeBytes' #-}
splitOn :: (Char -> Bool)
-> InputStream ByteString
-> IO (InputStream ByteString)
splitOn :: (Char -> Bool)
-> InputStream ByteString -> IO (InputStream ByteString)
splitOn p :: Char -> Bool
p is :: InputStream ByteString
is = do
IORef ([ByteString] -> [ByteString])
ref <- ([ByteString] -> [ByteString])
-> IO (IORef ([ByteString] -> [ByteString]))
forall a. a -> IO (IORef a)
newIORef [ByteString] -> [ByteString]
forall a. a -> a
id
IO (Maybe ByteString) -> IO (InputStream ByteString)
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream (IO (Maybe ByteString) -> IO (InputStream ByteString))
-> IO (Maybe ByteString) -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$ IORef ([ByteString] -> [ByteString]) -> IO (Maybe ByteString)
start IORef ([ByteString] -> [ByteString])
ref
where
start :: IORef ([ByteString] -> [ByteString]) -> IO (Maybe ByteString)
start ref :: IORef ([ByteString] -> [ByteString])
ref = IO (Maybe ByteString)
go
where
go :: IO (Maybe ByteString)
go = InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
is IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe ByteString)
-> (ByteString -> IO (Maybe ByteString))
-> Maybe ByteString
-> IO (Maybe ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (Maybe ByteString)
end ByteString -> IO (Maybe ByteString)
chunk
end :: IO (Maybe ByteString)
end = do
[ByteString] -> [ByteString]
dl <- IORef ([ByteString] -> [ByteString])
-> IO ([ByteString] -> [ByteString])
forall a. IORef a -> IO a
readIORef IORef ([ByteString] -> [ByteString])
ref
case [ByteString] -> [ByteString]
dl [] of
[] -> Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
xs :: [ByteString]
xs -> IORef ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ([ByteString] -> [ByteString])
ref [ByteString] -> [ByteString]
forall a. a -> a
id IO () -> IO (Maybe ByteString) -> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$! ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
S.concat [ByteString]
xs)
chunk :: ByteString -> IO (Maybe ByteString)
chunk s :: ByteString
s = let (a :: ByteString
a, b :: ByteString
b) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
S.break Char -> Bool
p ByteString
s
in if ByteString -> Bool
S.null ByteString
b
then IORef ([ByteString] -> [ByteString])
-> (([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString])
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyRef IORef ([ByteString] -> [ByteString])
ref (\f :: [ByteString] -> [ByteString]
f -> [ByteString] -> [ByteString]
f ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
aByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)) IO () -> IO (Maybe ByteString) -> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Maybe ByteString)
go
else do
let !b' :: ByteString
b' = Int -> ByteString -> ByteString
S.unsafeDrop 1 ByteString
b
[ByteString] -> [ByteString]
dl <- IORef ([ByteString] -> [ByteString])
-> IO ([ByteString] -> [ByteString])
forall a. IORef a -> IO a
readIORef IORef ([ByteString] -> [ByteString])
ref
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
S.null ByteString
b') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> InputStream ByteString -> IO ()
forall a. a -> InputStream a -> IO ()
unRead ByteString
b' InputStream ByteString
is
IORef ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ([ByteString] -> [ByteString])
ref [ByteString] -> [ByteString]
forall a. a -> a
id
Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
S.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
dl [ByteString
a]
lines :: InputStream ByteString -> IO (InputStream ByteString)
lines :: InputStream ByteString -> IO (InputStream ByteString)
lines = (Char -> Bool)
-> InputStream ByteString -> IO (InputStream ByteString)
splitOn (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n')
words :: InputStream ByteString -> IO (InputStream ByteString)
words :: InputStream ByteString -> IO (InputStream ByteString)
words = (Char -> Bool)
-> InputStream ByteString -> IO (InputStream ByteString)
splitOn Char -> Bool
isSpace (InputStream ByteString -> IO (InputStream ByteString))
-> (InputStream ByteString -> IO (InputStream ByteString))
-> InputStream ByteString
-> IO (InputStream ByteString)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ByteString -> IO Bool)
-> InputStream ByteString -> IO (InputStream ByteString)
forall a. (a -> IO Bool) -> InputStream a -> IO (InputStream a)
filterM (Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> (ByteString -> Bool) -> ByteString -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> Bool
S.all Char -> Bool
isSpace)
unlines :: OutputStream ByteString -> IO (OutputStream ByteString)
unlines :: OutputStream ByteString -> IO (OutputStream ByteString)
unlines os :: OutputStream ByteString
os = (Maybe ByteString -> IO ()) -> IO (OutputStream ByteString)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream ((Maybe ByteString -> IO ()) -> IO (OutputStream ByteString))
-> (Maybe ByteString -> IO ()) -> IO (OutputStream ByteString)
forall a b. (a -> b) -> a -> b
$ \m :: Maybe ByteString
m -> do
Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe ByteString
m OutputStream ByteString
os
case Maybe ByteString
m of
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ()
Just _ -> Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just "\n") OutputStream ByteString
os
unwords :: OutputStream ByteString -> IO (OutputStream ByteString)
unwords :: OutputStream ByteString -> IO (OutputStream ByteString)
unwords = ByteString
-> OutputStream ByteString -> IO (OutputStream ByteString)
forall a. a -> OutputStream a -> IO (OutputStream a)
intersperse " "
data TooManyBytesReadException = TooManyBytesReadException deriving (Typeable)
instance Show TooManyBytesReadException where
show :: TooManyBytesReadException -> String
show TooManyBytesReadException = "Too many bytes read"
instance Exception TooManyBytesReadException
data TooFewBytesWrittenException = TooFewBytesWrittenException deriving (Typeable)
instance Show TooFewBytesWrittenException where
show :: TooFewBytesWrittenException -> String
show TooFewBytesWrittenException = "Too few bytes written"
instance Exception TooFewBytesWrittenException
data TooManyBytesWrittenException =
TooManyBytesWrittenException deriving (Typeable)
instance Show TooManyBytesWrittenException where
show :: TooManyBytesWrittenException -> String
show TooManyBytesWrittenException = "Too many bytes written"
instance Exception TooManyBytesWrittenException
data ReadTooShortException = ReadTooShortException Int64 deriving (Typeable)
instance Show ReadTooShortException where
show :: ReadTooShortException -> String
show (ReadTooShortException x :: Int64
x) = "Short read, expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show Int64
x
String -> ShowS
forall a. [a] -> [a] -> [a]
++ " bytes"
instance Exception ReadTooShortException
throwIfProducesMoreThan
:: Int64
-> InputStream ByteString
-> IO (InputStream ByteString)
throwIfProducesMoreThan :: Int64 -> InputStream ByteString -> IO (InputStream ByteString)
throwIfProducesMoreThan k0 :: Int64
k0 src :: InputStream ByteString
src = do
IORef Int64
kref <- Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
newIORef Int64
k0
InputStream ByteString -> IO (InputStream ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (InputStream ByteString -> IO (InputStream ByteString))
-> InputStream ByteString -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$! IO (Maybe ByteString)
-> (ByteString -> IO ()) -> InputStream ByteString
forall a. IO (Maybe a) -> (a -> IO ()) -> InputStream a
InputStream (IORef Int64 -> IO (Maybe ByteString)
forall a.
(Ord a, Num a, Enum a) =>
IORef a -> IO (Maybe ByteString)
prod IORef Int64
kref) (IORef Int64 -> ByteString -> IO ()
forall a. Num a => IORef a -> ByteString -> IO ()
pb IORef Int64
kref)
where
prod :: IORef a -> IO (Maybe ByteString)
prod kref :: IORef a
kref = InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
src IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe ByteString)
-> (ByteString -> IO (Maybe ByteString))
-> Maybe ByteString
-> IO (Maybe ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> IO (Maybe ByteString)
chunk
where
chunk :: ByteString -> IO (Maybe ByteString)
chunk s :: ByteString
s = do
a
k <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
kref
let k' :: a
k' = a
k a -> a -> a
forall a. Num a => a -> a -> a
- a
l
case () of !()
_ | a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
s)
| a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> TooManyBytesReadException -> IO (Maybe ByteString)
forall e a. Exception e => e -> IO a
throwIO TooManyBytesReadException
TooManyBytesReadException
| a
k' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 -> IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
kref a
k' IO () -> IO (Maybe ByteString) -> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
s)
| Bool
otherwise -> do
let (!ByteString
a,!ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt (a -> Int
forall a. Enum a => a -> Int
fromEnum a
k) ByteString
s
IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
kref 0
ByteString -> InputStream ByteString -> IO ()
forall a. a -> InputStream a -> IO ()
unRead ByteString
b InputStream ByteString
src
Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$! ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
a
where
l :: a
l = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
s
pb :: IORef a -> ByteString -> IO ()
pb kref :: IORef a
kref s :: ByteString
s = do
ByteString -> InputStream ByteString -> IO ()
forall a. a -> InputStream a -> IO ()
unRead ByteString
s InputStream ByteString
src
IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyRef IORef a
kref (a -> a -> a
forall a. Num a => a -> a -> a
+ (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
s))
readExactly :: Int
-> InputStream ByteString
-> IO ByteString
readExactly :: Int -> InputStream ByteString -> IO ByteString
readExactly n :: Int
n input :: InputStream ByteString
input = ([ByteString] -> [ByteString]) -> Int -> IO ByteString
go [ByteString] -> [ByteString]
forall a. a -> a
id Int
n
where
go :: ([ByteString] -> [ByteString]) -> Int -> IO ByteString
go ![ByteString] -> [ByteString]
dl 0 = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
S.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> [ByteString]
dl []
go ![ByteString] -> [ByteString]
dl k :: Int
k =
InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
input IO (Maybe ByteString)
-> (Maybe ByteString -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
IO ByteString
-> (ByteString -> IO ByteString)
-> Maybe ByteString
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ReadTooShortException -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO (ReadTooShortException -> IO ByteString)
-> ReadTooShortException -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ReadTooShortException
ReadTooShortException (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))
(\s :: ByteString
s -> do
let l :: Int
l = ByteString -> Int
S.length ByteString
s
if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k
then do
let (a :: ByteString
a,b :: ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
k ByteString
s
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
S.null ByteString
b) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> InputStream ByteString -> IO ()
forall a. a -> InputStream a -> IO ()
unRead ByteString
b InputStream ByteString
input
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
S.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> [ByteString]
dl [ByteString
a]
else ([ByteString] -> [ByteString]) -> Int -> IO ByteString
go ([ByteString] -> [ByteString]
dl ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
sByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l))
takeBytesWhile :: (Char -> Bool)
-> InputStream ByteString
-> IO (Maybe ByteString)
takeBytesWhile :: (Char -> Bool) -> InputStream ByteString -> IO (Maybe ByteString)
takeBytesWhile p :: Char -> Bool
p input :: InputStream ByteString
input = InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
input IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe ByteString)
-> (ByteString -> IO (Maybe ByteString))
-> Maybe ByteString
-> IO (Maybe ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing) (([ByteString] -> [ByteString])
-> ByteString -> IO (Maybe ByteString)
go [ByteString] -> [ByteString]
forall a. a -> a
id)
where
go :: ([ByteString] -> [ByteString])
-> ByteString -> IO (Maybe ByteString)
go dl :: [ByteString] -> [ByteString]
dl !ByteString
s | ByteString -> Bool
S.null ByteString
b = InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
input IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe ByteString)
-> (ByteString -> IO (Maybe ByteString))
-> Maybe ByteString
-> IO (Maybe ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (Maybe ByteString)
finish (([ByteString] -> [ByteString])
-> ByteString -> IO (Maybe ByteString)
go [ByteString] -> [ByteString]
dl')
| Bool
otherwise = ByteString -> InputStream ByteString -> IO ()
forall a. a -> InputStream a -> IO ()
unRead ByteString
b InputStream ByteString
input IO () -> IO (Maybe ByteString) -> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Maybe ByteString)
finish
where
(a :: ByteString
a, b :: ByteString
b) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
S.span Char -> Bool
p ByteString
s
dl' :: [ByteString] -> [ByteString]
dl' = [ByteString] -> [ByteString]
dl ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
aByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)
finish :: IO (Maybe ByteString)
finish = Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$! ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
S.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> [ByteString]
dl [ByteString
a]
giveBytes :: Int64
-> OutputStream ByteString
-> IO (OutputStream ByteString)
giveBytes :: Int64 -> OutputStream ByteString -> IO (OutputStream ByteString)
giveBytes k0 :: Int64
k0 str :: OutputStream ByteString
str = do
IORef Int64
kref <- Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
newIORef Int64
k0
(Maybe ByteString -> IO ()) -> IO (OutputStream ByteString)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream ((Maybe ByteString -> IO ()) -> IO (OutputStream ByteString))
-> (Maybe ByteString -> IO ()) -> IO (OutputStream ByteString)
forall a b. (a -> b) -> a -> b
$ IORef Int64 -> Maybe ByteString -> IO ()
forall a. Integral a => IORef a -> Maybe ByteString -> IO ()
sink IORef Int64
kref
where
sink :: IORef a -> Maybe ByteString -> IO ()
sink _ Nothing = Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe ByteString
forall a. Maybe a
Nothing OutputStream ByteString
str
sink kref :: IORef a
kref mb :: Maybe ByteString
mb@(Just x :: ByteString
x) = do
a
k <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
kref
let l :: a
l = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
x
let k' :: a
k' = a
k a -> a -> a
forall a. Num a => a -> a -> a
- a
l
if a
k' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0
then do let a :: ByteString
a = Int -> ByteString -> ByteString
S.take (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
k) ByteString
x
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
S.null ByteString
a) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
a) OutputStream ByteString
str
IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
kref 0
else IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
kref a
k' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe ByteString
mb OutputStream ByteString
str
giveExactly :: Int64
-> OutputStream ByteString
-> IO (OutputStream ByteString)
giveExactly :: Int64 -> OutputStream ByteString -> IO (OutputStream ByteString)
giveExactly k0 :: Int64
k0 os :: OutputStream ByteString
os = do
IORef Int64
ref <- Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
newIORef Int64
k0
(Maybe ByteString -> IO ()) -> IO (OutputStream ByteString)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream ((Maybe ByteString -> IO ()) -> IO (OutputStream ByteString))
-> (Maybe ByteString -> IO ()) -> IO (OutputStream ByteString)
forall a b. (a -> b) -> a -> b
$ IORef Int64 -> Maybe ByteString -> IO ()
forall a. (Ord a, Num a) => IORef a -> Maybe ByteString -> IO ()
go IORef Int64
ref
where
go :: IORef a -> Maybe ByteString -> IO ()
go ref :: IORef a
ref chunk :: Maybe ByteString
chunk = do
!a
n <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
ref
case Maybe ByteString
chunk of
Nothing -> if a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
then TooFewBytesWrittenException -> IO ()
forall e a. Exception e => e -> IO a
throwIO TooFewBytesWrittenException
TooFewBytesWrittenException
else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ()
Just s :: ByteString
s -> let n' :: a
n' = a
n a -> a -> a
forall a. Num a => a -> a -> a
- Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
s)
in if a
n' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0
then TooManyBytesWrittenException -> IO ()
forall e a. Exception e => e -> IO a
throwIO TooManyBytesWrittenException
TooManyBytesWrittenException
else do IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
ref a
n'
Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe ByteString
chunk OutputStream ByteString
os
throwIfConsumesMoreThan
:: Int64
-> OutputStream ByteString
-> IO (OutputStream ByteString)
throwIfConsumesMoreThan :: Int64 -> OutputStream ByteString -> IO (OutputStream ByteString)
throwIfConsumesMoreThan k0 :: Int64
k0 str :: OutputStream ByteString
str = do
IORef Int64
kref <- Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
newIORef Int64
k0
(Maybe ByteString -> IO ()) -> IO (OutputStream ByteString)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream ((Maybe ByteString -> IO ()) -> IO (OutputStream ByteString))
-> (Maybe ByteString -> IO ()) -> IO (OutputStream ByteString)
forall a b. (a -> b) -> a -> b
$ IORef Int64 -> Maybe ByteString -> IO ()
forall a.
(Ord a, Enum a, Num a) =>
IORef a -> Maybe ByteString -> IO ()
sink IORef Int64
kref
where
sink :: IORef a -> Maybe ByteString -> IO ()
sink _ Nothing = Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe ByteString
forall a. Maybe a
Nothing OutputStream ByteString
str
sink kref :: IORef a
kref mb :: Maybe ByteString
mb@(Just x :: ByteString
x) = do
a
k <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
kref
let l :: a
l = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
x
let k' :: a
k' = a
k a -> a -> a
forall a. Num a => a -> a -> a
- a
l
if a
k' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0
then TooManyBytesWrittenException -> IO ()
forall e a. Exception e => e -> IO a
throwIO TooManyBytesWrittenException
TooManyBytesWrittenException
else IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
kref a
k' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe ByteString
mb OutputStream ByteString
str
getTime :: IO Double
getTime :: IO Double
getTime = POSIXTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (POSIXTime -> Double) -> IO POSIXTime -> IO Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO POSIXTime
getPOSIXTime
data RateTooSlowException = RateTooSlowException deriving (Typeable)
instance Show RateTooSlowException where
show :: RateTooSlowException -> String
show RateTooSlowException = "Input rate too slow"
instance Exception RateTooSlowException
throwIfTooSlow
:: IO ()
-> Double
-> Int
-> InputStream ByteString
-> IO (InputStream ByteString)
throwIfTooSlow :: IO ()
-> Double
-> Int
-> InputStream ByteString
-> IO (InputStream ByteString)
throwIfTooSlow !IO ()
bump !Double
minRate !Int
minSeconds' !InputStream ByteString
stream = do
!()
_ <- IO ()
bump
Double
startTime <- IO Double
getTime
IORef Int64
bytesRead <- Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
newIORef (0 :: Int64)
InputStream ByteString -> IO (InputStream ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (InputStream ByteString -> IO (InputStream ByteString))
-> InputStream ByteString -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$! IO (Maybe ByteString)
-> (ByteString -> IO ()) -> InputStream ByteString
forall a. IO (Maybe a) -> (a -> IO ()) -> InputStream a
InputStream (Double -> IORef Int64 -> IO (Maybe ByteString)
forall a. Integral a => Double -> IORef a -> IO (Maybe ByteString)
prod Double
startTime IORef Int64
bytesRead) (IORef Int64 -> ByteString -> IO ()
forall a. Num a => IORef a -> ByteString -> IO ()
pb IORef Int64
bytesRead)
where
prod :: Double -> IORef a -> IO (Maybe ByteString)
prod startTime :: Double
startTime bytesReadRef :: IORef a
bytesReadRef = InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
stream IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe ByteString)
-> (ByteString -> IO (Maybe ByteString))
-> Maybe ByteString
-> IO (Maybe ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> IO (Maybe ByteString)
chunk
where
chunk :: ByteString -> IO (Maybe ByteString)
chunk s :: ByteString
s = do
let slen :: Int
slen = ByteString -> Int
S.length ByteString
s
Double
now <- IO Double
getTime
let !delta :: Double
delta = Double
now Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
startTime
a
nb <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
bytesReadRef
let newBytes :: a
newBytes = a
nb a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slen
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
delta Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
minSeconds Double -> Double -> Double
forall a. Num a => a -> a -> a
+ 1 Bool -> Bool -> Bool
&&
(a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
newBytes Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/
(Double
delta Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
minSeconds)) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
minRate) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
RateTooSlowException -> IO ()
forall e a. Exception e => e -> IO a
throwIO RateTooSlowException
RateTooSlowException
!()
_ <- IO ()
bump
IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
bytesReadRef a
newBytes
Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$! ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
s
pb :: IORef a -> ByteString -> IO ()
pb bytesReadRef :: IORef a
bytesReadRef s :: ByteString
s = do
IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyRef IORef a
bytesReadRef ((a -> a) -> IO ()) -> (a -> a) -> IO ()
forall a b. (a -> b) -> a -> b
$ \x :: a
x -> a
x a -> a -> a
forall a. Num a => a -> a -> a
- (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
s)
ByteString -> InputStream ByteString -> IO ()
forall a. a -> InputStream a -> IO ()
unRead ByteString
s InputStream ByteString
stream
minSeconds :: Double
minSeconds = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minSeconds'