Permalink
Browse files

Converts to and from a Rails-formatted ISO-8601 time, handling the

special-casing of UTC time.
  • Loading branch information...
1 parent e3894cc commit da1a907fa5a32b2291c17990da815b79b7be8599 @mike-burns committed Jan 4, 2012
Showing with 46 additions and 17 deletions.
  1. +29 −16 Data/Aeson/Types/Class.hs
  2. +17 −1 tests/Properties.hs
View
@@ -40,7 +40,7 @@ module Data.Aeson.Types.Class
, typeMismatch
) where
-import Control.Applicative ((<$>), (<*>), pure)
+import Control.Applicative ((<$>), (<*>), pure, (<|>), empty)
import Data.Aeson.Functions
import Data.Aeson.Types.Internal
import Data.Attoparsec.Char8 (Number(..))
@@ -51,7 +51,7 @@ import Data.Monoid (Dual(..), First(..), Last(..))
import Data.Ratio (Ratio)
import Data.Text (Text, pack, unpack)
import Data.Text.Encoding (encodeUtf8)
-import Data.Time.Clock (UTCTime)
+import Data.Time (UTCTime, ZonedTime(..),TimeZone(..))
import Data.Time.Format (FormatTime, formatTime, parseTime)
import Data.Traversable (traverse)
import Data.Typeable (Typeable)
@@ -612,25 +612,38 @@ instance FromJSON DotNetTime where
parseJSON v = typeMismatch "DotNetTime" v
{-# INLINE parseJSON #-}
--- | A newtype wrapper for 'UTCTime' that uses the same ISO-8601 format that
--- Rails uses by default for its TimeWithZone type. The time format is
--- @%FT%T%Z@, which is one of the many allowed variants of ISO-8601.
-newtype TimeWithZone = TimeWithZone {
- fromTimeWithZone :: UTCTime
- } deriving (Eq, Ord, Read, Show, Typeable, FormatTime)
+-- | A newtype wrapper for 'ZonedTime' that uses the same ISO-8601 formats that
+-- Rails uses by default for its TimeWithZone type.
+-- This can be either UTC, in which case it follows the @%FT%T%Z@ format, or
+-- a localtime, in which case it follows the @%FT%T%z@ format (note the @%z@ vs
+-- @%Z@).
+-- TODO
+newtype TimeWithZone = TimeWithZone ZonedTime deriving (Eq, Show)
+instance Eq ZonedTime where
+ x == y =
+ zonedTimeToLocalTime x == zonedTimeToLocalTime y &&
+ zonedTimeZone x == zonedTimeZone y
instance ToJSON TimeWithZone where
- toJSON t = String (pack str)
- where str = formatTime defaultTimeLocale "%FT%T%Z" t
- {-# INLINE toJSON #-}
+ toJSON (TimeWithZone t) = String $ pack $ formattedTime
+ where
+ formattedTime
+ | 0 == timeZoneMinutes (zonedTimeZone t) =
+ formatTime defaultTimeLocale "%FT%T%QZ" t
+ | otherwise =
+ formatTime defaultTimeLocale "%FT%T%Q%z" t
instance FromJSON TimeWithZone where
- parseJSON (String t) =
- case parseTime defaultTimeLocale "%FT%T%Z" (unpack t) of
+ parseJSON (String t) =
+ timeFormat "%FT%T%QZ" <|> timeFormat "%FT%T%Q%z" <|>
+ fail "could not parse Rails-style ISO-8601 date"
+ where
+ timeFormat f =
+ case parseTime defaultTimeLocale f (unpack t) of
Just d -> pure $ TimeWithZone d
- _ -> fail "could not parse ISO-8601 date from Rails default format"
- parseJSON v = typeMismatch "UTCTime" v
- {-# INLINE parseJSON #-}
+ Nothing -> empty
+
+ parseJSON v = typeMismatch "TimeWithZone" v
instance ToJSON UTCTime where
toJSON t = String (pack (take 23 str ++ "Z"))
View
@@ -12,12 +12,13 @@ import Data.Data (Typeable, Data)
import Data.Text (Text)
import Test.Framework (Test, defaultMain, testGroup)
import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.QuickCheck (Arbitrary(..))
+import Test.QuickCheck (Arbitrary(..), choose, Gen(..))
import qualified Data.Aeson.Generic as G
import qualified Data.Attoparsec.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Text as T
import qualified Data.Map as Map
+import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..), utc, hoursToTimeZone, Day(..), TimeOfDay(..))
encodeDouble :: Double -> Double -> Bool
encodeDouble num denom
@@ -100,6 +101,20 @@ instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where
instance Arbitrary Foo where
arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
+instance Arbitrary LocalTime where
+ arbitrary = return $ LocalTime (ModifiedJulianDay 1) (TimeOfDay 1 2 3)
+
+instance Arbitrary TimeZone where
+ arbitrary = do
+ offset <- choose (0,2) :: Gen Int
+ return $ hoursToTimeZone offset
+
+instance Arbitrary ZonedTime where
+ arbitrary = liftM2 ZonedTime arbitrary arbitrary
+
+instance Arbitrary TimeWithZone where
+ arbitrary = liftM TimeWithZone arbitrary
+
{-
Test for Data.Aeson.Generic handling '_' names
-}
@@ -141,6 +156,7 @@ tests = [
, testProperty "String" $ roundTripEq (""::String)
, testProperty "Text" $ roundTripEq T.empty
, testProperty "Foo" $ roundTripEq (undefined::Foo)
+ , testProperty "TimeWithZone" $ roundTripEq (undefined::TimeWithZone)
],
testGroup "toFromJSON" [
testProperty "Integer" (toFromJSON :: Integer -> Bool)

0 comments on commit da1a907

Please sign in to comment.