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 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
$
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)