{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

module Network.Wai.Handler.Warp.PackInt where

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

import Network.Wai.Handler.Warp.Imports

packIntegral :: Integral a => a -> ByteString
packIntegral :: forall a. Integral a => 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
    -- Counted by division: @ceiling (logBase 10 ...)@ in a 'Double' is
    -- one short from 10^15 up, and 'go' then writes its last digit
    -- before the buffer it was given.
    !len :: Int
len = a -> Int
forall a. Integral a => a -> Int
numDigits a
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 :: forall a. Integral a => 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
_0 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 #-}

-- | How many digits a non-negative number is written with.
numDigits :: Integral a => a -> Int
numDigits :: forall a. Integral a => a -> Int
numDigits = Int -> a -> Int
forall {t} {t}. (Integral t, Num t) => t -> t -> t
go Int
1
  where
    go :: t -> t -> t
go !t
acc t
i = case t
i t -> t -> t
forall a. Integral a => a -> a -> a
`quot` t
10 of
        t
0 -> t
acc
        t
q -> t -> t -> t
go (t
acc t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) t
q
{-# SPECIALIZE numDigits :: Int -> Int #-}
{-# SPECIALIZE numDigits :: Integer -> Int #-}

-- |
--
-- >>> 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
_0 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