diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +# 0.3.1.0 + +- `aeson-0.11` support +- GHC 8.0.1 support +- Add `ToJSON` `Day` and `LocalTime` instances + - *NOTE* this instances are broken in `aeson-0.10.0.0` +- Add `Natural`, `Ordering` and `Version` instances + # 0.3.0.0 Split out `aeson-extra` diff --git a/aeson-compat.cabal b/aeson-compat.cabal --- a/aeson-compat.cabal +++ b/aeson-compat.cabal @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: aeson-compat -version: 0.3.0.0 +version: 0.3.1.0 synopsis: Compatibility layer for aeson description: Compatibility layer for @aeson@ category: Web @@ -13,7 +13,7 @@ maintainer: Oleg Grenrus license: BSD3 license-file: LICENSE -tested-with: GHC==7.6.3, GHC==7.8.4, GHC==7.10.3 +tested-with: GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.1 build-type: Simple cabal-version: >= 1.10 @@ -30,16 +30,18 @@ src ghc-options: -Wall build-depends: - base >=4.6 && <4.9 - , aeson >=0.7.0.6 && <0.11 + base >=4.6 && <4.10 + , aeson >=0.7.0.6 && <0.11.1 , attoparsec >=0.12 && <0.14 , bytestring >=0.10 && <0.11 , containers >=0.5 && <0.6 , exceptions >=0.8 && <0.9 , hashable >=1.2 && <1.3 + , nats >=1 && <1.2 , scientific >=0.3 && <0.4 , text >=1.2 && <1.3 , time >=1.4.2 && <1.7 + , time-locale-compat >=0.1.0.1 && <0.2 , unordered-containers >=0.2 && <0.3 , vector >=0.10 && <0.12 exposed-modules: @@ -55,23 +57,26 @@ test ghc-options: -Wall build-depends: - base >=4.6 && <4.9 - , aeson >=0.7.0.6 && <0.11 + base >=4.6 && <4.10 + , aeson >=0.7.0.6 && <0.11.1 , attoparsec >=0.12 && <0.14 , bytestring >=0.10 && <0.11 , containers >=0.5 && <0.6 , exceptions >=0.8 && <0.9 , hashable >=1.2 && <1.3 + , nats >=1 && <1.2 , scientific >=0.3 && <0.4 , text >=1.2 && <1.3 , time >=1.4.2 && <1.7 + , time-locale-compat >=0.1.0.1 && <0.2 , unordered-containers >=0.2 && <0.3 , vector >=0.10 && <0.12 , aeson-compat , tasty >=0.10 && <0.12 , tasty-hunit >=0.9 && <0.10 , tasty-quickcheck >=0.8 && <0.9 - , quickcheck-instances >=0.3 && <0.4 + , QuickCheck >=2.7.6 && <2.8.3 + , quickcheck-instances >=0.3 && <0.3.13 other-modules: Orphans default-language: Haskell2010 diff --git a/src/Data/Aeson/Compat.hs b/src/Data/Aeson/Compat.hs --- a/src/Data/Aeson/Compat.hs +++ b/src/Data/Aeson/Compat.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | @@ -57,16 +58,27 @@ import Control.Monad.Catch import Data.Aeson.Types hiding ((.:?)) import Data.ByteString as B +import qualified Data.Scientific as Scientific import Data.ByteString.Lazy as L import qualified Data.HashMap.Strict as H import Data.Text as T import Data.Typeable (Typeable) #if !MIN_VERSION_aeson(0,10,0) -import Data.Time (Day, LocalTime) +import Data.Time (Day, LocalTime, formatTime) +import Data.Time.Locale.Compat (defaultTimeLocale) import qualified Data.Aeson.Compat.Time as CompatTime #endif +#if !(MIN_VERSION_aeson(0,11,0) && MIN_VERSION_base(4,8,0)) +import Numeric.Natural (Natural) +#endif + +#if !MIN_VERSION_aeson(0,11,0) +import Data.Version (Version, showVersion, parseVersion) +import Text.ParserCombinators.ReadP (readP_to_S) +#endif + -- | Exception thrown by 'decode' - family of functions in this module. newtype AesonException = AesonException String deriving (Show, Typeable) @@ -117,6 +129,7 @@ #endif {-# INLINE (.:?) #-} +#if !MIN_VERSION_aeson(0,11,0) -- | Like '.:?', but the resulting parser will fail, -- if the key is present but is 'Null'. (.:!) :: (FromJSON a) => Object -> Text -> Parser (Maybe a) @@ -131,6 +144,7 @@ Just <$> parseJSON v #endif {-# INLINE (.:!) #-} +#endif #if !MIN_VERSION_aeson(0,9,0) -- From Parser.Internal @@ -185,10 +199,80 @@ #endif +----------------------------------------------------------------------- +-- Instances in aeson-0.10 +----------------------------------------------------------------------- + #if !MIN_VERSION_aeson(0,10,0) instance FromJSON Day where parseJSON = withText "Day" (CompatTime.run CompatTime.day) instance FromJSON LocalTime where parseJSON = withText "LocalTime" (CompatTime.run CompatTime.localTime) + +instance ToJSON Day where + toJSON = toJSON . T.pack . formatTime defaultTimeLocale "%F" + +instance ToJSON LocalTime where + toJSON = toJSON . T.pack . formatTime defaultTimeLocale "%FT%T%Q" +#endif + +----------------------------------------------------------------------- +-- Instances in aeson-0.11 +----------------------------------------------------------------------- + +#if !(MIN_VERSION_aeson(0,11,0) && MIN_VERSION_base(4,8,0)) +instance ToJSON Natural where + toJSON = toJSON . toInteger + {-# INLINE toJSON #-} + +#if MIN_VERSION_aeson(0,10,0) + toEncoding = toEncoding . toInteger + {-# INLINE toEncoding #-} +#endif + +instance FromJSON Natural where + parseJSON = withScientific "Natural" $ \s -> + if Scientific.coefficient s < 0 + then fail $ "Expected a Natural number but got the negative number: " ++ show s + else pure $ truncate s +#endif + +#if !MIN_VERSION_aeson(0,11,0) +instance ToJSON Version where + toJSON = toJSON . showVersion + {-# INLINE toJSON #-} + +#if MIN_VERSION_aeson(0,10,0) + toEncoding = toEncoding . showVersion + {-# INLINE toEncoding #-} +#endif + +instance FromJSON Version where + {-# INLINE parseJSON #-} + parseJSON = withText "Version" $ go . readP_to_S parseVersion . T.unpack + where + go [(v,[])] = return v + go (_ : xs) = go xs + go _ = fail $ "could not parse Version" + +instance ToJSON Ordering where + toJSON = toJSON . orderingToText +#if MIN_VERSION_aeson(0,10,0) + toEncoding = toEncoding . orderingToText +#endif + +orderingToText :: Ordering -> T.Text +orderingToText o = case o of + LT -> "LT" + EQ -> "EQ" + GT -> "GT" + +instance FromJSON Ordering where + parseJSON = withText "Ordering" $ \s -> + case s of + "LT" -> return LT + "EQ" -> return EQ + "GT" -> return GT + _ -> fail "Parsing Ordering value failed: expected \"LT\", \"EQ\", or \"GT\"" #endif diff --git a/src/Data/Aeson/Compat/Time.hs b/src/Data/Aeson/Compat/Time.hs --- a/src/Data/Aeson/Compat/Time.hs +++ b/src/Data/Aeson/Compat/Time.hs @@ -3,7 +3,7 @@ -- | -- Module: Data.Aeson.Compat.Time (Data.Aeson.Parser.Time) -- Copyright: (c) 2015 Bryan O'Sullivan --- License: Apache +-- License: BSD3 -- Maintainer: Bryan O'Sullivan -- Stability: experimental -- Portability: portable @@ -39,7 +39,7 @@ import Control.Applicative ((<$>), (<*>), (<*), (*>)) #endif --- from Data.Aeson.Internal.Time +--- from Data.Aeson.Internal.Time import Unsafe.Coerce (unsafeCoerce) toPico :: Integer -> Pico @@ -67,12 +67,12 @@ let c2d c = ord c .&. 15 return $! c2d a * 10 + c2d b --- | Parse a time of the form @HH:MM:SS[.SSS]@. +-- | Parse a time of the form @HH:MM[:SS[.SSS]]@. timeOfDay :: Parser Local.TimeOfDay timeOfDay = do - h <- twoDigits <* char ':' - m <- twoDigits <* char ':' - s <- seconds + h <- twoDigits + m <- char ':' *> twoDigits + s <- option 0 (char ':' *> seconds) if h < 24 && m < 60 && s < 61 then return (Local.TimeOfDay h m s) else fail "invalid time" @@ -125,9 +125,9 @@ let !tz = Local.minutesToTimeZone off in return (Just tz) --- | Parse a date and time, of the form @YYYY-MM-DD HH:MM:SS@. --- The space may be replaced with a @T@. The number of seconds may be --- followed by a fractional component. +-- | Parse a date and time, of the form @YYYY-MM-DD HH:MM[:SS[.SSS]]@. +-- The space may be replaced with a @T@. The number of seconds is optional +-- and may be followed by a fractional component. localTime :: Parser Local.LocalTime localTime = Local.LocalTime <$> day <* daySep <*> timeOfDay where daySep = satisfy (\c -> c == 'T' || c == ' ') @@ -145,7 +145,9 @@ -- | Parse a date with time zone info. Acceptable formats: -- +-- @YYYY-MM-DD HH:MM Z@ -- @YYYY-MM-DD HH:MM:SS Z@ +-- @YYYY-MM-DD HH:MM:SS.SSS Z@ -- -- The first space may instead be a @T@, and the second space is -- optional. The @Z@ represents UTC. The @Z@ may be replaced with a diff --git a/test/Orphans.hs b/test/Orphans.hs --- a/test/Orphans.hs +++ b/test/Orphans.hs @@ -7,8 +7,24 @@ #endif import Data.Vector as V +import Data.Version (Version(..)) import Test.Tasty.QuickCheck +#if !(MIN_VERSION_QuickCheck(2,8,0) && MIN_VERSION_base(4,8,0)) +import Numeric.Natural (Natural) +#endif + instance Arbitrary a => Arbitrary (Vector a) where arbitrary = V.fromList <$> arbitrary shrink = fmap V.fromList . shrink . V.toList + +#if !(MIN_VERSION_QuickCheck(2,8,0) && MIN_VERSION_base(4,8,0)) +instance Arbitrary Natural where + arbitrary = fmap (fromInteger . abs) arbitrary +#endif + +instance Arbitrary Version where + arbitrary = do + x <- fmap abs arbitrary + xs <- (fmap . fmap) abs arbitrary + return $ Version (x : xs) [] diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -2,12 +2,13 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif +import Data.Time (Day, LocalTime) +import Data.Version (Version) +import Numeric.Natural (Natural) import Test.QuickCheck.Instances () import Test.Tasty +import Test.Tasty.QuickCheck import Test.Tasty.HUnit import Data.Aeson.Compat @@ -17,6 +18,13 @@ main :: IO () main = defaultMain $ testGroup "Tests" [ dotColonMark + , testGroup "Roundtrip" + [ testProperty "Day" $ roundtripBroken10 (undefined :: Day) + , testProperty "LocalTime" $ roundtripBroken10 (undefined :: LocalTime) + , testProperty "Version" $ roundtrip (undefined :: Version) + , testProperty "Ordering" $ roundtrip (undefined :: Ordering) + , testProperty "Natural" $ roundtrip (undefined :: Natural) + ] ] ------------------------------------------------------------------------------ @@ -49,4 +57,15 @@ ex2 = "{\"value\": 42 }" ex3 = "{\"value\": null }" t = testCase "-" - + +roundtrip :: (Arbitrary a, Eq a, Show a, ToJSON a, FromJSON a) => a -> a -> Property +roundtrip _ x = Right x === (eitherDecode . encode $ x) + +roundtripBroken10 :: (Arbitrary a, Eq a, Show a, ToJSON a, FromJSON a) => a -> a -> Property +#if MIN_VERSION_aeson(0,10,0) && !MIN_VERSION_aeson(0,11,0) +roundtripBroken10 _ x = property $ case eitherDecode . encode $ x of + Right y -> False && x == y -- x and y of the same type! + Left _ -> True +#else +roundtripBroken10 = roundtrip +#endif