module Network.Monad.Transfer.ChunkyLazyIO (
Body(length),
transfer,
run,
) where
import qualified Network.Monad.Transfer as Transfer
import qualified Network.Monad.Reader as Reader
import qualified Network.Monad.Body as Body
import qualified Network.TCP as TCP
import Control.Monad.Trans.Reader (ReaderT, runReaderT, )
import qualified Control.Monad.Exception.Asynchronous as Async
import qualified System.IO.Lazy as LazyIO
import Data.Monoid (Monoid, mempty, mappend, )
import qualified Data.List as List
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import Prelude hiding (length, )
class Body.C body => Body body where
length :: body -> Int
instance Body.CharType char => Body [char] where
length :: [char] -> Int
length = forall (t :: * -> *) a. Foldable t => t a -> Int
List.length
instance Body BS.ByteString where
length :: ByteString -> Int
length = ByteString -> Int
BS.length
instance Body BL.ByteString where
length :: ByteString -> Int
length = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length
transfer :: (TCP.HStream body, Body body) =>
Int ->
TCP.HandleStream body ->
Transfer.T LazyIO.T body
transfer :: forall body.
(HStream body, Body body) =>
Int -> HandleStream body -> T T body
transfer Int
chunkSize HandleStream body
h =
Transfer.Cons {
readLine :: AsyncExceptional T body
Transfer.readLine =
forall (m :: * -> *) a.
(Monad m, Monoid a) =>
m (Result a) -> AsyncExceptional m a
Transfer.liftAsync forall a b. (a -> b) -> a -> b
$ forall a. IO a -> T a
LazyIO.interleave forall a b. (a -> b) -> a -> b
$ forall bufType.
HStream bufType =>
HandleStream bufType -> IO (Result bufType)
TCP.readLine HandleStream body
h,
readBlock :: Int -> AsyncExceptional T body
Transfer.readBlock = \Int
n ->
forall body.
(HStream body, Body body) =>
Int -> HandleStream body -> Int -> AsyncExceptional T body
readBlockChunky Int
chunkSize HandleStream body
h Int
n,
writeBlock :: body -> SyncExceptional T ()
Transfer.writeBlock = \body
str ->
forall (m :: * -> *) a.
Monad m =>
m (Result a) -> SyncExceptional m a
Transfer.liftSync forall a b. (a -> b) -> a -> b
$ forall a. IO a -> T a
LazyIO.interleave forall a b. (a -> b) -> a -> b
$ forall bufType.
HStream bufType =>
HandleStream bufType -> bufType -> IO (Result ())
TCP.writeBlock HandleStream body
h body
str
}
run :: (TCP.HStream body, Body body) =>
Reader.T body LazyIO.T a
->
Int ->
TCP.HandleStream body ->
IO a
run :: forall body a.
(HStream body, Body body) =>
T body T a -> Int -> HandleStream body -> IO a
run T body T a
m Int
chunkSize HandleStream body
h = forall a. T a -> IO a
LazyIO.run forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT T body T a
m forall a b. (a -> b) -> a -> b
$ forall body.
(HStream body, Body body) =>
Int -> HandleStream body -> T T body
transfer Int
chunkSize HandleStream body
h
readBlockChunky :: (TCP.HStream body, Body body) =>
Int -> TCP.HandleStream body ->
Int -> Transfer.AsyncExceptional LazyIO.T body
readBlockChunky :: forall body.
(HStream body, Body body) =>
Int -> HandleStream body -> Int -> AsyncExceptional T body
readBlockChunky Int
chunkSize HandleStream body
h =
let go :: Int -> ExceptionalT ConnError T body
go Int
todo =
if Int
todoforall a. Ord a => a -> a -> Bool
>Int
0
then
(forall (m :: * -> *) a.
(Monad m, Monoid a) =>
m (Result a) -> AsyncExceptional m a
Transfer.liftAsync forall a b. (a -> b) -> a -> b
$ forall a. IO a -> T a
LazyIO.interleave forall a b. (a -> b) -> a -> b
$
forall bufType.
HStream bufType =>
HandleStream bufType -> Int -> IO (Result bufType)
TCP.readBlock HandleStream body
h (forall a. Ord a => a -> a -> a
min Int
chunkSize Int
todo))
forall (m :: * -> *) b e a.
(Monad m, Monoid b) =>
ExceptionalT e m a
-> (a -> ExceptionalT e m b) -> ExceptionalT e m b
`Async.bindT`
(\body
str ->
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a -> a -> a
mappend body
str) forall a b. (a -> b) -> a -> b
$ Int -> ExceptionalT ConnError T body
go (forall a. Ord a => a -> a -> a
max Int
0 (Int
todo forall a. Num a => a -> a -> a
- forall body. Body body => body -> Int
length body
str)))
else forall a. Monoid a => a
mempty
in Int -> ExceptionalT ConnError T body
go