module Data.Time.W3C.Types
( W3CDateTime(..)
)
where
import Data.Convertible
import Data.Fixed
import Data.Time
import Data.Typeable
data W3CDateTime
= W3CDateTime {
w3cYear :: !Integer
, w3cMonth :: !(Maybe Int)
, w3cDay :: !(Maybe Int)
, w3cHour :: !(Maybe Int)
, w3cMinute :: !(Maybe Int)
, w3cSecond :: !(Maybe Pico)
, w3cTimeZone :: !(Maybe TimeZone)
}
deriving (Show, Eq, Typeable)
fetch :: (Show a, Typeable a, Typeable b) =>
String
-> (a -> Maybe b)
-> a
-> ConvertResult b
fetch name f a
= case f a of
Nothing -> convError ("No " ++ name ++ " information in the given value") a
Just b -> return b
instance Convertible W3CDateTime W3CDateTime where
safeConvert = return
instance Convertible Day W3CDateTime where
safeConvert day
= case toGregorian day of
(y, m, d) -> return W3CDateTime {
w3cYear = y
, w3cMonth = Just m
, w3cDay = Just d
, w3cHour = Nothing
, w3cMinute = Nothing
, w3cSecond = Nothing
, w3cTimeZone = Nothing
}
instance Convertible W3CDateTime Day where
safeConvert w3c
= do let y = w3cYear w3c
m <- fetch "month" w3cMonth w3c
d <- fetch "day" w3cDay w3c
return (fromGregorian y m d)
instance Convertible ZonedTime W3CDateTime where
safeConvert zt
= let lt = zonedTimeToLocalTime zt
tz = zonedTimeZone zt
ymd = localDay lt
hms = localTimeOfDay lt
in
return W3CDateTime {
w3cYear = case toGregorian ymd of (y, _, _) -> y
, w3cMonth = Just (case toGregorian ymd of (_, m, _) -> m)
, w3cDay = Just (case toGregorian ymd of (_, _, d) -> d)
, w3cHour = Just (todHour hms)
, w3cMinute = Just (todMin hms)
, w3cSecond = Just (todSec hms)
, w3cTimeZone = Just tz
}
instance Convertible W3CDateTime ZonedTime where
safeConvert w3c
= do day <- safeConvert w3c
tod <- do h <- fetch "hour" w3cHour w3c
m <- fetch "minute" w3cMinute w3c
s <- fetch "second" w3cSecond w3c
case makeTimeOfDayValid h m s of
Just tod -> return tod
Nothing -> convError "Invalid time of day" w3c
tz <- fetch "timezone" w3cTimeZone w3c
return ZonedTime {
zonedTimeToLocalTime = LocalTime day tod
, zonedTimeZone = tz
}