{-# LANGUAGE TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Network.BufferType
-- Description :  Abstract representation of request and response buffer types.
-- Copyright   :  See LICENSE file
-- License     :  BSD
--
-- Maintainer  :  Ganesh Sittampalam <ganesh@earth.li>
-- Stability   :  experimental
-- Portability :  non-portable (not tested)
--
-- In order to give the user freedom in how request and response content
-- is represented, a sufficiently abstract representation is needed of
-- these internally. The "Network.BufferType" module provides this, defining
-- the 'BufferType' class and its ad-hoc representation of buffer operations
-- via the 'BufferOp' record.
--
-- This module provides definitions for the standard buffer types that the
-- package supports, i.e., for @String@ and @ByteString@ (strict and lazy.)
-- 
-----------------------------------------------------------------------------
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 )

-- | The @BufferType@ class encodes, in a mixed-mode way, the interface
-- that the library requires to operate over data embedded in HTTP
-- requests and responses. That is, we use explicit dictionaries
-- for the operations, but overload the name of the dicts themselves.
-- 
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 String
bufferOps = BufferOp String
stringBufferOp

-- | @BufferOp@ encodes the I/O operations of the underlying buffer over 
-- a Handle in an (explicit) dictionary type. May not be needed, but gives
-- us flexibility in explicit overriding and wrapping up of these methods.
--
-- Along with IO operations is an ad-hoc collection of functions for working
-- with these abstract buffers, as needed by the internals of the code
-- that processes requests and responses.
--
-- We supply three default @BufferOp@ values, for @String@ along with the
-- strict and lazy versions of @ByteString@. To add others, provide @BufferOp@
-- definitions for 
data BufferOp a
 = BufferOp
     { BufferOp a -> Handle -> Int -> IO a
buf_hGet         :: Handle -> Int -> IO a
     , BufferOp a -> Handle -> IO a
buf_hGetContents :: Handle -> IO a
     , BufferOp a -> Handle -> a -> IO ()
buf_hPut         :: Handle -> a   -> IO ()
     , BufferOp a -> Handle -> IO a
buf_hGetLine     :: Handle -> IO a
     , BufferOp a -> a
buf_empty        :: a
     , BufferOp a -> a -> a -> a
buf_append       :: a -> a -> a
     , BufferOp a -> [a] -> a
buf_concat       :: [a] -> a
     , BufferOp a -> String -> a
buf_fromStr      :: String -> a
     , BufferOp a -> a -> String
buf_toStr        :: a -> String
     , BufferOp a -> a -> Word8 -> a
buf_snoc         :: a -> Word8 -> a
     , BufferOp a -> Int -> a -> (a, a)
buf_splitAt      :: Int -> a -> (a,a)
     , BufferOp a -> (Char -> Bool) -> a -> (a, a)
buf_span         :: (Char  -> Bool) -> a -> (a,a)
     , BufferOp a -> a -> Bool
buf_isLineTerm   :: a -> Bool
     , 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@ is the 'BufferOp' definition over @ByteString@s,
-- the non-lazy kind.
strictBufferOp :: BufferOp Strict.ByteString
strictBufferOp :: BufferOp ByteString
strictBufferOp = 
    BufferOp :: forall a.
(Handle -> Int -> IO a)
-> (Handle -> IO a)
-> (Handle -> a -> IO ())
-> (Handle -> IO a)
-> a
-> (a -> a -> a)
-> ([a] -> a)
-> (String -> a)
-> (a -> String)
-> (a -> Word8 -> a)
-> (Int -> a -> (a, a))
-> ((Char -> Bool) -> a -> (a, a))
-> (a -> Bool)
-> (a -> Bool)
-> BufferOp a
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 :: String -> ByteString
buf_fromStr      = String -> ByteString
Strict.pack
      , buf_toStr :: ByteString -> String
buf_toStr        = ByteString -> String
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 = String -> ByteString
Strict.pack String
crlf
    p_lf :: ByteString
p_lf   = String -> ByteString
Strict.pack String
lf

-- | @lazyBufferOp@ is the 'BufferOp' definition over @ByteString@s,
-- the non-strict kind.
lazyBufferOp :: BufferOp Lazy.ByteString
lazyBufferOp :: BufferOp ByteString
lazyBufferOp = 
    BufferOp :: forall a.
(Handle -> Int -> IO a)
-> (Handle -> IO a)
-> (Handle -> a -> IO ())
-> (Handle -> IO a)
-> a
-> (a -> a -> a)
-> ([a] -> a)
-> (String -> a)
-> (a -> String)
-> (a -> Word8 -> a)
-> (Int -> a -> (a, a))
-> ((Char -> Bool) -> a -> (a, a))
-> (a -> Bool)
-> (a -> Bool)
-> BufferOp a
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ ByteString
l -> ByteString -> IO ByteString
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 :: String -> ByteString
buf_fromStr      = String -> ByteString
Lazy.pack
      , buf_toStr :: ByteString -> String
buf_toStr        = ByteString -> String
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 = String -> ByteString
Lazy.pack String
crlf
    p_lf :: ByteString
p_lf   = String -> ByteString
Lazy.pack String
lf

-- | @stringBufferOp@ is the 'BufferOp' definition over @String@s.
-- It is defined in terms of @strictBufferOp@ operations,
-- unpacking/converting to @String@ when needed.
stringBufferOp :: BufferOp String
stringBufferOp :: BufferOp String
stringBufferOp =BufferOp :: forall a.
(Handle -> Int -> IO a)
-> (Handle -> IO a)
-> (Handle -> a -> IO ())
-> (Handle -> IO a)
-> a
-> (a -> a -> a)
-> ([a] -> a)
-> (String -> a)
-> (a -> String)
-> (a -> Word8 -> a)
-> (Int -> a -> (a, a))
-> ((Char -> Bool) -> a -> (a, a))
-> (a -> Bool)
-> (a -> Bool)
-> BufferOp a
BufferOp 
      { buf_hGet :: Handle -> Int -> IO String
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 String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String)
-> (ByteString -> String) -> ByteString -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Strict.unpack
      , buf_hGetContents :: Handle -> IO String
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 String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String)
-> (ByteString -> String) -> ByteString -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Strict.unpack
      , buf_hPut :: Handle -> String -> IO ()
buf_hPut         = \ Handle
h String
s -> BufferOp ByteString -> Handle -> ByteString -> IO ()
forall a. BufferOp a -> Handle -> a -> IO ()
buf_hPut BufferOp ByteString
strictBufferOp Handle
h (String -> ByteString
Strict.pack String
s)
      , buf_hGetLine :: Handle -> IO String
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 String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String)
-> (ByteString -> String) -> ByteString -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Strict.unpack
      , buf_append :: String -> String -> String
buf_append       = String -> String -> String
forall a. [a] -> [a] -> [a]
(++)
      , buf_concat :: [String] -> String
buf_concat       = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      , buf_fromStr :: String -> String
buf_fromStr      = String -> String
forall a. a -> a
id
      , buf_toStr :: String -> String
buf_toStr        = String -> String
forall a. a -> a
id
      , buf_snoc :: String -> Word8 -> String
buf_snoc         = \ String
a Word8
x -> String
a String -> String -> String
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 -> String -> (String, String)
buf_splitAt      = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt
      , buf_span :: (Char -> Bool) -> String -> (String, String)
buf_span         = \ Char -> Bool
p String
a -> 
                             case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
Strict.span Char -> Bool
p (String -> ByteString
Strict.pack String
a) of
                               (ByteString
x,ByteString
y) -> (ByteString -> String
Strict.unpack ByteString
x, ByteString -> String
Strict.unpack ByteString
y)
      , buf_empty :: String
buf_empty        = []
      , buf_isLineTerm :: String -> Bool
buf_isLineTerm   = \ String
b -> String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
crlf Bool -> Bool -> Bool
|| String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
lf
      , buf_isEmpty :: String -> Bool
buf_isEmpty      = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null 
      }