git.iko.soy/typeable/aeson
on master help sign in
parseJSON for the variations on ISO-8601 dates as listed in ECMA-262.
commit8fec44b7a3f2ca569e30f25e315f06f286af628c authorMike Burns <mike@mike-burns.com> dateSun 22 Jan 2012, 15:26 (15 years ago) parentb6a7872
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,18 +41,18 @@ 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(..))
4648import Data.Hashable (Hashable(..))
4749import Data.Int (Int8, Int16, Int32, Int64)
4850import Data.Maybe (fromMaybe)
49−import Data.Monoid (Dual(..), First(..), Last(..))
51+import Data.Monoid (Dual(..), First(..), Last(..), mappend)
5052import Data.Ratio (Ratio)
5153import Data.Text (Text, pack, unpack)
5254import Data.Text.Encoding (encodeUtf8)
53−import Data.Time.Clock (UTCTime)
55+import Data.Time (UTCTime, ZonedTime(..), TimeZone(..))
5456import Data.Time.Format (FormatTime, formatTime, parseTime)
5557import Data.Traversable (traverse)
5658import Data.Typeable (Typeable)
@@ -611,6 +613,37 @@ instance FromJSON DotNetTime where
611613 parseJSON v = typeMismatch "DotNetTime" v
612614 {-# INLINE parseJSON #-}
613615
616+deriving instance Eq ZonedTime
617+
618+instance ToJSON ZonedTime where
619+ toJSON t = String $ pack $ formattedTime
620+ where
621+ formattedTime
622+ | 0 == timeZoneMinutes (zonedTimeZone t) =
623+ formatTime defaultTimeLocale "%FT%T%QZ" t
624+ | otherwise =
625+ formatTime defaultTimeLocale "%FT%T%Q%z" t
626+
627+instance FromJSON ZonedTime where
628+ parseJSON (String t) =
629+ tryFormats alternateFormats
630+ <|> fail "could not parse ECMA-262 ISO-8601 date"
631+ where
632+ tryFormat f =
633+ case parseTime defaultTimeLocale f (unpack t) of
634+ Just d -> pure d
635+ Nothing -> empty
636+ tryFormats = foldr1 (<|>) . map tryFormat
637+ alternateFormats =
638+ distributeList ["%Y", "%Y-%m", "%F"]
639+ ["T%R", "T%T", "T%T%Q", "T%T%QZ", "T%T%Q%z"]
640+
641+ distributeList xs ys =
642+ foldr (\x acc -> acc ++ distribute x ys) [] xs
643+ distribute x = map (mappend x)
644+
645+ parseJSON v = typeMismatch "ZonedTime" v
646+
614647instance ToJSON UTCTime where
615648 toJSON t = String (pack (take 23 str ++ "Z"))
616649 where str = formatTime defaultTimeLocale "%FT%T%Q" t
aeson.cabal+2−1
@@ -159,7 +159,8 @@ test-suite tests
159159 template-haskell,
160160 test-framework,
161161 test-framework-quickcheck2,
162− text
162+ text,
163+ time
163164
164165source-repository head
165166 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
@@ -100,6 +101,17 @@ instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where
100101instance Arbitrary Foo where
101102 arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
102103
104+instance Arbitrary LocalTime where
105+ arbitrary = return $ LocalTime (ModifiedJulianDay 1) (TimeOfDay 1 2 3)
106+
107+instance Arbitrary TimeZone where
108+ arbitrary = do
109+ offset <- choose (0,2) :: Gen Int
110+ return $ hoursToTimeZone offset
111+
112+instance Arbitrary ZonedTime where
113+ arbitrary = liftM2 ZonedTime arbitrary arbitrary
114+
103115data UFoo = UFoo {
104116 _UFooInt :: Int
105117 , uFooInt :: Int
@@ -138,6 +150,7 @@ tests = [
138150 , testProperty "String" $ roundTripEq (""::String)
139151 , testProperty "Text" $ roundTripEq T.empty
140152 , testProperty "Foo" $ roundTripEq (undefined::Foo)
153+ , testProperty "ZonedTime" $ roundTripEq (undefined::ZonedTime)
141154 ],
142155 testGroup "toFromJSON" [
143156 testProperty "Integer" (toFromJSON :: Integer -> Bool)