module Penny.Lincoln.Bits.DateTime
( TimeZoneOffset ( offsetToMins )
, minsToOffset
, noOffset
, Hours ( unHours )
, intToHours
, zeroHours
, Minutes ( unMinutes )
, intToMinutes
, zeroMinutes
, Seconds ( unSeconds )
, intToSeconds
, zeroSeconds
, midnight
, DateTime ( .. )
, dateTimeMidnightUTC
, toUTC
, toZonedTime
, fromZonedTime
, sameInstant
, showDateTime
) where
import qualified Data.Time as T
newtype TimeZoneOffset = TimeZoneOffset { offsetToMins :: Int }
deriving (Eq, Ord, Show)
minsToOffset :: Int -> Maybe TimeZoneOffset
minsToOffset m = if abs m > 840
then Nothing
else Just $ TimeZoneOffset m
noOffset :: TimeZoneOffset
noOffset = TimeZoneOffset 0
newtype Hours = Hours { unHours :: Int }
deriving (Eq, Ord, Show)
newtype Minutes = Minutes { unMinutes :: Int }
deriving (Eq, Ord, Show)
newtype Seconds = Seconds { unSeconds :: Int }
deriving (Eq, Ord, Show)
intToHours :: Int -> Maybe Hours
intToHours h =
if h >= 0 && h < 24 then Just . Hours $ h else Nothing
zeroHours :: Hours
zeroHours = Hours 0
intToMinutes :: Int -> Maybe Minutes
intToMinutes m =
if m >= 0 && m < 60 then Just . Minutes $ m else Nothing
zeroMinutes :: Minutes
zeroMinutes = Minutes 0
intToSeconds :: Int -> Maybe Seconds
intToSeconds s =
if s >= 0 && s < 61
then Just . Seconds $ s
else Nothing
zeroSeconds :: Seconds
zeroSeconds = Seconds 0
midnight :: (Hours, Minutes, Seconds)
midnight = (zeroHours, zeroMinutes, zeroSeconds)
data DateTime = DateTime
{ day :: T.Day
, hours :: Hours
, minutes :: Minutes
, seconds :: Seconds
, timeZone :: TimeZoneOffset
} deriving (Eq, Ord, Show)
dateTimeMidnightUTC :: T.Day -> DateTime
dateTimeMidnightUTC d = DateTime d h m s z
where
(h, m, s) = midnight
z = noOffset
toZonedTime :: DateTime -> T.ZonedTime
toZonedTime dt = T.ZonedTime lt tz
where
d = day dt
lt = T.LocalTime d tod
tod = T.TimeOfDay (unHours . hours $ dt) (unMinutes . minutes $ dt)
(fromIntegral . unSeconds . seconds $ dt)
tz = T.TimeZone (offsetToMins . timeZone $ dt) False ""
fromZonedTime :: T.ZonedTime -> Maybe DateTime
fromZonedTime (T.ZonedTime (T.LocalTime d tod) tz) = do
h <- intToHours . T.todHour $ tod
m <- intToMinutes . T.todMin $ tod
let (sWhole, _) = properFraction . T.todSec $ tod
s <- intToSeconds sWhole
tzo <- minsToOffset . T.timeZoneMinutes $ tz
return $ DateTime d h m s tzo
toUTC :: DateTime -> T.UTCTime
toUTC dt = T.localTimeToUTC tz lt
where
tz = T.minutesToTimeZone . offsetToMins . timeZone $ dt
tod = T.TimeOfDay (unHours h) (unMinutes m)
(fromIntegral . unSeconds $ s)
DateTime d h m s _ = dt
lt = T.LocalTime d tod
sameInstant :: DateTime -> DateTime -> Bool
sameInstant t1 t2 = toUTC t1 == toUTC t2
showDateTime :: DateTime -> String
showDateTime (DateTime d h m s tz) =
ds ++ " " ++ hmss ++ " " ++ showOffset
where
ds = show d
hmss = hs ++ ":" ++ ms ++ ":" ++ ss
hs = pad0 . show . unHours $ h
ms = pad0 . show . unMinutes $ m
ss = pad0 . show . unSeconds $ s
pad0 str = if length str < 2 then '0':str else str
showOffset =
let (zoneHr, zoneMin) = abs (offsetToMins tz) `divMod` 60
sign = if offsetToMins tz < 0 then "-" else "+"
in sign ++ pad0 (show zoneHr) ++ pad0 (show zoneMin)