git.iko.soy/typeable/aeson
on master help sign in
Merge pull request #64 from mike-burns/iso-8601

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

commita16acf5fe6220c0d8909567782b7dc0edb95f9dd authorBryan O'Sullivan <bos@serpentine.com> dateMon 19 Nov 2012, 20:07 (14 years ago) parentab46712e8f5b3f
3 files changed+53−6
compare with master
unifiedsplit
Data/Aeson/Types/Class.hs+37−4 aeson.cabal+2−1 tests/Properties.hs+14−1
Data/Aeson/Types/Class.hs+37−4
@@ -1,6 +1,8 @@
11{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, FlexibleInstances,
22 GeneralizedNewtypeDeriving, IncoherentInstances, OverlappingInstances,
3− OverloadedStrings, UndecidableInstances, ViewPatterns #-}
3+ OverloadedStrings, UndecidableInstances, ViewPatterns,
4+ StandaloneDeriving #-}
5+{-# OPTIONS_GHC -fno-warn-orphans #-}
46
57#ifdef GENERICS
68{-# LANGUAGE DefaultSignatures #-}
@@ -39,7 +41,7 @@ module Data.Aeson.Types.Class
3941 , typeMismatch
4042 ) where
4143
42−import Control.Applicative ((<$>), (<*>), pure)
44+import Control.Applicative ((<$>), (<*>), (<|>), pure, empty)
4345import Data.Aeson.Functions
4446import Data.Aeson.Types.Internal
4547import Data.Attoparsec.Char8 (Number(..))
@@ -47,11 +49,11 @@ import Data.Fixed
4749import Data.Hashable (Hashable(..))
4850import Data.Int (Int8, Int16, Int32, Int64)
4951import Data.Maybe (fromMaybe)
50−import Data.Monoid (Dual(..), First(..), Last(..))
52+import Data.Monoid (Dual(..), First(..), Last(..), mappend)
5153import Data.Ratio (Ratio)
5254import Data.Text (Text, pack, unpack)
5355import Data.Text.Encoding (encodeUtf8)
54−import Data.Time.Clock (UTCTime)
56+import Data.Time (UTCTime, ZonedTime(..), TimeZone(..))
5557import Data.Time.Format (FormatTime, formatTime, parseTime)
5658import Data.Traversable (traverse)
5759import Data.Typeable (Typeable)
@@ -623,6 +625,37 @@ instance FromJSON DotNetTime where
623625 parseJSON v = typeMismatch "DotNetTime" v
624626 {-# INLINE parseJSON #-}
625627
628+deriving instance Eq ZonedTime
629+
630+instance ToJSON ZonedTime where
631+ toJSON t = String $ pack $ formatTime defaultTimeLocale format t
632+ where
633+ format = "%FT%T" ++ milliseconds ++ tzFormat
634+ milliseconds = take 4 $ formatTime defaultTimeLocale "%Q" t
635+ tzFormat
636+ | 0 == timeZoneMinutes (zonedTimeZone t) = "Z"
637+ | otherwise = "%z"
638+
639+instance FromJSON ZonedTime where
640+ parseJSON (String t) =
641+ tryFormats alternateFormats
642+ <|> fail "could not parse ECMA-262 ISO-8601 date"
643+ where
644+ tryFormat f =
645+ case parseTime defaultTimeLocale f (unpack t) of
646+ Just d -> pure d
647+ Nothing -> empty
648+ tryFormats = foldr1 (<|>) . map tryFormat
649+ alternateFormats =
650+ distributeList ["%Y", "%Y-%m", "%F"]
651+ ["T%R", "T%T", "T%T%Q", "T%T%QZ", "T%T%Q%z"]
652+
653+ distributeList xs ys =
654+ foldr (\x acc -> acc ++ distribute x ys) [] xs
655+ distribute x = map (mappend x)
656+
657+ parseJSON v = typeMismatch "ZonedTime" v
658+
626659instance ToJSON UTCTime where
627660 toJSON t = String (pack (take 23 str ++ "Z"))
628661 where str = formatTime defaultTimeLocale "%FT%T%Q" t
aeson.cabal+2−1
@@ -154,7 +154,8 @@ test-suite tests
154154 template-haskell,
155155 test-framework,
156156 test-framework-quickcheck2,
157− text
157+ text,
158+ time
158159
159160source-repository head
160161 type: git
tests/Properties.hs+14−1
@@ -12,12 +12,13 @@ import Data.Data (Typeable, Data)
1212import Data.Text (Text)
1313import Test.Framework (Test, defaultMain, testGroup)
1414import Test.Framework.Providers.QuickCheck2 (testProperty)
15−import Test.QuickCheck (Arbitrary(..))
15+import Test.QuickCheck (Arbitrary(..), choose, Gen)
1616import qualified Data.Aeson.Generic as G
1717import qualified Data.Attoparsec.Lazy as L
1818import qualified Data.ByteString.Lazy.Char8 as L
1919import qualified Data.Text as T
2020import qualified Data.Map as Map
21+import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..), hoursToTimeZone, Day(..), TimeOfDay(..))
2122
2223encodeDouble :: Double -> Double -> Bool
2324encodeDouble num denom
@@ -103,6 +104,17 @@ instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where
103104instance Arbitrary Foo where
104105 arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
105106
107+instance Arbitrary LocalTime where
108+ arbitrary = return $ LocalTime (ModifiedJulianDay 1) (TimeOfDay 1 2 3)
109+
110+instance Arbitrary TimeZone where
111+ arbitrary = do
112+ offset <- choose (0,2) :: Gen Int
113+ return $ hoursToTimeZone offset
114+
115+instance Arbitrary ZonedTime where
116+ arbitrary = liftM2 ZonedTime arbitrary arbitrary
117+
106118data UFoo = UFoo {
107119 _UFooInt :: Int
108120 , uFooInt :: Int
@@ -144,6 +156,7 @@ tests = [
144156 , testProperty "String" $ roundTripEq (""::String)
145157 , testProperty "Text" $ roundTripEq T.empty
146158 , testProperty "Foo" $ roundTripEq (undefined::Foo)
159+ , testProperty "ZonedTime" $ roundTripEq (undefined::ZonedTime)
147160 ],
148161 testGroup "toFromJSON" [
149162 testProperty "Integer" (toFromJSON :: Integer -> Bool)