{-# 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 :: forall a. IORef a -> (a -> a) -> IO ()
modifyRef IORef a
ref a -> a
f = do
a
x <- forall a. IORef a -> IO a
readIORef IORef a
ref
forall a. IORef a -> a -> IO ()
writeIORef IORef a
ref forall a b. (a -> b) -> a -> b
$! a -> a
f a
x
writeLazyByteString :: L.ByteString
-> OutputStream ByteString
-> IO ()
writeLazyByteString :: ByteString -> OutputStream ByteString -> IO ()
writeLazyByteString = forall a. [a] -> OutputStream a -> IO ()
writeList 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 = forall c. [c] -> IO (InputStream c)
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])
fromLazyByteString :: L.ByteString -> IO (InputStream ByteString)
fromLazyByteString :: ByteString -> IO (InputStream ByteString)
fromLazyByteString = forall c. [c] -> IO (InputStream c)
fromList 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 InputStream ByteString
src = do
IORef Int64
ref <- forall a. a -> IO (IORef a)
newIORef (Int64
0 :: Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (forall a. IO (Maybe a) -> (a -> IO ()) -> InputStream a
InputStream (forall {a}. Num a => IORef a -> IO (Maybe ByteString)
prod IORef Int64
ref) (forall {a}. Num a => IORef a -> ByteString -> IO ()
pb IORef Int64
ref), forall a. IORef a -> IO a
readIORef IORef Int64
ref)
where
prod :: IORef a -> IO (Maybe ByteString)
prod IORef a
ref = forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
src forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (\ByteString
x -> do
forall a. IORef a -> (a -> a) -> IO ()
modifyRef IORef a
ref (forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
x))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just ByteString
x)
pb :: IORef a -> ByteString -> IO ()
pb IORef a
ref ByteString
s = do
forall a. IORef a -> (a -> a) -> IO ()
modifyRef IORef a
ref (\a
x -> a
x forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
s))
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 = forall a b.
(a -> b -> IO a)
-> a -> OutputStream b -> IO (OutputStream b, IO a)
outputFoldM forall {m :: * -> *} {a}.
(Monad m, Num a, Enum a) =>
a -> ByteString -> m a
f Int64
0
where
f :: a -> ByteString -> m a
f !a
count ByteString
s = forall (m :: * -> *) a. Monad m => a -> m a
return a
z
where
!c :: Int
c = ByteString -> Int
S.length ByteString
s
!z :: a
z = forall a. Enum a => Int -> a
toEnum Int
c forall a. Num a => a -> a -> a
+ a
count
takeBytes :: Int64
-> InputStream ByteString
-> IO (InputStream ByteString)
takeBytes :: Int64 -> InputStream ByteString -> IO (InputStream ByteString)
takeBytes Int64
k0 = Int64
-> IO (Maybe ByteString)
-> InputStream ByteString
-> IO (InputStream ByteString)
takeBytes' Int64
k0 (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
{-# INLINE takeBytes #-}
takeExactly :: Int64
-> InputStream ByteString
-> IO (InputStream ByteString)
takeExactly :: Int64 -> InputStream ByteString -> IO (InputStream ByteString)
takeExactly Int64
k0 = Int64
-> IO (Maybe ByteString)
-> InputStream ByteString
-> IO (InputStream ByteString)
takeBytes' Int64
k0 (forall e a. Exception e => e -> IO a
throwIO 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' Int64
k0 IO (Maybe ByteString)
h InputStream ByteString
src = do
IORef Int64
kref <- forall a. a -> IO (IORef a)
newIORef Int64
k0
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. IO (Maybe a) -> (a -> IO ()) -> InputStream a
InputStream (forall {a}. Integral a => IORef a -> IO (Maybe ByteString)
prod IORef Int64
kref) (forall {a}. Num a => IORef a -> ByteString -> IO ()
pb IORef Int64
kref)
where
prod :: IORef a -> IO (Maybe ByteString)
prod IORef a
kref = do
a
k <- forall a. IORef a -> IO a
readIORef IORef a
kref
if a
k forall a. Ord a => a -> a -> Bool
<= a
0
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
src forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 a
k ByteString
s = do
let l :: a
l = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
s
let k' :: a
k' = a
k forall a. Num a => a -> a -> a
- a
l
if a
k' forall a. Ord a => a -> a -> Bool
<= a
0
then let (ByteString
a,ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
k) ByteString
s
in do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
S.null ByteString
b) forall a b. (a -> b) -> a -> b
$ forall a. a -> InputStream a -> IO ()
unRead ByteString
b InputStream ByteString
src
forall a. IORef a -> a -> IO ()
writeIORef IORef a
kref a
0
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just ByteString
a
else forall a. IORef a -> a -> IO ()
writeIORef IORef a
kref a
k' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ByteString
s)
pb :: IORef a -> ByteString -> IO ()
pb IORef a
kref ByteString
s = do
forall a. IORef a -> (a -> a) -> IO ()
modifyRef IORef a
kref (forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
s))
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 Char -> Bool
p InputStream ByteString
is = do
IORef ([ByteString] -> [ByteString])
ref <- forall a. a -> IO (IORef a)
newIORef forall a. a -> a
id
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream 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 IORef ([ByteString] -> [ByteString])
ref = IO (Maybe ByteString)
go
where
go :: IO (Maybe ByteString)
go = forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
is forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 <- forall a. IORef a -> IO a
readIORef IORef ([ByteString] -> [ByteString])
ref
case [ByteString] -> [ByteString]
dl [] of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
[ByteString]
xs -> forall a. IORef a -> a -> IO ()
writeIORef IORef ([ByteString] -> [ByteString])
ref forall a. a -> a
id forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
S.concat [ByteString]
xs)
chunk :: ByteString -> IO (Maybe ByteString)
chunk ByteString
s = let (ByteString
a, ByteString
b) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
S.break Char -> Bool
p ByteString
s
in if ByteString -> Bool
S.null ByteString
b
then forall a. IORef a -> (a -> a) -> IO ()
modifyRef IORef ([ByteString] -> [ByteString])
ref (\[ByteString] -> [ByteString]
f -> [ByteString] -> [ByteString]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
aforall a. a -> [a] -> [a]
:)) 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 Int
1 ByteString
b
[ByteString] -> [ByteString]
dl <- forall a. IORef a -> IO a
readIORef IORef ([ByteString] -> [ByteString])
ref
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
S.null ByteString
b') forall a b. (a -> b) -> a -> b
$ forall a. a -> InputStream a -> IO ()
unRead ByteString
b' InputStream ByteString
is
forall a. IORef a -> a -> IO ()
writeIORef IORef ([ByteString] -> [ByteString])
ref forall a. a -> a
id
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
S.concat 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 (forall a. Eq a => a -> a -> Bool
== Char
'\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 forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. (a -> IO Bool) -> InputStream a -> IO (InputStream a)
filterM (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not 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 OutputStream ByteString
os = forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
m -> do
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe ByteString
m OutputStream ByteString
os
case Maybe ByteString
m of
Maybe ByteString
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ()
Just ByteString
_ -> forall a. Maybe a -> OutputStream a -> IO ()
write (forall a. a -> Maybe a
Just ByteString
"\n") OutputStream ByteString
os
unwords :: OutputStream ByteString -> IO (OutputStream ByteString)
unwords :: OutputStream ByteString -> IO (OutputStream ByteString)
unwords = forall a. a -> OutputStream a -> IO (OutputStream a)
intersperse ByteString
" "
data TooManyBytesReadException = TooManyBytesReadException deriving (Typeable)
instance Show TooManyBytesReadException where
show :: TooManyBytesReadException -> String
show TooManyBytesReadException
TooManyBytesReadException = String
"Too many bytes read"
instance Exception TooManyBytesReadException
data TooFewBytesWrittenException = TooFewBytesWrittenException deriving (Typeable)
instance Show TooFewBytesWrittenException where
show :: TooFewBytesWrittenException -> String
show TooFewBytesWrittenException
TooFewBytesWrittenException = String
"Too few bytes written"
instance Exception TooFewBytesWrittenException
data TooManyBytesWrittenException =
TooManyBytesWrittenException deriving (Typeable)
instance Show TooManyBytesWrittenException where
show :: TooManyBytesWrittenException -> String
show TooManyBytesWrittenException
TooManyBytesWrittenException = String
"Too many bytes written"
instance Exception TooManyBytesWrittenException
data ReadTooShortException = ReadTooShortException Int64 deriving (Typeable)
instance Show ReadTooShortException where
show :: ReadTooShortException -> String
show (ReadTooShortException Int64
x) = String
"Short read, expected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int64
x
forall a. [a] -> [a] -> [a]
++ String
" bytes"
instance Exception ReadTooShortException
throwIfProducesMoreThan
:: Int64
-> InputStream ByteString
-> IO (InputStream ByteString)
throwIfProducesMoreThan :: Int64 -> InputStream ByteString -> IO (InputStream ByteString)
throwIfProducesMoreThan Int64
k0 InputStream ByteString
src = do
IORef Int64
kref <- forall a. a -> IO (IORef a)
newIORef Int64
k0
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. IO (Maybe a) -> (a -> IO ()) -> InputStream a
InputStream (forall {a}.
(Ord a, Num a, Enum a) =>
IORef a -> IO (Maybe ByteString)
prod IORef Int64
kref) (forall {a}. Num a => IORef a -> ByteString -> IO ()
pb IORef Int64
kref)
where
prod :: IORef a -> IO (Maybe ByteString)
prod IORef a
kref = forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
src forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) ByteString -> IO (Maybe ByteString)
chunk
where
chunk :: ByteString -> IO (Maybe ByteString)
chunk ByteString
s = do
a
k <- forall a. IORef a -> IO a
readIORef IORef a
kref
let k' :: a
k' = a
k forall a. Num a => a -> a -> a
- a
l
case () of !()
_ | a
l forall a. Eq a => a -> a -> Bool
== a
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ByteString
s)
| a
k forall a. Eq a => a -> a -> Bool
== a
0 -> forall e a. Exception e => e -> IO a
throwIO TooManyBytesReadException
TooManyBytesReadException
| a
k' forall a. Ord a => a -> a -> Bool
>= a
0 -> forall a. IORef a -> a -> IO ()
writeIORef IORef a
kref a
k' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ByteString
s)
| Bool
otherwise -> do
let (!ByteString
a,!ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt (forall a. Enum a => a -> Int
fromEnum a
k) ByteString
s
forall a. IORef a -> a -> IO ()
writeIORef IORef a
kref a
0
forall a. a -> InputStream a -> IO ()
unRead ByteString
b InputStream ByteString
src
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just ByteString
a
where
l :: a
l = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
s
pb :: IORef a -> ByteString -> IO ()
pb IORef a
kref ByteString
s = do
forall a. a -> InputStream a -> IO ()
unRead ByteString
s InputStream ByteString
src
forall a. IORef a -> (a -> a) -> IO ()
modifyRef IORef a
kref (forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 Int
n InputStream ByteString
input = ([ByteString] -> [ByteString]) -> Int -> IO ByteString
go forall a. a -> a
id Int
n
where
go :: ([ByteString] -> [ByteString]) -> Int -> IO ByteString
go ![ByteString] -> [ByteString]
dl Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
S.concat forall a b. (a -> b) -> a -> b
$! [ByteString] -> [ByteString]
dl []
go ![ByteString] -> [ByteString]
dl Int
k =
forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
input forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Int64 -> ReadTooShortException
ReadTooShortException (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))
(\ByteString
s -> do
let l :: Int
l = ByteString -> Int
S.length ByteString
s
if Int
l forall a. Ord a => a -> a -> Bool
>= Int
k
then do
let (ByteString
a,ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
k ByteString
s
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
S.null ByteString
b) forall a b. (a -> b) -> a -> b
$ forall a. a -> InputStream a -> IO ()
unRead ByteString
b InputStream ByteString
input
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
S.concat forall a b. (a -> b) -> a -> b
$! [ByteString] -> [ByteString]
dl [ByteString
a]
else ([ByteString] -> [ByteString]) -> Int -> IO ByteString
go ([ByteString] -> [ByteString]
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
sforall a. a -> [a] -> [a]
:)) (Int
k 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 Char -> Bool
p InputStream ByteString
input = forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
input forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (([ByteString] -> [ByteString])
-> ByteString -> IO (Maybe ByteString)
go forall a. a -> a
id)
where
go :: ([ByteString] -> [ByteString])
-> ByteString -> IO (Maybe ByteString)
go [ByteString] -> [ByteString]
dl !ByteString
s | ByteString -> Bool
S.null ByteString
b = forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
input forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 = forall a. a -> InputStream a -> IO ()
unRead ByteString
b InputStream ByteString
input forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Maybe ByteString)
finish
where
(ByteString
a, ByteString
b) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
S.span Char -> Bool
p ByteString
s
dl' :: [ByteString] -> [ByteString]
dl' = [ByteString] -> [ByteString]
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
aforall a. a -> [a] -> [a]
:)
finish :: IO (Maybe ByteString)
finish = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
S.concat 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 Int64
k0 OutputStream ByteString
str = do
IORef Int64
kref <- forall a. a -> IO (IORef a)
newIORef Int64
k0
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream forall a b. (a -> b) -> a -> b
$ forall {a}. Integral a => IORef a -> Maybe ByteString -> IO ()
sink IORef Int64
kref
where
sink :: IORef a -> Maybe ByteString -> IO ()
sink IORef a
_ Maybe ByteString
Nothing = forall a. Maybe a -> OutputStream a -> IO ()
write forall a. Maybe a
Nothing OutputStream ByteString
str
sink IORef a
kref mb :: Maybe ByteString
mb@(Just ByteString
x) = do
a
k <- forall a. IORef a -> IO a
readIORef IORef a
kref
let l :: a
l = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
x
let k' :: a
k' = a
k forall a. Num a => a -> a -> a
- a
l
if a
k' forall a. Ord a => a -> a -> Bool
< a
0
then do let a :: ByteString
a = Int -> ByteString -> ByteString
S.take (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
k) ByteString
x
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
S.null ByteString
a) forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> OutputStream a -> IO ()
write (forall a. a -> Maybe a
Just ByteString
a) OutputStream ByteString
str
forall a. IORef a -> a -> IO ()
writeIORef IORef a
kref a
0
else forall a. IORef a -> a -> IO ()
writeIORef IORef a
kref a
k' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 Int64
k0 OutputStream ByteString
os = do
IORef Int64
ref <- forall a. a -> IO (IORef a)
newIORef Int64
k0
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream forall a b. (a -> b) -> a -> b
$ forall {a}. (Ord a, Num a) => IORef a -> Maybe ByteString -> IO ()
go IORef Int64
ref
where
go :: IORef a -> Maybe ByteString -> IO ()
go IORef a
ref Maybe ByteString
chunk = do
!a
n <- forall a. IORef a -> IO a
readIORef IORef a
ref
case Maybe ByteString
chunk of
Maybe ByteString
Nothing -> if a
n forall a. Eq a => a -> a -> Bool
/= a
0
then forall e a. Exception e => e -> IO a
throwIO TooFewBytesWrittenException
TooFewBytesWrittenException
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ()
Just ByteString
s -> let n' :: a
n' = a
n forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
s)
in if a
n' forall a. Ord a => a -> a -> Bool
< a
0
then forall e a. Exception e => e -> IO a
throwIO TooManyBytesWrittenException
TooManyBytesWrittenException
else do forall a. IORef a -> a -> IO ()
writeIORef IORef a
ref a
n'
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 Int64
k0 OutputStream ByteString
str = do
IORef Int64
kref <- forall a. a -> IO (IORef a)
newIORef Int64
k0
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream forall a b. (a -> b) -> a -> b
$ 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 IORef a
_ Maybe ByteString
Nothing = forall a. Maybe a -> OutputStream a -> IO ()
write forall a. Maybe a
Nothing OutputStream ByteString
str
sink IORef a
kref mb :: Maybe ByteString
mb@(Just ByteString
x) = do
a
k <- forall a. IORef a -> IO a
readIORef IORef a
kref
let l :: a
l = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
x
let k' :: a
k' = a
k forall a. Num a => a -> a -> a
- a
l
if a
k' forall a. Ord a => a -> a -> Bool
< a
0
then forall e a. Exception e => e -> IO a
throwIO TooManyBytesWrittenException
TooManyBytesWrittenException
else forall a. IORef a -> a -> IO ()
writeIORef IORef a
kref a
k' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Maybe a -> OutputStream a -> IO ()
write Maybe ByteString
mb OutputStream ByteString
str
getTime :: IO Double
getTime :: IO Double
getTime = forall a b. (Real a, Fractional b) => a -> b
realToFrac 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
RateTooSlowException = String
"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 <- forall a. a -> IO (IORef a)
newIORef (Int64
0 :: Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. IO (Maybe a) -> (a -> IO ()) -> InputStream a
InputStream (forall {a}.
Integral a =>
Double -> IORef a -> IO (Maybe ByteString)
prod Double
startTime IORef Int64
bytesRead) (forall {a}. Num a => IORef a -> ByteString -> IO ()
pb IORef Int64
bytesRead)
where
prod :: Double -> IORef a -> IO (Maybe ByteString)
prod Double
startTime IORef a
bytesReadRef = forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
stream forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) ByteString -> IO (Maybe ByteString)
chunk
where
chunk :: ByteString -> IO (Maybe ByteString)
chunk ByteString
s = do
let slen :: Int
slen = ByteString -> Int
S.length ByteString
s
Double
now <- IO Double
getTime
let !delta :: Double
delta = Double
now forall a. Num a => a -> a -> a
- Double
startTime
a
nb <- forall a. IORef a -> IO a
readIORef IORef a
bytesReadRef
let newBytes :: a
newBytes = a
nb forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slen
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
delta forall a. Ord a => a -> a -> Bool
> Double
minSeconds forall a. Num a => a -> a -> a
+ Double
1 Bool -> Bool -> Bool
&&
(forall a b. (Integral a, Num b) => a -> b
fromIntegral a
newBytes forall a. Fractional a => a -> a -> a
/
(Double
delta forall a. Num a => a -> a -> a
- Double
minSeconds)) forall a. Ord a => a -> a -> Bool
< Double
minRate) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO RateTooSlowException
RateTooSlowException
!()
_ <- IO ()
bump
forall a. IORef a -> a -> IO ()
writeIORef IORef a
bytesReadRef a
newBytes
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just ByteString
s
pb :: IORef a -> ByteString -> IO ()
pb IORef a
bytesReadRef ByteString
s = do
forall a. IORef a -> (a -> a) -> IO ()
modifyRef IORef a
bytesReadRef forall a b. (a -> b) -> a -> b
$ \a
x -> a
x forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
s)
forall a. a -> InputStream a -> IO ()
unRead ByteString
s InputStream ByteString
stream
minSeconds :: Double
minSeconds = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minSeconds'