{- |
Module:        Network.Monad.Body
Copyright:     (c) 2009 Henning Thielemann
License:       BSD

Stability:     experimental
Portability:   non-portable (not tested)
-}
module Network.Monad.Body (C(..), CharType(..) {- for Transfer.Offline -}) where

import qualified Network.BufferType as BT

import Data.Monoid (Monoid, )
import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy as BL
import Network.Monad.Utility (crlf, )


class Monoid body => C body where
   fromString   :: String -> body
   toString     :: body -> String
   isLineTerm   :: body -> Bool
   isEmpty      :: body -> Bool

class CharType char where
   fromChar :: Char -> char
   toChar   :: char -> Char

instance CharType Char where
   fromChar :: Char -> Char
fromChar = forall a. a -> a
id
   toChar :: Char -> Char
toChar   = forall a. a -> a
id

instance CharType char => C [char] where
   fromString :: String -> [char]
fromString = forall a b. (a -> b) -> [a] -> [b]
map forall char. CharType char => Char -> char
fromChar
   toString :: [char] -> String
toString   = forall a b. (a -> b) -> [a] -> [b]
map forall char. CharType char => char -> Char
toChar
   isLineTerm :: [char] -> Bool
isLineTerm = (String
crlfforall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. C body => body -> String
toString
   isEmpty :: [char] -> Bool
isEmpty    = forall (t :: * -> *) a. Foldable t => t a -> Bool
null

instance C BS.ByteString where
   fromString :: String -> ByteString
fromString = forall a. BufferOp a -> String -> a
BT.buf_fromStr    BufferOp ByteString
BT.strictBufferOp
   toString :: ByteString -> String
toString   = forall a. BufferOp a -> a -> String
BT.buf_toStr      BufferOp ByteString
BT.strictBufferOp
   isLineTerm :: ByteString -> Bool
isLineTerm = forall a. BufferOp a -> a -> Bool
BT.buf_isLineTerm BufferOp ByteString
BT.strictBufferOp
   isEmpty :: ByteString -> Bool
isEmpty    = forall a. BufferOp a -> a -> Bool
BT.buf_isEmpty    BufferOp ByteString
BT.strictBufferOp

instance C BL.ByteString where
   fromString :: String -> ByteString
fromString = forall a. BufferOp a -> String -> a
BT.buf_fromStr    BufferOp ByteString
BT.lazyBufferOp
   toString :: ByteString -> String
toString   = forall a. BufferOp a -> a -> String
BT.buf_toStr      BufferOp ByteString
BT.lazyBufferOp
   isLineTerm :: ByteString -> Bool
isLineTerm = forall a. BufferOp a -> a -> Bool
BT.buf_isLineTerm BufferOp ByteString
BT.lazyBufferOp
   isEmpty :: ByteString -> Bool
isEmpty    = forall a. BufferOp a -> a -> Bool
BT.buf_isEmpty    BufferOp ByteString
BT.lazyBufferOp