git.iko.soy/typeable/wai
on master help sign in
introducing packInteger for performance.
7732e36Kazu Yamamoto
warp/Network/Wai/Handler/Warp/File.hs+29−2
compare with master
unifiedsplit
@@ -7,14 +7,19 @@ module Network.Wai.Handler.Warp.File (
7 , conditionalRequest
7 , conditionalRequest
8 , addContentHeadersForFilePart
8 , addContentHeadersForFilePart
9 , parseByteRanges
9 , parseByteRanges
10+ , packInteger -- testing
10 ) where
11 ) where
11
12
12import Control.Applicative ((<|>))
13import Control.Applicative ((<|>))
14+import Control.Monad
13import Data.Array ((!))
15import Data.Array ((!))
14−import Data.ByteString (ByteString)
15import qualified Data.ByteString as B hiding (pack)
16import qualified Data.ByteString as B hiding (pack)
16import qualified Data.ByteString.Char8 as B (pack, readInteger)
17import qualified Data.ByteString.Char8 as B (pack, readInteger)
18+import Data.ByteString.Internal (ByteString(..), unsafeCreate)
17import Data.Maybe (fromMaybe)
19import Data.Maybe (fromMaybe)
20+import Data.Word8 (Word8)
21+import Foreign.Ptr (Ptr, plusPtr)
22+import Foreign.Storable (poke)
18import Network.HTTP.Date
23import Network.HTTP.Date
19import qualified Network.HTTP.Types as H
24import qualified Network.HTTP.Types as H
20import qualified Network.HTTP.Types.Header as H
25import qualified Network.HTTP.Types.Header as H
@@ -27,6 +32,9 @@ import Numeric (showInt)
27#define MIN_VERSION_http_types(x,y,z) 1
32#define MIN_VERSION_http_types(x,y,z) 1
28#endif
33#endif
29
34
35+-- $setup
36+-- >>> import Test.QuickCheck
37+
30----------------------------------------------------------------
38----------------------------------------------------------------
31
39
32data RspFileInfo = WithoutBody H.Status
40data RspFileInfo = WithoutBody H.Status
@@ -175,9 +183,28 @@ addContentHeaders hs off len size
175 | otherwise = let !ctrng = contentRangeHeader off (off + len - 1) size
183 | otherwise = let !ctrng = contentRangeHeader off (off + len - 1) size
176 in ctrng:hs'
184 in ctrng:hs'
177 where
185 where
178− !lengthBS = B.pack $ show len -- fixme
186+ !lengthBS = packInteger len
179 !hs' = (H.hContentLength, lengthBS) : (acceptRange,"bytes") : hs
187 !hs' = (H.hContentLength, lengthBS) : (acceptRange,"bytes") : hs
180
188
189+-- |
190+--
191+-- prop> packInteger (abs n) == B.pack (show (abs n))
192+-- prop> \(Large n) -> let n' = fromIntegral (abs n :: Int) in packInteger n' == B.pack (show n')
193+
194+packInteger :: Integer -> ByteString
195+packInteger 0 = "0"
196+packInteger n | n < 0 = error "packInteger"
197+packInteger n = unsafeCreate len go0
198+ where
199+ n' = fromIntegral n + 1 :: Double
200+ len = ceiling $ logBase 10 n'
201+ go0 p = go n $ p `plusPtr` (len - 1)
202+ go :: Integer -> Ptr Word8 -> IO ()
203+ go i p = do
204+ let (d,r) = i `divMod` 10
205+ poke p (48 + fromIntegral r)
206+ when (d /= 0) $ go d (p `plusPtr` (-1))
207+
181-- |
208-- |
182--
209--
183-- >>> addContentHeadersForFilePart [] (FilePart 2 10 16)
210-- >>> addContentHeadersForFilePart [] (FilePart 2 10 16)