{-# LANGUAGE OverloadedStrings, BangPatterns #-}

module Network.Wai.Handler.Warp.PackInt where

import Data.ByteString.Internal (unsafeCreate)
import Foreign.Ptr (Ptr, plusPtr)
import Foreign.Storable (poke)
import qualified Network.HTTP.Types as H

import Network.Wai.Handler.Warp.Imports

-- $setup
-- >>> import Data.ByteString.Char8 as C8
-- >>> import Test.QuickCheck (Large(..))

-- |
--
-- prop> packIntegral (abs n) == C8.pack (show (abs n))
-- prop> \(Large n) -> let n' = fromIntegral (abs n :: Int) in packIntegral n' == C8.pack (show n')

packIntegral :: Integral a => a -> ByteString
packIntegral :: forall a. Integral a => a -> ByteString
packIntegral a
0 = ByteString
"0"
packIntegral a
n | a
n forall a. Ord a => a -> a -> Bool
< a
0 = forall a. HasCallStack => [Char] -> a
error [Char]
"packIntegral"
packIntegral a
n = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
len forall {a}. Ptr a -> IO ()
go0
  where
    n' :: Double
n' = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n forall a. Num a => a -> a -> a
+ Double
1 :: Double
    len :: Int
len = forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall a b. (a -> b) -> a -> b
$ forall a. Floating a => a -> a -> a
logBase Double
10 Double
n'
    go0 :: Ptr a -> IO ()
go0 Ptr a
p = forall a. Integral a => a -> Ptr Word8 -> IO ()
go a
n forall a b. (a -> b) -> a -> b
$ Ptr a
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
len forall a. Num a => a -> a -> a
- Int
1)
    go :: Integral a => a -> Ptr Word8 -> IO ()
    go :: forall a. Integral a => a -> Ptr Word8 -> IO ()
go a
i Ptr Word8
p = do
        let (a
d,a
r) = a
i forall a. Integral a => a -> a -> (a, a)
`divMod` a
10
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8
48 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r)
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
d forall a. Eq a => a -> a -> Bool
/= a
0) forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Ptr Word8 -> IO ()
go a
d (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1))

{-# SPECIALIZE packIntegral :: Int -> ByteString #-}
{-# SPECIALIZE packIntegral :: Integer -> ByteString #-}

-- |
--
-- >>> packStatus H.status200
-- "200"
-- >>> packStatus H.preconditionFailed412
-- "412"

packStatus :: H.Status -> ByteString
packStatus :: Status -> ByteString
packStatus Status
status = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
3 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
    forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p               (Int -> Word8
toW8 Int
r2)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int -> Word8
toW8 Int
r1)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Int -> Word8
toW8 Int
r0)
  where
    toW8 :: Int -> Word8
    toW8 :: Int -> Word8
toW8 Int
n = Word8
48 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    !s :: Int
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Status -> Int
H.statusCode Status
status
    (!Int
q0,!Int
r0) = Int
s forall a. Integral a => a -> a -> (a, a)
`divMod` Int
10
    (!Int
q1,!Int
r1) = Int
q0 forall a. Integral a => a -> a -> (a, a)
`divMod` Int
10
    !r2 :: Int
r2 = Int
q1 forall a. Integral a => a -> a -> a
`mod` Int
10