{-# LANGUAGE BangPatterns #-}
module Network.HTTP.Date.Converter ( epochTimeToHTTPDate
                                   , httpDateToUTC
                                   , utcToHTTPDate
                                   ) where

import Data.Time
import Data.Time.Calendar.WeekDate
import Data.Word
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import Network.HTTP.Date.Types
import System.IO.Unsafe (unsafeDupablePerformIO, unsafePerformIO)
import System.Posix.Types

{-|
  Translating 'EpochTime' to 'HTTPDate'.
-}
epochTimeToHTTPDate :: EpochTime -> HTTPDate
epochTimeToHTTPDate :: EpochTime -> HTTPDate
epochTimeToHTTPDate EpochTime
x = HTTPDate
defaultHTTPDate {
    hdYear :: Int
hdYear   = Int
y
  , hdMonth :: Int
hdMonth  = Int
m
  , hdDay :: Int
hdDay    = Int
d
  , hdHour :: Int
hdHour   = Int
h
  , hdMinute :: Int
hdMinute = Int
n
  , hdSecond :: Int
hdSecond = Int
s
  , hdWkday :: Int
hdWkday  = Int
w
  }
  where
    w64 :: Word64
    w64 :: Word64
w64 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum EpochTime
x
    (Word64
days',Word64
secs') = Word64
w64 forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
86400
    days :: Int
days = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
days'
    secs :: Int
secs = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
secs'
    -- 1970/1/1 is Thu (4)
    w :: Int
w = (Int
days forall a. Num a => a -> a -> a
+ Int
3) forall a. Integral a => a -> a -> a
`rem` Int
7 forall a. Num a => a -> a -> a
+ Int
1
    (Int
y,Int
m,Int
d) = Int -> (Int, Int, Int)
toYYMMDD Int
days
    (Int
h,Int
n,Int
s) = Int -> (Int, Int, Int)
toHHMMSS Int
secs

-- | Translating 'HTTPDate' to 'UTCTime'.
--
--   Since 0.0.7.
httpDateToUTC :: HTTPDate -> UTCTime
httpDateToUTC :: HTTPDate -> UTCTime
httpDateToUTC HTTPDate
x = Day -> DiffTime -> UTCTime
UTCTime (Year -> Int -> Int -> Day
fromGregorian Year
y Int
m Int
d) (Year -> DiffTime
secondsToDiffTime Year
s)
  where
    y :: Year
y = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ HTTPDate -> Int
hdYear HTTPDate
x
    m :: Int
m = HTTPDate -> Int
hdMonth HTTPDate
x
    d :: Int
d = HTTPDate -> Int
hdDay HTTPDate
x
    s :: Year
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (HTTPDate -> Int
hdHour   HTTPDate
x forall a. Integral a => a -> a -> a
`rem` Int
24) forall a. Num a => a -> a -> a
* Int
3600
                     forall a. Num a => a -> a -> a
+ (HTTPDate -> Int
hdMinute HTTPDate
x forall a. Integral a => a -> a -> a
`rem` Int
60) forall a. Num a => a -> a -> a
* Int
60
                     forall a. Num a => a -> a -> a
+ (HTTPDate -> Int
hdSecond HTTPDate
x forall a. Integral a => a -> a -> a
`rem` Int
60)

-- | Translating 'UTCTime' to 'HTTPDate'.
--
--   Since 0.0.7.
utcToHTTPDate :: UTCTime -> HTTPDate
utcToHTTPDate :: UTCTime -> HTTPDate
utcToHTTPDate UTCTime
x = HTTPDate
defaultHTTPDate {
    hdYear :: Int
hdYear   = forall a b. (Integral a, Num b) => a -> b
fromIntegral Year
y
  , hdMonth :: Int
hdMonth  = Int
m
  , hdDay :: Int
hdDay    = Int
d
  , hdHour :: Int
hdHour   = Int
h
  , hdMinute :: Int
hdMinute = Int
n
  , hdSecond :: Int
hdSecond = forall a b. (RealFrac a, Integral b) => a -> b
truncate Pico
s
  , hdWkday :: Int
hdWkday  = forall a. Enum a => a -> Int
fromEnum (Int
w :: Int)
  }
  where
    (Year
y, Int
m, Int
d) = Day -> (Year, Int, Int)
toGregorian Day
day
    (Int
h, Int
n, Pico
s) = ((TimeOfDay -> Int
todHour TimeOfDay
tod), (TimeOfDay -> Int
todMin TimeOfDay
tod), (TimeOfDay -> Pico
todSec TimeOfDay
tod))
    (Year
_, Int
_, Int
w) = Day -> (Year, Int, Int)
toWeekDate Day
day
    day :: Day
day       = LocalTime -> Day
localDay LocalTime
time
    tod :: TimeOfDay
tod       = LocalTime -> TimeOfDay
localTimeOfDay LocalTime
time
    time :: LocalTime
time      = TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc UTCTime
x

toYYMMDD :: Int -> (Int,Int,Int)
toYYMMDD :: Int -> (Int, Int, Int)
toYYMMDD Int
x = (Int
yy, Int
mm, Int
dd)
  where
    (Int
y,Int
d) = Int
x forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
365
    cy :: Int
cy = Int
1970 forall a. Num a => a -> a -> a
+ Int
y
    cy' :: Int
cy' = Int
cy forall a. Num a => a -> a -> a
- Int
1
    leap :: Int
leap = Int
cy' forall a. Integral a => a -> a -> a
`quot` Int
4 forall a. Num a => a -> a -> a
- Int
cy' forall a. Integral a => a -> a -> a
`quot` Int
100 forall a. Num a => a -> a -> a
+ Int
cy' forall a. Integral a => a -> a -> a
`quot` Int
400 forall a. Num a => a -> a -> a
- Int
477
    (Int
yy,Int
days) = forall {t} {a}. (Integral t, Num a, Ord a) => t -> a -> a -> (t, a)
adjust Int
cy Int
d Int
leap
    (Int
mm,Int
dd) = Int -> (Int, Int)
findMonth Int
days
    adjust :: t -> a -> a -> (t, a)
adjust !t
ty a
td a
aj
      | a
td forall a. Ord a => a -> a -> Bool
>= a
aj        = (t
ty, a
td forall a. Num a => a -> a -> a
- a
aj)
      | forall {a}. Integral a => a -> Bool
isLeap (t
ty forall a. Num a => a -> a -> a
- t
1) = if a
td forall a. Num a => a -> a -> a
+ a
366 forall a. Ord a => a -> a -> Bool
>= a
aj
                          then (t
ty forall a. Num a => a -> a -> a
- t
1, a
td forall a. Num a => a -> a -> a
+ a
366 forall a. Num a => a -> a -> a
- a
aj)
                          else t -> a -> a -> (t, a)
adjust (t
ty forall a. Num a => a -> a -> a
- t
1) (a
td forall a. Num a => a -> a -> a
+ a
366) a
aj
      | Bool
otherwise       = if a
td forall a. Num a => a -> a -> a
+ a
365 forall a. Ord a => a -> a -> Bool
>= a
aj
                          then (t
ty forall a. Num a => a -> a -> a
- t
1, a
td forall a. Num a => a -> a -> a
+ a
365 forall a. Num a => a -> a -> a
- a
aj)
                          else t -> a -> a -> (t, a)
adjust (t
ty forall a. Num a => a -> a -> a
- t
1) (a
td forall a. Num a => a -> a -> a
+ a
365) a
aj
    isLeap :: a -> Bool
isLeap a
year = a
year forall a. Integral a => a -> a -> a
`rem` a
4 forall a. Eq a => a -> a -> Bool
== a
0
              Bool -> Bool -> Bool
&& (a
year forall a. Integral a => a -> a -> a
`rem` a
400 forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
||
                  a
year forall a. Integral a => a -> a -> a
`rem` a
100 forall a. Eq a => a -> a -> Bool
/= a
0)
    (Ptr Int
mnths, Ptr Int
daysArr) = if forall {a}. Integral a => a -> Bool
isLeap Int
yy
      then (Ptr Int
leapMonth, Ptr Int
leapDayInMonth)
      else (Ptr Int
normalMonth, Ptr Int
normalDayInMonth)
    findMonth :: Int -> (Int, Int)
findMonth Int
n = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int
mnths Int
n) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int
daysArr Int
n)

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

normalMonthDays :: [Int]
normalMonthDays :: [Int]
normalMonthDays = [Int
31,Int
28,Int
31,Int
30,Int
31,Int
30,Int
31,Int
31,Int
30,Int
31,Int
30,Int
31]

leapMonthDays :: [Int]
leapMonthDays :: [Int]
leapMonthDays   = [Int
31,Int
29,Int
31,Int
30,Int
31,Int
30,Int
31,Int
31,Int
30,Int
31,Int
30,Int
31]

mkPtrInt :: [Int] -> Ptr Int
mkPtrInt :: [Int] -> Ptr Int
mkPtrInt = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => [a] -> IO (Ptr a)
newArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Int -> a -> [a]
replicate) [Int
1..]

mkPtrInt2 :: [Int] -> Ptr Int
mkPtrInt2 :: [Int] -> Ptr Int
mkPtrInt2 = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => [a] -> IO (Ptr a)
newArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Enum a => a -> a -> [a]
enumFromTo Int
1)

normalMonth :: Ptr Int
normalMonth :: Ptr Int
normalMonth = [Int] -> Ptr Int
mkPtrInt [Int]
normalMonthDays

normalDayInMonth :: Ptr Int
normalDayInMonth :: Ptr Int
normalDayInMonth = [Int] -> Ptr Int
mkPtrInt2 [Int]
normalMonthDays

leapMonth :: Ptr Int
leapMonth :: Ptr Int
leapMonth = [Int] -> Ptr Int
mkPtrInt [Int]
leapMonthDays

leapDayInMonth :: Ptr Int
leapDayInMonth :: Ptr Int
leapDayInMonth = [Int] -> Ptr Int
mkPtrInt2 [Int]
leapMonthDays

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

toHHMMSS :: Int -> (Int,Int,Int)
toHHMMSS :: Int -> (Int, Int, Int)
toHHMMSS Int
x = (Int
hh,Int
mm,Int
ss)
  where
    (Int
hhmm,Int
ss) = Int
x forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
60
    (Int
hh,Int
mm) = Int
hhmm forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
60