{- |
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 $
          maybe
             (prefix,suffix)
             (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)