{-# LANGUAGE TypeSynonymInstances #-}
module Network.BufferType
(
BufferType(..)
, BufferOp(..)
, strictBufferOp
, lazyBufferOp
, stringBufferOp
) where
import qualified Data.ByteString as Strict hiding ( unpack, pack, span )
import qualified Data.ByteString.Char8 as Strict ( unpack, pack, span )
import qualified Data.ByteString.Lazy as Lazy hiding ( pack, unpack,span )
import qualified Data.ByteString.Lazy.Char8 as Lazy ( pack, unpack, span )
import System.IO ( Handle )
import Data.Word ( Word8 )
import Network.HTTP.Utils ( crlf, lf )
class BufferType bufType where
bufferOps :: BufferOp bufType
instance BufferType Lazy.ByteString where
bufferOps :: BufferOp ByteString
bufferOps = BufferOp ByteString
lazyBufferOp
instance BufferType Strict.ByteString where
bufferOps :: BufferOp ByteString
bufferOps = BufferOp ByteString
strictBufferOp
instance BufferType String where
bufferOps :: BufferOp [Char]
bufferOps = BufferOp [Char]
stringBufferOp
data BufferOp a
= BufferOp
{ forall a. BufferOp a -> Handle -> Int -> IO a
buf_hGet :: Handle -> Int -> IO a
, forall a. BufferOp a -> Handle -> IO a
buf_hGetContents :: Handle -> IO a
, forall a. BufferOp a -> Handle -> a -> IO ()
buf_hPut :: Handle -> a -> IO ()
, forall a. BufferOp a -> Handle -> IO a
buf_hGetLine :: Handle -> IO a
, forall a. BufferOp a -> a
buf_empty :: a
, forall a. BufferOp a -> a -> a -> a
buf_append :: a -> a -> a
, forall a. BufferOp a -> [a] -> a
buf_concat :: [a] -> a
, forall a. BufferOp a -> [Char] -> a
buf_fromStr :: String -> a
, forall a. BufferOp a -> a -> [Char]
buf_toStr :: a -> String
, forall a. BufferOp a -> a -> Word8 -> a
buf_snoc :: a -> Word8 -> a
, forall a. BufferOp a -> Int -> a -> (a, a)
buf_splitAt :: Int -> a -> (a,a)
, forall a. BufferOp a -> (Char -> Bool) -> a -> (a, a)
buf_span :: (Char -> Bool) -> a -> (a,a)
, forall a. BufferOp a -> a -> Bool
buf_isLineTerm :: a -> Bool
, forall a. BufferOp a -> a -> Bool
buf_isEmpty :: a -> Bool
}
instance Eq (BufferOp a) where
BufferOp a
_ == :: BufferOp a -> BufferOp a -> Bool
== BufferOp a
_ = Bool
False
strictBufferOp :: BufferOp Strict.ByteString
strictBufferOp :: BufferOp ByteString
strictBufferOp =
BufferOp
{ buf_hGet :: Handle -> Int -> IO ByteString
buf_hGet = Handle -> Int -> IO ByteString
Strict.hGet
, buf_hGetContents :: Handle -> IO ByteString
buf_hGetContents = Handle -> IO ByteString
Strict.hGetContents
, buf_hPut :: Handle -> ByteString -> IO ()
buf_hPut = Handle -> ByteString -> IO ()
Strict.hPut
, buf_hGetLine :: Handle -> IO ByteString
buf_hGetLine = Handle -> IO ByteString
Strict.hGetLine
, buf_append :: ByteString -> ByteString -> ByteString
buf_append = ByteString -> ByteString -> ByteString
Strict.append
, buf_concat :: [ByteString] -> ByteString
buf_concat = [ByteString] -> ByteString
Strict.concat
, buf_fromStr :: [Char] -> ByteString
buf_fromStr = [Char] -> ByteString
Strict.pack
, buf_toStr :: ByteString -> [Char]
buf_toStr = ByteString -> [Char]
Strict.unpack
, buf_snoc :: ByteString -> Word8 -> ByteString
buf_snoc = ByteString -> Word8 -> ByteString
Strict.snoc
, buf_splitAt :: Int -> ByteString -> (ByteString, ByteString)
buf_splitAt = Int -> ByteString -> (ByteString, ByteString)
Strict.splitAt
, buf_span :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
buf_span = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
Strict.span
, buf_empty :: ByteString
buf_empty = ByteString
Strict.empty
, buf_isLineTerm :: ByteString -> Bool
buf_isLineTerm = \ ByteString
b -> ByteString -> Int
Strict.length ByteString
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
&& ByteString
p_crlf ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
b Bool -> Bool -> Bool
||
ByteString -> Int
Strict.length ByteString
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& ByteString
p_lf ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
b
, buf_isEmpty :: ByteString -> Bool
buf_isEmpty = ByteString -> Bool
Strict.null
}
where
p_crlf :: ByteString
p_crlf = [Char] -> ByteString
Strict.pack [Char]
crlf
p_lf :: ByteString
p_lf = [Char] -> ByteString
Strict.pack [Char]
lf
lazyBufferOp :: BufferOp Lazy.ByteString
lazyBufferOp :: BufferOp ByteString
lazyBufferOp =
BufferOp
{ buf_hGet :: Handle -> Int -> IO ByteString
buf_hGet = Handle -> Int -> IO ByteString
Lazy.hGet
, buf_hGetContents :: Handle -> IO ByteString
buf_hGetContents = Handle -> IO ByteString
Lazy.hGetContents
, buf_hPut :: Handle -> ByteString -> IO ()
buf_hPut = Handle -> ByteString -> IO ()
Lazy.hPut
, buf_hGetLine :: Handle -> IO ByteString
buf_hGetLine = \ Handle
h -> Handle -> IO ByteString
Strict.hGetLine Handle
h IO ByteString -> (ByteString -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ ByteString
l -> ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
Lazy.fromChunks [ByteString
l])
, buf_append :: ByteString -> ByteString -> ByteString
buf_append = ByteString -> ByteString -> ByteString
Lazy.append
, buf_concat :: [ByteString] -> ByteString
buf_concat = [ByteString] -> ByteString
Lazy.concat
, buf_fromStr :: [Char] -> ByteString
buf_fromStr = [Char] -> ByteString
Lazy.pack
, buf_toStr :: ByteString -> [Char]
buf_toStr = ByteString -> [Char]
Lazy.unpack
, buf_snoc :: ByteString -> Word8 -> ByteString
buf_snoc = ByteString -> Word8 -> ByteString
Lazy.snoc
, buf_splitAt :: Int -> ByteString -> (ByteString, ByteString)
buf_splitAt = \ Int
i ByteString
x -> Int64 -> ByteString -> (ByteString, ByteString)
Lazy.splitAt (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) ByteString
x
, buf_span :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
buf_span = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
Lazy.span
, buf_empty :: ByteString
buf_empty = ByteString
Lazy.empty
, buf_isLineTerm :: ByteString -> Bool
buf_isLineTerm = \ ByteString
b -> ByteString -> Int64
Lazy.length ByteString
b Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
2 Bool -> Bool -> Bool
&& ByteString
p_crlf ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
b Bool -> Bool -> Bool
||
ByteString -> Int64
Lazy.length ByteString
b Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
1 Bool -> Bool -> Bool
&& ByteString
p_lf ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
b
, buf_isEmpty :: ByteString -> Bool
buf_isEmpty = ByteString -> Bool
Lazy.null
}
where
p_crlf :: ByteString
p_crlf = [Char] -> ByteString
Lazy.pack [Char]
crlf
p_lf :: ByteString
p_lf = [Char] -> ByteString
Lazy.pack [Char]
lf
stringBufferOp :: BufferOp String
stringBufferOp :: BufferOp [Char]
stringBufferOp =BufferOp
{ buf_hGet :: Handle -> Int -> IO [Char]
buf_hGet = \ Handle
h Int
n -> BufferOp ByteString -> Handle -> Int -> IO ByteString
forall a. BufferOp a -> Handle -> Int -> IO a
buf_hGet BufferOp ByteString
strictBufferOp Handle
h Int
n IO ByteString -> (ByteString -> IO [Char]) -> IO [Char]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char])
-> (ByteString -> [Char]) -> ByteString -> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
Strict.unpack
, buf_hGetContents :: Handle -> IO [Char]
buf_hGetContents = \ Handle
h -> BufferOp ByteString -> Handle -> IO ByteString
forall a. BufferOp a -> Handle -> IO a
buf_hGetContents BufferOp ByteString
strictBufferOp Handle
h IO ByteString -> (ByteString -> IO [Char]) -> IO [Char]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char])
-> (ByteString -> [Char]) -> ByteString -> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
Strict.unpack
, buf_hPut :: Handle -> [Char] -> IO ()
buf_hPut = \ Handle
h [Char]
s -> BufferOp ByteString -> Handle -> ByteString -> IO ()
forall a. BufferOp a -> Handle -> a -> IO ()
buf_hPut BufferOp ByteString
strictBufferOp Handle
h ([Char] -> ByteString
Strict.pack [Char]
s)
, buf_hGetLine :: Handle -> IO [Char]
buf_hGetLine = \ Handle
h -> BufferOp ByteString -> Handle -> IO ByteString
forall a. BufferOp a -> Handle -> IO a
buf_hGetLine BufferOp ByteString
strictBufferOp Handle
h IO ByteString -> (ByteString -> IO [Char]) -> IO [Char]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char])
-> (ByteString -> [Char]) -> ByteString -> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
Strict.unpack
, buf_append :: [Char] -> [Char] -> [Char]
buf_append = [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++)
, buf_concat :: [[Char]] -> [Char]
buf_concat = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
, buf_fromStr :: [Char] -> [Char]
buf_fromStr = [Char] -> [Char]
forall a. a -> a
id
, buf_toStr :: [Char] -> [Char]
buf_toStr = [Char] -> [Char]
forall a. a -> a
id
, buf_snoc :: [Char] -> Word8 -> [Char]
buf_snoc = \ [Char]
a Word8
x -> [Char]
a [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Int -> Char
forall a. Enum a => Int -> a
toEnum (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)]
, buf_splitAt :: Int -> [Char] -> ([Char], [Char])
buf_splitAt = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt
, buf_span :: (Char -> Bool) -> [Char] -> ([Char], [Char])
buf_span = \ Char -> Bool
p [Char]
a ->
case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
Strict.span Char -> Bool
p ([Char] -> ByteString
Strict.pack [Char]
a) of
(ByteString
x,ByteString
y) -> (ByteString -> [Char]
Strict.unpack ByteString
x, ByteString -> [Char]
Strict.unpack ByteString
y)
, buf_empty :: [Char]
buf_empty = []
, buf_isLineTerm :: [Char] -> Bool
buf_isLineTerm = \ [Char]
b -> [Char]
b [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
crlf Bool -> Bool -> Bool
|| [Char]
b [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
lf
, buf_isEmpty :: [Char] -> Bool
buf_isEmpty = [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
}