{- |
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      = List.splitAt
   breakAfter p = ListHT.breakAfter (p . Body.toChar)

instance Body BS.ByteString where
   splitAt = BS.splitAt
   breakAfter p s =
      forcePair $
      maybe (s,BS.empty)
         (\i -> splitAt (i+1) s)
         (BS.findIndex (p . chr . fromIntegral) s)

instance Body BL.ByteString where
   splitAt = BL.splitAt . fromIntegral
   breakAfter p s =
      let (prefix,suffix) =
             BL.break (p . chr . fromIntegral) s
      in  forcePair $
             (mapFst (BL.snoc prefix))
             (BL.uncons suffix)

withBuffer :: (Body.C body) =>
   (body -> (a, body)) ->
   Transfer.AsyncExceptional (T body) a
withBuffer f =
   Async.ExceptionalT $
   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 buf <- RWS.get
      let (block,rest) = f buf
      RWS.put rest
      closeReason <- RWS.ask
      return $
         Async.Exceptional (toMaybe (Body.isEmpty rest) closeReason) block

transfer :: (Body body) =>
   Transfer.T (T body) body
transfer =
   Transfer.Cons {
      Transfer.readBlock  = \n -> withBuffer $ splitAt n,
      Transfer.readLine   = withBuffer $ breakAfter ('\n'==),
      Transfer.writeBlock = \str -> lift $ tell [str]

run :: (Body body) =>
   Reader.T body (T body) a -> Stream.ConnError -> body -> (a, body, [body])
run m = runRWS (runReaderT m $ transfer)