1{-# LANGUAGE TypeSynonymInstances #-} 2----------------------------------------------------------------------------- 3-- | 4-- Module : Network.BufferType 5-- Description : Abstract representation of request and response buffer types. 6-- Copyright : See LICENSE file 7-- License : BSD 8-- 9-- Maintainer : Ganesh Sittampalam <ganesh@earth.li> 10-- Stability : experimental 11-- Portability : non-portable (not tested) 12-- 13-- In order to give the user freedom in how request and response content 14-- is represented, a sufficiently abstract representation is needed of 15-- these internally. The "Network.BufferType" module provides this, defining 16-- the 'BufferType' class and its ad-hoc representation of buffer operations 17-- via the 'BufferOp' record. 18-- 19-- This module provides definitions for the standard buffer types that the 20-- package supports, i.e., for @String@ and @ByteString@ (strict and lazy.) 21-- 22----------------------------------------------------------------------------- 23module Network.BufferType 24 ( 25 BufferType(..) 26 27 , BufferOp(..) 28 , strictBufferOp 29 , lazyBufferOp 30 , stringBufferOp 31 ) where 32 33 34import qualified Data.ByteString as Strict hiding ( unpack, pack, span ) 35import qualified Data.ByteString.Char8 as Strict ( unpack, pack, span ) 36import qualified Data.ByteString.Lazy as Lazy hiding ( pack, unpack,span ) 37import qualified Data.ByteString.Lazy.Char8 as Lazy ( pack, unpack, span ) 38import System.IO ( Handle ) 39import Data.Word ( Word8 ) 40 41import Network.HTTP.Utils ( crlf, lf ) 42 43-- | The @BufferType@ class encodes, in a mixed-mode way, the interface 44-- that the library requires to operate over data embedded in HTTP 45-- requests and responses. That is, we use explicit dictionaries 46-- for the operations, but overload the name of the dicts themselves. 47-- 48class BufferType bufType where 49 bufferOps :: BufferOp bufType 50 51instance BufferType Lazy.ByteString where 52 bufferOps = lazyBufferOp 53 54instance BufferType Strict.ByteString where 55 bufferOps = strictBufferOp 56 57instance BufferType String where 58 bufferOps = stringBufferOp 59 60-- | @BufferOp@ encodes the I/O operations of the underlying buffer over 61-- a Handle in an (explicit) dictionary type. May not be needed, but gives 62-- us flexibility in explicit overriding and wrapping up of these methods. 63-- 64-- Along with IO operations is an ad-hoc collection of functions for working 65-- with these abstract buffers, as needed by the internals of the code 66-- that processes requests and responses. 67-- 68-- We supply three default @BufferOp@ values, for @String@ along with the 69-- strict and lazy versions of @ByteString@. To add others, provide @BufferOp@ 70-- definitions for 71data BufferOp a 72 = BufferOp 73 { buf_hGet :: Handle -> Int -> IO a 74 , buf_hGetContents :: Handle -> IO a 75 , buf_hPut :: Handle -> a -> IO () 76 , buf_hGetLine :: Handle -> IO a 77 , buf_empty :: a 78 , buf_append :: a -> a -> a 79 , buf_concat :: [a] -> a 80 , buf_fromStr :: String -> a 81 , buf_toStr :: a -> String 82 , buf_snoc :: a -> Word8 -> a 83 , buf_splitAt :: Int -> a -> (a,a) 84 , buf_span :: (Char -> Bool) -> a -> (a,a) 85 , buf_isLineTerm :: a -> Bool 86 , buf_isEmpty :: a -> Bool 87 } 88 89instance Eq (BufferOp a) where 90 _ == _ = False 91 92-- | @strictBufferOp@ is the 'BufferOp' definition over @ByteString@s, 93-- the non-lazy kind. 94strictBufferOp :: BufferOp Strict.ByteString 95strictBufferOp = 96 BufferOp 97 { buf_hGet = Strict.hGet 98 , buf_hGetContents = Strict.hGetContents 99 , buf_hPut = Strict.hPut 100 , buf_hGetLine = Strict.hGetLine 101 , buf_append = Strict.append 102 , buf_concat = Strict.concat 103 , buf_fromStr = Strict.pack 104 , buf_toStr = Strict.unpack 105 , buf_snoc = Strict.snoc 106 , buf_splitAt = Strict.splitAt 107 , buf_span = Strict.span 108 , buf_empty = Strict.empty 109 , buf_isLineTerm = \ b -> Strict.length b == 2 && p_crlf == b || 110 Strict.length b == 1 && p_lf == b 111 , buf_isEmpty = Strict.null 112 } 113 where 114 p_crlf = Strict.pack crlf 115 p_lf = Strict.pack lf 116 117-- | @lazyBufferOp@ is the 'BufferOp' definition over @ByteString@s, 118-- the non-strict kind. 119lazyBufferOp :: BufferOp Lazy.ByteString 120lazyBufferOp = 121 BufferOp 122 { buf_hGet = Lazy.hGet 123 , buf_hGetContents = Lazy.hGetContents 124 , buf_hPut = Lazy.hPut 125 , buf_hGetLine = \ h -> Strict.hGetLine h >>= \ l -> return (Lazy.fromChunks [l]) 126 , buf_append = Lazy.append 127 , buf_concat = Lazy.concat 128 , buf_fromStr = Lazy.pack 129 , buf_toStr = Lazy.unpack 130 , buf_snoc = Lazy.snoc 131 , buf_splitAt = \ i x -> Lazy.splitAt (fromIntegral i) x 132 , buf_span = Lazy.span 133 , buf_empty = Lazy.empty 134 , buf_isLineTerm = \ b -> Lazy.length b == 2 && p_crlf == b || 135 Lazy.length b == 1 && p_lf == b 136 , buf_isEmpty = Lazy.null 137 } 138 where 139 p_crlf = Lazy.pack crlf 140 p_lf = Lazy.pack lf 141 142-- | @stringBufferOp@ is the 'BufferOp' definition over @String@s. 143-- It is defined in terms of @strictBufferOp@ operations, 144-- unpacking/converting to @String@ when needed. 145stringBufferOp :: BufferOp String 146stringBufferOp =BufferOp 147 { buf_hGet = \ h n -> buf_hGet strictBufferOp h n >>= return . Strict.unpack 148 , buf_hGetContents = \ h -> buf_hGetContents strictBufferOp h >>= return . Strict.unpack 149 , buf_hPut = \ h s -> buf_hPut strictBufferOp h (Strict.pack s) 150 , buf_hGetLine = \ h -> buf_hGetLine strictBufferOp h >>= return . Strict.unpack 151 , buf_append = (++) 152 , buf_concat = concat 153 , buf_fromStr = id 154 , buf_toStr = id 155 , buf_snoc = \ a x -> a ++ [toEnum (fromIntegral x)] 156 , buf_splitAt = splitAt 157 , buf_span = \ p a -> 158 case Strict.span p (Strict.pack a) of 159 (x,y) -> (Strict.unpack x, Strict.unpack y) 160 , buf_empty = [] 161 , buf_isLineTerm = \ b -> b == crlf || b == lf 162 , buf_isEmpty = null 163 } 164 165