{-# 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 HTTPDate
hd =
    Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
29 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
        Ptr Word8 -> ForeignPtr Word8 -> Int -> IO ()
cpy3 Ptr Word8
ptr ForeignPtr Word8
weekDays (Int
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`  Int
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`  Int
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`  Int
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`  Int
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`  Int
8) ForeignPtr Word8
months (Int
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` Int
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` Int
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` Int
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` Int
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` Int
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` Int
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` Int
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` Int
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` Int
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` Int
26) (Word8
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` Int
27) (Word8
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` Int
28) (Word8
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 Word8
ptr ForeignPtr Word8
p 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
$ \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) Int
3

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

int2 :: Ptr Word8 -> Int -> IO ()
int2 :: Ptr Word8 -> Int -> IO ()
int2 Ptr Word8
ptr Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
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` Int
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` Int
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` Int
1) (Int -> Word8
i2w8 (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
10))

int4 :: Ptr Word8 -> Int -> IO ()
int4 :: Ptr Word8 -> Int -> IO ()
int4 Ptr Word8
ptr Int
n0 = do
    let (Int
n1,Int
x1) = Int
n0 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
        (Int
n2,Int
x2) = Int
n1 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
        (Int
x4,Int
x3) = Int
n2 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
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` Int
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` Int
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` Int
3) (Int -> Word8
i2w8 Int
x1)

i2w8 :: Int -> Word8
i2w8 :: Int -> Word8
i2w8 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 ForeignPtr Word8
p Int
_ Int
_) = ByteString
"___JanFebMarAprMayJunJulAugSepOctNovDec" in ForeignPtr Word8
p

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

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

spc :: Word8
spc :: Word8
spc = Word8
32

comma :: Word8
comma :: Word8
comma = Word8
44

colon :: Word8
colon :: Word8
colon = Word8
58

zero :: Word8
zero :: Word8
zero = Word8
48