{-# LANGUAGE OverloadedStrings #-}

module Network.HTTP.Date.Formatter (formatHTTPDate) where

import Data.ByteString.Char8 ()
import Data.ByteString.Internal
import Data.Word
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
import Network.HTTP.Date.Types

----------------------------------------------------------------

-- | Generating HTTP Date in RFC1123 style.
--
-- >>> formatHTTPDate defaultHTTPDate {hdYear = 1994, hdMonth = 11, hdDay = 15, hdHour = 8, hdMinute = 12, hdSecond = 31, hdWkday = 2}
-- "Tue, 15 Nov 1994 08:12:31 GMT"

formatHTTPDate :: HTTPDate -> ByteString
formatHTTPDate :: HTTPDate -> ByteString
formatHTTPDate hd :: HTTPDate
hd =
    Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate 29 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word8
ptr -> do
        Ptr Word8 -> ForeignPtr Word8 -> Int -> IO ()
cpy3 Ptr Word8
ptr ForeignPtr Word8
weekDays (3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w)
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`  3) Word8
comma
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`  4) Word8
spc
        Ptr Word8 -> Int -> IO ()
int2 (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`  5) Int
d
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`  7) Word8
spc
        Ptr Word8 -> ForeignPtr Word8 -> Int -> IO ()
cpy3 (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`  8) ForeignPtr Word8
months (3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m)
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 11) Word8
spc
        Ptr Word8 -> Int -> IO ()
int4 (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12) Int
y
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) Word8
spc
        Ptr Word8 -> Int -> IO ()
int2 (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 17) Int
h
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 19) Word8
colon
        Ptr Word8 -> Int -> IO ()
int2 (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20) Int
n
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 22) Word8
colon
        Ptr Word8 -> Int -> IO ()
int2 (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 23) Int
s
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 25) Word8
spc
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 26) (71 :: Word8)
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 27) (77 :: Word8)
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28) (84 :: Word8)
  where
    y :: Int
y = HTTPDate -> Int
hdYear HTTPDate
hd
    m :: Int
m = HTTPDate -> Int
hdMonth HTTPDate
hd
    d :: Int
d = HTTPDate -> Int
hdDay HTTPDate
hd
    h :: Int
h = HTTPDate -> Int
hdHour HTTPDate
hd
    n :: Int
n = HTTPDate -> Int
hdMinute HTTPDate
hd
    s :: Int
s = HTTPDate -> Int
hdSecond HTTPDate
hd
    w :: Int
w = HTTPDate -> Int
hdWkday HTTPDate
hd
    cpy3 :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO ()
    cpy3 :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO ()
cpy3 ptr :: Ptr Word8
ptr p :: ForeignPtr Word8
p o :: Int
o = ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
p ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \fp :: Ptr Word8
fp ->
      Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
ptr (Ptr Word8
fp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o) 3

----------------------------------------------------------------

int2 :: Ptr Word8 -> Int -> IO ()
int2 :: Ptr Word8 -> Int -> IO ()
int2 ptr :: Ptr Word8
ptr n :: Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 10 = do
      Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
zero
      Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) (Int -> Word8
i2w8 Int
n)
  | Bool
otherwise = do
      Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr               (Int -> Word8
i2w8 (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` 10))
      Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) (Int -> Word8
i2w8 (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` 10))

int4 :: Ptr Word8 -> Int -> IO ()
int4 :: Ptr Word8 -> Int -> IO ()
int4 ptr :: Ptr Word8
ptr n0 :: Int
n0 = do
    let (n1 :: Int
n1,x1 :: Int
x1) = Int
n0 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 10
        (n2 :: Int
n2,x2 :: Int
x2) = Int
n1 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 10
        (x4 :: Int
x4,x3 :: Int
x3) = Int
n2 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 10
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr               (Int -> Word8
i2w8 Int
x4)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) (Int -> Word8
i2w8 Int
x3)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 2) (Int -> Word8
i2w8 Int
x2)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 3) (Int -> Word8
i2w8 Int
x1)

i2w8 :: Int -> Word8
i2w8 :: Int -> Word8
i2w8 n :: Int
n = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
zero

----------------------------------------------------------------

months :: ForeignPtr Word8
months :: ForeignPtr Word8
months = let (PS p :: ForeignPtr Word8
p _ _) = "___JanFebMarAprMayJunJulAugSepOctNovDec" in ForeignPtr Word8
p

weekDays :: ForeignPtr Word8
weekDays :: ForeignPtr Word8
weekDays = let (PS p :: ForeignPtr Word8
p _ _) = "___MonTueWedThuFriSatSun" in ForeignPtr Word8
p

----------------------------------------------------------------

spc :: Word8
spc :: Word8
spc = 32

comma :: Word8
comma :: Word8
comma = 44

colon :: Word8
colon :: Word8
colon = 58

zero :: Word8
zero :: Word8
zero = 48