    {-# 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   = y
      , hdMonth  = m
      , hdDay    = d
      , hdHour   = h
      , hdMinute = n
      , hdSecond = s
      , hdWkday  = w
      }
      where
        w64 :: Word64
        w64 :: Word64
    w64 = Int -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word64) -> Int -> Word64
    forall a b. (a -> b) -> a -> b
    $ EpochTime -> Int
    forall a. Enum a => a -> Int
    fromEnum EpochTime
    x
        (Word64
    days',Word64
    secs') = Word64
    w64 Word64 -> Word64 -> (Word64, Word64)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Word64
    86400
        days :: Int
    days = Word64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word64
    days'
        secs :: Int
    secs = Word64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word64
    secs'
        -- 1970/1/1 is Thu (4)
        w :: Int
    w = (Int
    days Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `rem` Int
    7 Int -> Int -> Int
    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 = Int -> Year
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Year) -> Int -> Year
    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 = Int -> Year
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Year) -> Int -> Year
    forall a b. (a -> b) -> a -> b
    $ (HTTPDate -> Int
    hdHour   HTTPDate
    x Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `rem` Int
    24) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3600
                         Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (HTTPDate -> Int
    hdMinute HTTPDate
    x Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `rem` Int
    60) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    60
                         Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (HTTPDate -> Int
    hdSecond HTTPDate
    x Int -> Int -> Int
    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   = fromIntegral y
      , hdMonth  = m
      , hdDay    = d
      , hdHour   = h
      , hdMinute = n
      , hdSecond = truncate s
      , hdWkday  = fromEnum (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 Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Int
    365
        cy :: Int
    cy = Int
    1970 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y
        cy' :: Int
    cy' = Int
    cy Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
        leap :: Int
    leap = Int
    cy' Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `quot` Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    cy' Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `quot` Int
    100 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    cy' Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `quot` Int
    400 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    477
        (Int
    yy,Int
    days) = Int -> Int -> Int -> (Int, Int)
    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 a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    aj        = (t
    ty, a
    td a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    aj)
          | t -> Bool
    forall {a}. Integral a => a -> Bool
    isLeap (t
    ty t -> t -> t
    forall a. Num a => a -> a -> a
    - t
    1) = if a
    td a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    366 a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    aj
                              then (t
    ty t -> t -> t
    forall a. Num a => a -> a -> a
    - t
    1, a
    td a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    366 a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    aj)
                              else t -> a -> a -> (t, a)
    adjust (t
    ty t -> t -> t
    forall a. Num a => a -> a -> a
    - t
    1) (a
    td a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    366) a
    aj
          | Bool
    otherwise       = if a
    td a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    365 a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    aj
                              then (t
    ty t -> t -> t
    forall a. Num a => a -> a -> a
    - t
    1, a
    td a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    365 a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    aj)
                              else t -> a -> a -> (t, a)
    adjust (t
    ty t -> t -> t
    forall a. Num a => a -> a -> a
    - t
    1) (a
    td a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    365) a
    aj
        isLeap :: a -> Bool
    isLeap a
    year = a
    year a -> a -> a
    forall a. Integral a => a -> a -> a
    `rem` a
    4 a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0
                  Bool -> Bool -> Bool
    && (a
    year a -> a -> a
    forall a. Integral a => a -> a -> a
    `rem` a
    400 a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0 Bool -> Bool -> Bool
    ||
                      a
    year a -> a -> a
    forall a. Integral a => a -> a -> a
    `rem` a
    100 a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    0)
        (Ptr Int
    mnths, Ptr Int
    daysArr) = if Int -> Bool
    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 = IO (Int, Int) -> (Int, Int)
    forall a. IO a -> a
    unsafeDupablePerformIO (IO (Int, Int) -> (Int, Int)) -> IO (Int, Int) -> (Int, Int)
    forall a b. (a -> b) -> a -> b
    $ (,) (Int -> Int -> (Int, Int)) -> IO Int -> IO (Int -> (Int, Int))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Ptr Int -> Int -> IO Int
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Int
    mnths Int
    n) IO (Int -> (Int, Int)) -> IO Int -> IO (Int, Int)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Ptr Int -> Int -> IO Int
    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 = IO (Ptr Int) -> Ptr Int
    forall a. IO a -> a
    unsafePerformIO (IO (Ptr Int) -> Ptr Int)
    -> ([Int] -> IO (Ptr Int)) -> [Int] -> Ptr Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> IO (Ptr Int)
    forall a. Storable a => [a] -> IO (Ptr a)
    newArray ([Int] -> IO (Ptr Int))
    -> ([Int] -> [Int]) -> [Int] -> IO (Ptr Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Int]] -> [Int]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Int]] -> [Int]) -> ([Int] -> [[Int]]) -> [Int] -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Int -> [Int]) -> [Int] -> [Int] -> [[Int]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith ((Int -> Int -> [Int]) -> Int -> Int -> [Int]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Int -> Int -> [Int]
    forall a. Int -> a -> [a]
    replicate) [Int
    1..]

    mkPtrInt2 :: [Int] -> Ptr Int
    mkPtrInt2 :: [Int] -> Ptr Int
    mkPtrInt2 = IO (Ptr Int) -> Ptr Int
    forall a. IO a -> a
    unsafePerformIO (IO (Ptr Int) -> Ptr Int)
    -> ([Int] -> IO (Ptr Int)) -> [Int] -> Ptr Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> IO (Ptr Int)
    forall a. Storable a => [a] -> IO (Ptr a)
    newArray ([Int] -> IO (Ptr Int))
    -> ([Int] -> [Int]) -> [Int] -> IO (Ptr Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> [Int]) -> [Int] -> [Int]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Int -> Int -> [Int]
    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 Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Int
    60
        (Int
    hh,Int
    mm) = Int
    hhmm Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Int
    60