{- |
Transfer type without IO interaction.
Optimal for testing.
-}
module Network.Monad.Transfer.Offline 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.Stream as Stream
import Control.Monad.Trans.Reader (ReaderT, runReaderT, )
import Control.Monad.Trans.RWS    (RWS, runRWS, tell, )
import Control.Monad.Trans.Class (lift, )

import qualified Control.Monad.Trans.RWS as RWS

import qualified Control.Monad.Exception.Asynchronous as Async
-- import qualified Control.Monad.Exception.Synchronous  as Sync

import Data.Char (chr, )

import qualified Data.List    as List
import qualified Data.List.HT as ListHT
import Data.Maybe.HT (toMaybe, )
import Data.Tuple.HT (forcePair, mapFst, )

import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy as BL

import Prelude hiding (splitAt, )



type T body = RWS Stream.ConnError [body] body


class Body.C body => Body body where
   splitAt    :: Int -> body -> (body, body)
   breakAfter :: (Char  -> Bool) -> body -> (body, body)

instance Body.CharType char => Body [char] where
   splitAt :: Int -> [char] -> ([char], [char])
splitAt      = forall a. Int -> [a] -> ([a], [a])
List.splitAt
   breakAfter :: (Char -> Bool) -> [char] -> ([char], [char])
breakAfter Char -> Bool
p = forall a. (a -> Bool) -> [a] -> ([a], [a])
ListHT.breakAfter (Char -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall char. CharType char => char -> Char
Body.toChar)

instance Body BS.ByteString where
   splitAt :: Int -> ByteString -> (ByteString, ByteString)
splitAt = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt
   breakAfter :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
breakAfter Char -> Bool
p ByteString
s =
      forall a b. (a, b) -> (a, b)
forcePair forall a b. (a -> b) -> a -> b
$
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString
s,ByteString
BS.empty)
         (\Int
i -> forall body. Body body => Int -> body -> (body, body)
splitAt (Int
iforall a. Num a => a -> a -> a
+Int
1) ByteString
s)
         ((Word8 -> Bool) -> ByteString -> Maybe Int
BS.findIndex (Char -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) ByteString
s)

instance Body BL.ByteString where
   splitAt :: Int -> ByteString -> (ByteString, ByteString)
splitAt = Int64 -> ByteString -> (ByteString, ByteString)
BL.splitAt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
   breakAfter :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
breakAfter Char -> Bool
p ByteString
s =
      let (ByteString
prefix,ByteString
suffix) =
             (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BL.break (Char -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) ByteString
s
      in  forall a b. (a, b) -> (a, b)
forcePair forall a b. (a -> b) -> a -> b
$
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe
             (ByteString
prefix,ByteString
suffix)
             (forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (ByteString -> Word8 -> ByteString
BL.snoc ByteString
prefix))
             (ByteString -> Maybe (Word8, ByteString)
BL.uncons ByteString
suffix)


withBuffer :: (Body.C body) =>
   (body -> (a, body)) ->
   Transfer.AsyncExceptional (T body) a
withBuffer :: forall body a.
C body =>
(body -> (a, body)) -> AsyncExceptional (T body) a
withBuffer body -> (a, body)
f =
   forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
Async.ExceptionalT forall a b. (a -> b) -> a -> b
$
   {-
   It is important to run all monadic actions
   independent from the exceptional case of an empty buffer,
   because only this way it is clear to the run-time system,
   that there is no write action.
   This in turn is important for a maximum of laziness.
   -}
   do body
buf <- forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
RWS.get
      let (a
block,body
rest) = body -> (a, body)
f body
buf
      forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
s -> RWST r w s m ()
RWS.put body
rest
      ConnError
closeReason <- forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
RWS.ask
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
         forall e a. Maybe e -> a -> Exceptional e a
Async.Exceptional (forall a. Bool -> a -> Maybe a
toMaybe (forall body. C body => body -> Bool
Body.isEmpty body
rest) ConnError
closeReason) a
block


transfer :: (Body body) =>
   Transfer.T (T body) body
transfer :: forall body. Body body => T (T body) body
transfer =
   Transfer.Cons {
      readBlock :: Int -> AsyncExceptional (T body) body
Transfer.readBlock  = \Int
n -> forall body a.
C body =>
(body -> (a, body)) -> AsyncExceptional (T body) a
withBuffer forall a b. (a -> b) -> a -> b
$ forall body. Body body => Int -> body -> (body, body)
splitAt Int
n,
      readLine :: AsyncExceptional (T body) body
Transfer.readLine   = forall body a.
C body =>
(body -> (a, body)) -> AsyncExceptional (T body) a
withBuffer forall a b. (a -> b) -> a -> b
$ forall body. Body body => (Char -> Bool) -> body -> (body, body)
breakAfter (Char
'\n'forall a. Eq a => a -> a -> Bool
==),
      writeBlock :: body -> SyncExceptional (T body) ()
Transfer.writeBlock = \body
str -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
tell [body
str]
   }

run :: (Body body) =>
   Reader.T body (T body) a -> Stream.ConnError -> body -> (a, body, [body])
run :: forall body a.
Body body =>
T body (T body) a -> ConnError -> body -> (a, body, [body])
run T body (T body) a
m = forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT T body (T body) a
m forall a b. (a -> b) -> a -> b
$ forall body. Body body => T (T body) body
transfer)