{-# 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 :: a -> ByteString
packIntegral a
0 = ByteString
"0"
packIntegral a
n | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"packIntegral"
packIntegral a
n = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
len Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
go0
  where
    n' :: Double
n' = a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1 :: Double
    len :: Int
len = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
10 Double
n'
    go0 :: Ptr a -> IO ()
go0 Ptr a
p = a -> Ptr Word8 -> IO ()
forall a. Integral a => a -> Ptr Word8 -> IO ()
go a
n (Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr a
p Ptr a -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    go :: Integral a => a -> Ptr Word8 -> IO ()
    go :: a -> Ptr Word8 -> IO ()
go a
i Ptr Word8
p = do
        let (a
d,a
r) = a
i a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`divMod` a
10
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8
48 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r)
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> Ptr Word8 -> IO ()
forall a. Integral a => a -> Ptr Word8 -> IO ()
go a
d (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
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 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p               (Int -> Word8
toW8 Int
r2)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int -> Word8
toW8 Int
r1)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
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 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    !s :: Int
s = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Status -> Int
H.statusCode Status
status
    (!Int
q0,!Int
r0) = Int
s Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
10
    (!Int
q1,!Int
r1) = Int
q0 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
10
    !r2 :: Int
r2 = Int
q1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
10