module Matterhorn.TimeUtils
    ( lookupLocalTimeZone
    , utcTimezone
    , startOfDay
    , justAfter, justBefore
    , asLocalTime
    , localTimeText
    , originTime
    )
where

import           Prelude ()
import           Matterhorn.Prelude

import qualified Control.Exception as E
import qualified Data.Text as T
import           Data.Time.Clock ( UTCTime(..) )
import           Data.Time.Format ( formatTime, defaultTimeLocale )
import           Data.Time.LocalTime ( LocalTime(..), TimeOfDay(..), utc )
import           Data.Time.LocalTime.TimeZone.Olson ( getTimeZoneSeriesFromOlsonFile )
import           Data.Time.LocalTime.TimeZone.Series ( TimeZoneSeries(..)
                                                     , localTimeToUTC'
                                                     , utcToLocalTime')

import           Network.Mattermost.Types ( ServerTime(..) )


-- | Get the timezone series that should be used for converting UTC
-- times into local times with appropriate DST adjustments.
lookupLocalTimeZone :: IO (Either E.SomeException TimeZoneSeries)
lookupLocalTimeZone :: IO (Either SomeException TimeZoneSeries)
lookupLocalTimeZone = IO TimeZoneSeries -> IO (Either SomeException TimeZoneSeries)
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO TimeZoneSeries -> IO (Either SomeException TimeZoneSeries))
-> IO TimeZoneSeries -> IO (Either SomeException TimeZoneSeries)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO TimeZoneSeries
getTimeZoneSeriesFromOlsonFile FilePath
"/etc/localtime"

utcTimezone :: TimeZoneSeries
utcTimezone :: TimeZoneSeries
utcTimezone = TimeZone -> [(UTCTime, TimeZone)] -> TimeZoneSeries
TimeZoneSeries TimeZone
utc []

-- | Sometimes it is convenient to render a divider between messages;
-- the 'justAfter' function can be used to get a time that is after
-- the input time but by such a small increment that there is unlikely
-- to be anything between (or at) the result.  Adding the divider
-- using this timestamp value allows the general sorting based on
-- timestamps to operate normally (whereas a type-match for a
-- non-timestamp-entry in the sort operation would be considerably
-- more complex).
justAfter :: ServerTime -> ServerTime
justAfter :: ServerTime -> ServerTime
justAfter = UTCTime -> ServerTime
ServerTime (UTCTime -> ServerTime)
-> (ServerTime -> UTCTime) -> ServerTime -> ServerTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> UTCTime
justAfterUTC (UTCTime -> UTCTime)
-> (ServerTime -> UTCTime) -> ServerTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerTime -> UTCTime
withServerTime
    where justAfterUTC :: UTCTime -> UTCTime
justAfterUTC UTCTime
time = let UTCTime Day
d DiffTime
t = UTCTime
time in Day -> DiffTime -> UTCTime
UTCTime Day
d (DiffTime -> DiffTime
forall a. Enum a => a -> a
succ DiffTime
t)

-- | Obtain a time value that is just moments before the input time;
-- see the comment for the 'justAfter' function for more details.
justBefore :: ServerTime -> ServerTime
justBefore :: ServerTime -> ServerTime
justBefore = UTCTime -> ServerTime
ServerTime (UTCTime -> ServerTime)
-> (ServerTime -> UTCTime) -> ServerTime -> ServerTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> UTCTime
justBeforeUTC (UTCTime -> UTCTime)
-> (ServerTime -> UTCTime) -> ServerTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerTime -> UTCTime
withServerTime
    where justBeforeUTC :: UTCTime -> UTCTime
justBeforeUTC UTCTime
time = let UTCTime Day
d DiffTime
t = UTCTime
time in Day -> DiffTime -> UTCTime
UTCTime Day
d (DiffTime -> DiffTime
forall a. Enum a => a -> a
pred DiffTime
t)

-- | The timestamp for the start of the day associated with the input
-- timestamp.  If timezone information is supplied, then the returned
-- value will correspond to when the day started in that timezone;
-- otherwise it is the start of the day in a timezone aligned with
-- UTC.
startOfDay :: Maybe TimeZoneSeries -> UTCTime -> UTCTime
startOfDay :: Maybe TimeZoneSeries -> UTCTime -> UTCTime
startOfDay Maybe TimeZoneSeries
Nothing UTCTime
time = let UTCTime Day
d DiffTime
_ = UTCTime
time in Day -> DiffTime -> UTCTime
UTCTime Day
d DiffTime
0
startOfDay (Just TimeZoneSeries
tz) UTCTime
time = let lt :: LocalTime
lt = TimeZoneSeries -> UTCTime -> LocalTime
utcToLocalTime' TimeZoneSeries
tz UTCTime
time
                                ls :: LocalTime
ls = Day -> TimeOfDay -> LocalTime
LocalTime (LocalTime -> Day
localDay LocalTime
lt) (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0)
                            in TimeZoneSeries -> LocalTime -> UTCTime
localTimeToUTC' TimeZoneSeries
tz LocalTime
ls

-- | Convert a UTC time value to a local time.
asLocalTime :: TimeZoneSeries -> UTCTime -> LocalTime
asLocalTime :: TimeZoneSeries -> UTCTime -> LocalTime
asLocalTime = TimeZoneSeries -> UTCTime -> LocalTime
utcToLocalTime'

-- | Local time in displayable format
localTimeText :: Text -> LocalTime -> Text
localTimeText :: Text -> LocalTime -> Text
localTimeText Text
fmt LocalTime
time = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> FilePath -> LocalTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale (Text -> FilePath
T.unpack Text
fmt) LocalTime
time

-- | Provides a time value that can be used when there are no other times available
originTime :: UTCTime
originTime :: UTCTime
originTime = Day -> DiffTime -> UTCTime
UTCTime (Int -> Day
forall a. Enum a => Int -> a
toEnum Int
0) DiffTime
0