json2-0.8.3: src/Data/JSON2/Instances/Time.hs

{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
{- |

This module provides Instances classes `ToJson` and `FromJson` for Time.

Time transforms to JSON as: 

@
    `Day`              [\"2011\", \"04\", \"03\"]
    `TimeOfDay`        [\"13\", \"12\", \"47\", \".244649\"]
    `TimeZone`         \"EEST\"
    `LocalTime`        [\"2011\", \"04\", \"03\", \"13\", \"12\", \"47\", \".244649\"]
    `ZonedTime`        [\"2011\", \"04\", \"03\", \"13\", \"12\", \"47\", \".244649\", \"EEST\"]
    `UTCTime`          [\"2011\", \"04\", \"03\", \"10\", \"12\", \"47\", \".244777\", \"UTC\"]
    `NominalDiffTime`  1.301825863528051e9
    `POSIXTime`        1.301825863528051e9
@
 
-}
module Data.JSON2.Instances.Time where

import Data.JSON2
import Data.Time
import Data.Time.Clock.POSIX(POSIXTime) -- POSIXTime synonym NominalDiffTime
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

-- WARNING: Not instance Eq for ZonedTime
-- Zoned Time
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


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

-- TimeOfDay

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

-- WARNING: Test via for TimeZone fail
-- TimeZone
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


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


-- UTC Time
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

--  NominalDiffTime aka POSIXTime
instance ToJson NominalDiffTime where
    toJson x  = (JNumber . toRational) x

instance FromJson NominalDiffTime where
    safeFromJson (JNumber x) = (return . fromRational) x
    safeFromJson x = mkError x


{-
-- Text format UTCTime.
fmtUTC = "%Y-%m-%d %T%Q UTC"
instance FromJson UTCTime where
    safeFromJson (JString x) = case (parseTime defaultTimeLocale fmtUTC x) of
        Just t -> return t
        Nothing -> mkError' ("No parse format: " ++ fmtUTC ) x
    safeFromJson x =  mkError x
-}