Repository navigation
Expand file tree
/
Copy pathBufferType.hs
More file actions
164 lines (150 loc) · 6.22 KB
/
Copy pathBufferType.hs
File metadata and controls
164 lines (150 loc) · 6.22 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
{-# 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 = lazyBufferOp
instance BufferType Strict.ByteString where
bufferOps = strictBufferOp
instance BufferType String where
bufferOps = 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
{ buf_hGet :: Handle -> Int -> IO a
, buf_hGetContents :: Handle -> IO a
, buf_hPut :: Handle -> a -> IO ()
, buf_hGetLine :: Handle -> IO a
, buf_empty :: a
, buf_append :: a -> a -> a
, buf_concat :: [a] -> a
, buf_fromStr :: String -> a
, buf_toStr :: a -> String
, buf_snoc :: a -> Word8 -> a
, buf_splitAt :: Int -> a -> (a,a)
, buf_span :: (Char -> Bool) -> a -> (a,a)
, buf_isLineTerm :: a -> Bool
, buf_isEmpty :: a -> Bool
}
instance Eq (BufferOp a) where
_ == _ = False
-- | @strictBufferOp@ is the 'BufferOp' definition over @ByteString@s,
-- the non-lazy kind.
strictBufferOp :: BufferOp Strict.ByteString
strictBufferOp =
BufferOp
{ buf_hGet = Strict.hGet
, buf_hGetContents = Strict.hGetContents
, buf_hPut = Strict.hPut
, buf_hGetLine = Strict.hGetLine
, buf_append = Strict.append
, buf_concat = Strict.concat
, buf_fromStr = Strict.pack
, buf_toStr = Strict.unpack
, buf_snoc = Strict.snoc
, buf_splitAt = Strict.splitAt
, buf_span = Strict.span
, buf_empty = Strict.empty
, buf_isLineTerm = \ b -> Strict.length b == 2 && p_crlf == b ||
Strict.length b == 1 && p_lf == b
, buf_isEmpty = Strict.null
}
where
p_crlf = Strict.pack crlf
p_lf = Strict.pack lf
-- | @lazyBufferOp@ is the 'BufferOp' definition over @ByteString@s,
-- the non-strict kind.
lazyBufferOp :: BufferOp Lazy.ByteString
lazyBufferOp =
BufferOp
{ buf_hGet = Lazy.hGet
, buf_hGetContents = Lazy.hGetContents
, buf_hPut = Lazy.hPut
, buf_hGetLine = \ h -> Strict.hGetLine h >>= \ l -> return (Lazy.fromChunks [l])
, buf_append = Lazy.append
, buf_concat = Lazy.concat
, buf_fromStr = Lazy.pack
, buf_toStr = Lazy.unpack
, buf_snoc = Lazy.snoc
, buf_splitAt = \ i x -> Lazy.splitAt (fromIntegral i) x
, buf_span = Lazy.span
, buf_empty = Lazy.empty
, buf_isLineTerm = \ b -> Lazy.length b == 2 && p_crlf == b ||
Lazy.length b == 1 && p_lf == b
, buf_isEmpty = Lazy.null
}
where
p_crlf = Lazy.pack crlf
p_lf = Lazy.pack 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
{ buf_hGet = \ h n -> buf_hGet strictBufferOp h n >>= return . Strict.unpack
, buf_hGetContents = \ h -> buf_hGetContents strictBufferOp h >>= return . Strict.unpack
, buf_hPut = \ h s -> buf_hPut strictBufferOp h (Strict.pack s)
, buf_hGetLine = \ h -> buf_hGetLine strictBufferOp h >>= return . Strict.unpack
, buf_append = (++)
, buf_concat = concat
, buf_fromStr = id
, buf_toStr = id
, buf_snoc = \ a x -> a ++ [toEnum (fromIntegral x)]
, buf_splitAt = splitAt
, buf_span = \ p a ->
case Strict.span p (Strict.pack a) of
(x,y) -> (Strict.unpack x, Strict.unpack y)
, buf_empty = []
, buf_isLineTerm = \ b -> b == crlf || b == lf
, buf_isEmpty = null
}