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

-- Copyright     : Erik de Castro Lopo <erikd@mega-nerd.com>
-- License       : BSD3

module Network.Wai.Handler.Warp.ReadInt (
    readInt
  , readInt64
  ) where

-- This function lives in its own file because the MagicHash pragma interacts
-- poorly with the CPP pragma.

import qualified Data.ByteString as S
import GHC.Prim
import GHC.Types
import GHC.Word

import Network.Wai.Handler.Warp.Imports hiding (readInt)

{-# INLINE readInt #-}
readInt :: Integral a => ByteString -> a
readInt :: ByteString -> a
readInt ByteString
bs = Int64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> a) -> Int64 -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
readInt64 ByteString
bs

-- This function is used to parse the Content-Length field of HTTP headers and
-- is a performance hot spot. It should only be replaced with something
-- significantly and provably faster.
--
-- It needs to be able work correctly on 32 bit CPUs for file sizes > 2G so we
-- use Int64 here and then make a generic 'readInt' that allows conversion to
-- Int and Integer.

{-# NOINLINE readInt64 #-}
readInt64 :: ByteString -> Int64
readInt64 :: ByteString -> Int64
readInt64 ByteString
bs = (Int64 -> Word8 -> Int64) -> Int64 -> ByteString -> Int64
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
S.foldl' (\ !Int64
i !Word8
c -> Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int
mhDigitToInt Word8
c)) Int64
0
             (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
S.takeWhile Word8 -> Bool
isDigit ByteString
bs

data Table = Table !Addr#

{-# NOINLINE mhDigitToInt #-}
mhDigitToInt :: Word8 -> Int
mhDigitToInt :: Word8 -> Int
mhDigitToInt (W8# Word#
i) = Int# -> Int
I# (Word# -> Int#
word2Int# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
addr (Word# -> Int#
word2Int# Word#
i)))
  where
    !(Table Addr#
addr) = Table
table
    table :: Table
    table :: Table
table = Addr# -> Table
Table
        Addr#
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
        \\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x00\x00\x00\x00\x00\x00\
        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#

isDigit :: Word8 -> Bool
isDigit :: Word8 -> Bool
isDigit Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57