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

{-
@fromIntegral@ converts from Int64 to Int which is dangerous in general
but in our case,
since we only use it to check the length of actually read data
that is never more than 2^31 because that's the maximum possible chunk size.
-}
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 {-^ chunk size, only relevant for 'Transfer.readBlock'. -} ->
   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
       {-^ dictionary for read and write methods -} ->
   Int {-^ chunk size -} ->
   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
              {-
              We must use `bindT` instead of 'mappend'
              because we need 'length str'.
              -}
              (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