```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

-- | The number of minutes that this timezone is offset from UTC. Can
-- be positive, negative, or zero.
newtype TimeZoneOffset = TimeZoneOffset { offsetToMins :: Int }
deriving (Eq, Ord, Show)

-- | Convert minutes to a time zone offset. I'm having a hard time
-- deciding whether to be liberal or strict in what to accept
-- here. Currently it is somewhat strict in that it will fail if
-- absolute value is greater than 840 minutes; currently the article
-- at http://en.wikipedia.org/wiki/List_of_time_zones_by_UTC_offset
-- says there is no offset greater than 14 hours, or 840 minutes.
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)

-- | succeeds if 0 <= x < 24
intToHours :: Int -> Maybe Hours
intToHours h =
if h >= 0 && h < 24 then Just . Hours \$ h else Nothing

zeroHours :: Hours
zeroHours = Hours 0

-- | succeeds if 0 <= x < 60
intToMinutes :: Int -> Maybe Minutes
intToMinutes m =
if m >= 0 && m < 60 then Just . Minutes \$ m else Nothing

zeroMinutes :: Minutes
zeroMinutes = Minutes 0

-- | succeeds if 0 <= x < 61 (to allow for leap seconds)
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)

-- | A DateTime is a a local date and time, along with a time zone
-- offset.  The Eq and Ord instances are derived; therefore, two
-- DateTime instances will not be equivalent if the time zone offsets
-- are different, even if they are the same instant. To compare one
-- DateTime to another, you probably want to use 'toUTC' and compare
-- those. To see if two DateTime are the same instant, use
-- 'sameInstant'.
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

-- | Are these DateTimes the same instant in time, after adjusting for
-- local timezones?

sameInstant :: DateTime -> DateTime -> Bool
sameInstant t1 t2 = toUTC t1 == toUTC t2

-- | Shows a DateTime in a pretty way.
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 "+"