Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

parseJSON for the variations on ISO-8601 dates as listed in ECMA-262.

  • Loading branch information...
commit 4fbd5b9139d487dd7eb00fe5674e424489a85b7c 1 parent 55ab832
@mike-burns mike-burns authored
Showing with 53 additions and 6 deletions.
  1. +37 −4 Data/Aeson/Types/Class.hs
  2. +2 −1  aeson.cabal
  3. +14 −1 tests/Properties.hs
View
41 Data/Aeson/Types/Class.hs
@@ -1,6 +1,8 @@
{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, FlexibleInstances,
GeneralizedNewtypeDeriving, IncoherentInstances, OverlappingInstances,
- OverloadedStrings, UndecidableInstances, ViewPatterns #-}
+ OverloadedStrings, UndecidableInstances, ViewPatterns,
+ StandaloneDeriving #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
#ifdef GENERICS
{-# LANGUAGE DefaultSignatures #-}
@@ -39,18 +41,18 @@ 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(..))
import Data.Hashable (Hashable(..))
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Maybe (fromMaybe)
-import Data.Monoid (Dual(..), First(..), Last(..))
+import Data.Monoid (Dual(..), First(..), Last(..), mappend)
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)
@@ -611,6 +613,37 @@ instance FromJSON DotNetTime where
parseJSON v = typeMismatch "DotNetTime" v
{-# INLINE parseJSON #-}
+deriving instance Eq ZonedTime
+
+instance ToJSON ZonedTime where
+ toJSON 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 ZonedTime where
+ parseJSON (String t) =
+ tryFormats alternateFormats
+ <|> fail "could not parse ECMA-262 ISO-8601 date"
+ where
+ tryFormat f =
+ case parseTime defaultTimeLocale f (unpack t) of
+ Just d -> pure d
+ Nothing -> empty
+ tryFormats = foldr1 (<|>) . map tryFormat
+ alternateFormats =
+ distributeList ["%Y", "%Y-%m", "%F"]
+ ["T%R", "T%T", "T%T%Q", "T%T%QZ", "T%T%Q%z"]
+
+ distributeList xs ys =
+ foldr (\x acc -> acc ++ distribute x ys) [] xs
+ distribute x = map (mappend x)
+
+ parseJSON v = typeMismatch "ZonedTime" v
+
instance ToJSON UTCTime where
toJSON t = String (pack (take 23 str ++ "Z"))
where str = formatTime defaultTimeLocale "%FT%T%Q" t
View
3  aeson.cabal
@@ -159,7 +159,8 @@ test-suite tests
template-haskell,
test-framework,
test-framework-quickcheck2,
- text
+ text,
+ time
source-repository head
type: git
View
15 tests/Properties.hs
@@ -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(..), hoursToTimeZone, Day(..), TimeOfDay(..))
encodeDouble :: Double -> Double -> Bool
encodeDouble num denom
@@ -100,6 +101,17 @@ 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
+
data UFoo = UFoo {
_UFooInt :: Int
, uFooInt :: Int
@@ -138,6 +150,7 @@ tests = [
, testProperty "String" $ roundTripEq (""::String)
, testProperty "Text" $ roundTripEq T.empty
, testProperty "Foo" $ roundTripEq (undefined::Foo)
+ , testProperty "ZonedTime" $ roundTripEq (undefined::ZonedTime)
],
testGroup "toFromJSON" [
testProperty "Integer" (toFromJSON :: Integer -> Bool)
Please sign in to comment.
Something went wrong with that request. Please try again.