module Data.JSON2.Instances.Time where
import Data.JSON2
import Data.JSON2.Internal
import Data.Time
import Data.Time.Clock.POSIX(POSIXTime)
import System.Locale (iso8601DateFormat, defaultTimeLocale)
fmtYear x = JString $ formatTime defaultTimeLocale "%Y" x
fmtMonth x = JString $ formatTime defaultTimeLocale "%m" x
fmtDay x = JString $ formatTime defaultTimeLocale "%d" x
fmtHour x = JString $ formatTime defaultTimeLocale "%H" x
fmtMin x = JString $ formatTime defaultTimeLocale "%M" x
fmtSec x = JString $ formatTime defaultTimeLocale "%S" x
fmtPico x = JString $ formatTime defaultTimeLocale "%Q" x
fmtZone x = JString $ formatTime defaultTimeLocale "%Z" x
instance ToJson ZonedTime where
toJson x = toJson [ fmtYear x, fmtMonth x, fmtDay x
, fmtHour x, fmtMin x, fmtSec x
, fmtPico x
, fmtZone x
]
fmtZT = "%Y-%m-%d %T%Q %Z"
instance FromJson ZonedTime where
safeFromJson js@(JArray [ JString y, JString mon, JString d
, JString h, JString m, JString s
, JString p, JString z
]
) = case (parseTime defaultTimeLocale fmtZT zt) of
Just t -> return t
Nothing -> mkError' ("No parse format: " ++ fmtZT) js
where zt = concat [ y, "-", mon, "-", d
, " ", h, ":", m, ":", s
, p, " ", z
]
safeFromJson x = mkError x
instance ToJson Day where
toJson x = toJson [ fmtYear x, fmtMonth x, fmtDay x]
fmtDayT = "%Y-%m-%d"
instance FromJson Day where
safeFromJson js@(JArray [ JString y, JString mon, JString d]) =
case (parseTime defaultTimeLocale fmtDayT dt) of
Just t -> return t
Nothing -> mkError' ("No parse format: " ++ fmtDayT) js
where dt = concat [ y, "-", mon, "-", d]
safeFromJson x = mkError x
instance ToJson TimeOfDay where
toJson x = toJson [fmtHour x, fmtMin x, fmtSec x, fmtPico x]
fmtTD = "%T%Q"
instance FromJson TimeOfDay where
safeFromJson js@(JArray [JString h, JString m, JString s, JString p]) =
case (parseTime defaultTimeLocale fmtTD td) of
Just t -> return t
Nothing -> mkError' ("No parse format: " ++ fmtTD) js
where td = concat [h, ":", m, ":", s, p]
safeFromJson x = mkError x
instance ToJson TimeZone where
toJson tz = fmtZone tz
instance FromJson TimeZone where
safeFromJson js@(JString tz) = case parseTime defaultTimeLocale "%Z" tz of
Just t -> return t
Nothing -> mkError' "No parse format: %Z" js
safeFromJson x = mkError x
instance ToJson LocalTime where
toJson x = toJson [ fmtYear x, fmtMonth x, fmtDay x
, fmtHour x, fmtMin x, fmtSec x
, fmtPico x
]
fmtLT = "%Y-%m-%d %T%Q"
instance FromJson LocalTime where
safeFromJson js@(JArray [ JString y, JString mon, JString d
, JString h, JString m, JString s
, JString p
]
) = case (parseTime defaultTimeLocale fmtLT zt) of
Just t -> return t
Nothing -> mkError' ("No parse format: " ++ fmtLT) js
where zt = concat [ y, "-", mon, "-", d
, " ", h, ":", m, ":", s , p
]
safeFromJson x = mkError x
instance ToJson UTCTime where
toJson x = toJson [ fmtYear x, fmtMonth x, fmtDay x
, fmtHour x, fmtMin x, fmtSec x
, fmtPico x
, fmtZone x
]
fmtUTC = "%Y-%m-%d %T%Q %Z"
instance FromJson UTCTime where
safeFromJson js@(JArray [ JString y, JString mon, JString d
, JString h, JString m, JString s
, JString p, JString z
]
) = case (parseTime defaultTimeLocale fmtUTC zt) of
Just t -> return t
Nothing -> mkError' ("No parse format: " ++ fmtUTC) js
where zt = concat [ y, "-", mon, "-", d
, " ", h, ":", m, ":", s
, p, " ", z
]
safeFromJson x = mkError x
instance ToJson NominalDiffTime where
toJson x = (JNumber . toRational) x
instance FromJson NominalDiffTime where
safeFromJson (JNumber x) = (return . fromRational) x
safeFromJson x = mkError x