8fec44b · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

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

8fec44bMike Burns15 years ago

Data/Aeson/Types/Class.hs+37−4

compare with master

unifiedsplit

@@ -1,6 +1,8 @@

1{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, FlexibleInstances,

2 GeneralizedNewtypeDeriving, IncoherentInstances, OverlappingInstances,

3− OverloadedStrings, UndecidableInstances, ViewPatterns #-}

3+ OverloadedStrings, UndecidableInstances, ViewPatterns,

4+ StandaloneDeriving #-}

5+{-# OPTIONS_GHC -fno-warn-orphans #-}

5#ifdef GENERICS

7#ifdef GENERICS

6{-# LANGUAGE DefaultSignatures #-}

8{-# LANGUAGE DefaultSignatures #-}

@@ -39,18 +41,18 @@ module Data.Aeson.Types.Class

39 , typeMismatch

41 , typeMismatch

40 ) where

42 ) where

42−import Control.Applicative ((<$>), (<*>), pure)

44+import Control.Applicative ((<$>), (<*>), (<|>), pure, empty)

43import Data.Aeson.Functions

45import Data.Aeson.Functions

44import Data.Aeson.Types.Internal

46import Data.Aeson.Types.Internal

45import Data.Attoparsec.Char8 (Number(..))

47import Data.Attoparsec.Char8 (Number(..))

46import Data.Hashable (Hashable(..))

48import Data.Hashable (Hashable(..))

47import Data.Int (Int8, Int16, Int32, Int64)

49import Data.Int (Int8, Int16, Int32, Int64)

48import Data.Maybe (fromMaybe)

50import Data.Maybe (fromMaybe)

49−import Data.Monoid (Dual(..), First(..), Last(..))

51+import Data.Monoid (Dual(..), First(..), Last(..), mappend)

50import Data.Ratio (Ratio)

52import Data.Ratio (Ratio)

51import Data.Text (Text, pack, unpack)

53import Data.Text (Text, pack, unpack)

52import Data.Text.Encoding (encodeUtf8)

54import Data.Text.Encoding (encodeUtf8)

53−import Data.Time.Clock (UTCTime)

55+import Data.Time (UTCTime, ZonedTime(..), TimeZone(..))

54import Data.Time.Format (FormatTime, formatTime, parseTime)

56import Data.Time.Format (FormatTime, formatTime, parseTime)

55import Data.Traversable (traverse)

57import Data.Traversable (traverse)

56import Data.Typeable (Typeable)

58import Data.Typeable (Typeable)

@@ -611,6 +613,37 @@ instance FromJSON DotNetTime where

611 parseJSON v = typeMismatch "DotNetTime" v

613 parseJSON v = typeMismatch "DotNetTime" v

612 {-# INLINE parseJSON #-}

614 {-# INLINE parseJSON #-}

613

615

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+

614instance ToJSON UTCTime where

647instance ToJSON UTCTime where

615 toJSON t = String (pack (take 23 str ++ "Z"))

648 toJSON t = String (pack (take 23 str ++ "Z"))

616 where str = formatTime defaultTimeLocale "%FT%T%Q" t

649 where str = formatTime defaultTimeLocale "%FT%T%Q" t

aeson.cabal+2−1

@@ -159,7 +159,8 @@ test-suite tests

159 template-haskell,

160 test-framework,

161 test-framework-quickcheck2,

162− text

162+ text,

163+ time

163

164

164source-repository head

165source-repository head

165 type: git

166 type: git

tests/Properties.hs+14−1

@@ -12,12 +12,13 @@ import Data.Data (Typeable, Data)

12import Data.Text (Text)

13import Test.Framework (Test, defaultMain, testGroup)

14import Test.Framework.Providers.QuickCheck2 (testProperty)

15−import Test.QuickCheck (Arbitrary(..))

15+import Test.QuickCheck (Arbitrary(..), choose, Gen)

16import qualified Data.Aeson.Generic as G

17import qualified Data.Attoparsec.Lazy as L

18import qualified Data.ByteString.Lazy.Char8 as L

19import qualified Data.Text as T

20import qualified Data.Map as Map

21+import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..), hoursToTimeZone, Day(..), TimeOfDay(..))

22encodeDouble :: Double -> Double -> Bool

23encodeDouble :: Double -> Double -> Bool

23encodeDouble num denom

24encodeDouble num denom

@@ -100,6 +101,17 @@ instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where

100instance Arbitrary Foo where

101instance Arbitrary Foo where

101 arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary

102 arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary

102

103

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+

103data UFoo = UFoo {

115data UFoo = UFoo {

104 _UFooInt :: Int

116 _UFooInt :: Int

105 , uFooInt :: Int

117 , uFooInt :: Int

@@ -138,6 +150,7 @@ tests = [

138 , testProperty "String" $ roundTripEq (""::String)

150 , testProperty "String" $ roundTripEq (""::String)

139 , testProperty "Text" $ roundTripEq T.empty

151 , testProperty "Text" $ roundTripEq T.empty

140 , testProperty "Foo" $ roundTripEq (undefined::Foo)

152 , testProperty "Foo" $ roundTripEq (undefined::Foo)

153+ , testProperty "ZonedTime" $ roundTripEq (undefined::ZonedTime)

141 ],

154 ],

142 testGroup "toFromJSON" [

155 testGroup "toFromJSON" [

143 testProperty "Integer" (toFromJSON :: Integer -> Bool)

156 testProperty "Integer" (toFromJSON :: Integer -> Bool)