{-# LANGUAGE CPP #-}
module Debian.Time where

import Data.Time
#if !MIN_VERSION_time(1,5,0)
import System.Locale (defaultTimeLocale)
#endif
import Data.Time.Clock.POSIX
import System.Posix.Types

-- * Time Helper Functions

rfc822DateFormat' :: String
rfc822DateFormat' :: String
rfc822DateFormat' = String
"%a, %d %b %Y %T %z"

epochTimeToUTCTime :: EpochTime -> UTCTime
epochTimeToUTCTime :: EpochTime -> UTCTime
epochTimeToUTCTime = POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (EpochTime -> POSIXTime) -> EpochTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> POSIXTime) -> (EpochTime -> Int) -> EpochTime -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochTime -> Int
forall a. Enum a => a -> Int
fromEnum

formatTimeRFC822 :: (FormatTime t) => t -> String
formatTimeRFC822 :: t -> String
formatTimeRFC822 = TimeLocale -> String -> t -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
rfc822DateFormat'

parseTimeRFC822 :: (ParseTime t) => String -> Maybe t
parseTimeRFC822 :: String -> Maybe t
parseTimeRFC822 = Bool -> TimeLocale -> String -> String -> Maybe t
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
rfc822DateFormat'

getCurrentLocalRFC822Time :: IO String
getCurrentLocalRFC822Time :: IO String
getCurrentLocalRFC822Time = IO UTCTime
getCurrentTime IO UTCTime -> (UTCTime -> IO ZonedTime) -> IO ZonedTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UTCTime -> IO ZonedTime
utcToLocalZonedTime IO ZonedTime -> (ZonedTime -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String)
-> (ZonedTime -> String) -> ZonedTime -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
rfc822DateFormat'