@@ -7,14 +7,19 @@ module Network.Wai.Handler.Warp.File (
77 , conditionalRequest
88 , addContentHeadersForFilePart
99 , parseByteRanges
10+ , packInteger -- testing
1011 ) where
1112
1213import Control.Applicative ((<|>))
14+import Control.Monad
1315import Data.Array ((!))
14−import Data.ByteString (ByteString)
1516import qualified Data.ByteString as B hiding (pack)
1617import qualified Data.ByteString.Char8 as B (pack, readInteger)
18+import Data.ByteString.Internal (ByteString(..), unsafeCreate)
1719import Data.Maybe (fromMaybe)
20+import Data.Word8 (Word8)
21+import Foreign.Ptr (Ptr, plusPtr)
22+import Foreign.Storable (poke)
1823import Network.HTTP.Date
1924import qualified Network.HTTP.Types as H
2025import qualified Network.HTTP.Types.Header as H
@@ -27,6 +32,9 @@ import Numeric (showInt)
2732#define MIN_VERSION_http_types(x,y,z) 1
2833#endif
2934
35+-- $setup
36+-- >>> import Test.QuickCheck
37+
3038----------------------------------------------------------------
3139
3240data RspFileInfo = WithoutBody H.Status
@@ -175,9 +183,28 @@ addContentHeaders hs off len size
175183 | otherwise = let !ctrng = contentRangeHeader off (off + len - 1) size
176184 in ctrng:hs'
177185 where
178− !lengthBS = B.pack $ show len -- fixme
186+ !lengthBS = packInteger len
179187 !hs' = (H.hContentLength, lengthBS) : (acceptRange,"bytes") : hs
180188
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+
181208-- |
182209--
183210-- >>> addContentHeadersForFilePart [] (FilePart 2 10 16)