diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +# 0.3.7 + +- Use `attoparsec-iso8601` time parsers. +- Don't export `GToJSON` etc. members. + # 0.3.6 - Fix accidental removal of `AesonException` export diff --git a/aeson-compat.cabal b/aeson-compat.cabal --- a/aeson-compat.cabal +++ b/aeson-compat.cabal @@ -1,9 +1,5 @@ --- This file has been generated from package.yaml by hpack version 0.14.1. --- --- see: https://github.com/sol/hpack - name: aeson-compat -version: 0.3.6 +version: 0.3.7 synopsis: Compatibility layer for aeson description: Compatibility layer for @aeson@ category: Web @@ -13,9 +9,16 @@ maintainer: Oleg Grenrus license: BSD3 license-file: LICENSE -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 +tested-with: + GHC==7.6.3, + GHC==7.8.4, + GHC==7.10.2, + GHC==7.10.3, + GHC==8.0.1, + GHC==8.0.2, + GHC==8.2.1 extra-source-files: CHANGELOG.md @@ -30,10 +33,11 @@ src ghc-options: -Wall build-depends: - base >=4.6 && <4.10 + base >=4.6 && <4.11 , base-compat >=0.6.0 && <0.10 - , aeson >=0.7.0.6 && <1.1 + , aeson >=0.7.0.6 && <1.3 , attoparsec >=0.12 && <0.14 + , attoparsec-iso8601 >=1.0.0.0 && <1.1 , bytestring >=0.10 && <0.11 , containers >=0.5 && <0.6 , exceptions >=0.8 && <0.9 @@ -41,16 +45,14 @@ , nats >=1 && <1.2 , scientific >=0.3 && <0.4 , text >=1.2 && <1.3 - , time >=1.4.2 && <1.7 + , time >=1.4.2 && <1.9 , time-locale-compat >=0.1.0.1 && <0.2 , unordered-containers >=0.2 && <0.3 - , vector >=0.10 && <0.12 + , vector >=0.10 && <0.13 , semigroups >=0.16.2.2 && <0.19 , tagged >=0.7.3 && <0.9 exposed-modules: Data.Aeson.Compat - other-modules: - Data.Aeson.Compat.Time default-language: Haskell2010 test-suite aeson-compat-test @@ -60,30 +62,28 @@ test ghc-options: -Wall build-depends: - base >=4.6 && <4.10 - , base-compat >=0.6.0 && <0.10 - , aeson >=0.7.0.6 && <1.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 - , semigroups >=0.16.2.2 && <0.19 - , tagged >=0.7.3 && <0.9 + base + , base-compat + , aeson + , attoparsec + , bytestring + , containers + , exceptions + , hashable + , nats + , scientific + , text + , time + , time-locale-compat + , unordered-containers + , vector + , semigroups + , tagged , aeson-compat - , base-orphans >=0.4.5 && <0.6 + , base-orphans >=0.4.5 && <0.7 , tasty >=0.10 && <0.12 , tasty-hunit >=0.9 && <0.10 , tasty-quickcheck >=0.8 && <0.9 - , QuickCheck >=2.7.6 && <2.9.2 - , quickcheck-instances >=0.3 && <0.3.13 - other-modules: - Orphans + , QuickCheck >=2.9.2 && <2.9.3 + , quickcheck-instances >=0.3.14 && <0.3.15 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 @@ -14,8 +14,8 @@ -- -- * 'decode' etc. work as in @aeson >=0.9@ -- * but it is generalised to work in any 'MonadThrow' (that is extra) --- * '.:?' works as in @aeson <0.10@ --- * '.:!' works as '.:?' in @aeson ==0.10@ +-- * '.:?' works as in @aeson <0.10 || >=0.11@ +-- * '.:!' works as in @aeson <0.10 || >=0.11@ and as '.:?' did in @aeson ==0.10.*@ -- * Orphan instances 'FromJSON' 'Day' and 'FromJSON' 'LocalTime' for @aeson <0.10@ -- * 'Encoding' related functionality is not added. It's present only with @aeson >=0.10@ -- @@ -54,11 +54,11 @@ (.=), #endif -- ** Generic JSON classes and options - GFromJSON(..), - GToJSON(..), + GFromJSON, + GToJSON, #if MIN_VERSION_aeson(0,11,0) -- GToEncoding is introduced in 0.11.0.0 - GToEncoding(..), + GToEncoding, #endif genericToJSON, #if MIN_VERSION_aeson(0,10,0) @@ -123,7 +123,8 @@ #if !MIN_VERSION_aeson(0,10,0) import Data.Time (Day, LocalTime, formatTime, NominalDiffTime) import Data.Time.Locale.Compat (defaultTimeLocale) -import qualified Data.Aeson.Compat.Time as CompatTime +import qualified Data.Attoparsec.Text as Atto +import qualified Data.Attoparsec.Time as CompatTime #endif #if !(MIN_VERSION_aeson(0,11,0) && MIN_VERSION_base(4,8,0)) @@ -270,11 +271,16 @@ ----------------------------------------------------------------------- #if !MIN_VERSION_aeson(0,10,0) +attoRun :: Atto.Parser a -> Text -> Parser a +attoRun p t = case Atto.parseOnly (p <* Atto.endOfInput) t of + Left err -> fail $ "could not parse date: " ++ err + Right r -> return r + instance FromJSON Day where - parseJSON = withText "Day" (CompatTime.run CompatTime.day) + parseJSON = withText "Day" (attoRun CompatTime.day) instance FromJSON LocalTime where - parseJSON = withText "LocalTime" (CompatTime.run CompatTime.localTime) + parseJSON = withText "LocalTime" (attoRun CompatTime.localTime) instance ToJSON Day where toJSON = toJSON . T.pack . formatTime defaultTimeLocale "%F" @@ -285,12 +291,12 @@ instance ToJSON NominalDiffTime where toJSON = Number . realToFrac {-# INLINE toJSON #-} - + #if MIN_VERSION_aeson(0,10,0) toEncoding = Encoding . E.number . realToFrac {-# INLINE toEncoding #-} #endif - + -- | /WARNING:/ Only parse lengths of time from trusted input -- since an attacker could easily fill up the memory of the target -- system by specifying a scientific number with a big exponent like diff --git a/src/Data/Aeson/Compat/Time.hs b/src/Data/Aeson/Compat/Time.hs deleted file mode 100644 --- a/src/Data/Aeson/Compat/Time.hs +++ /dev/null @@ -1,161 +0,0 @@ -{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-} - --- | --- Module: Data.Aeson.Compat.Time (Data.Aeson.Parser.Time) --- Copyright: (c) 2015 Bryan O'Sullivan --- License: BSD3 --- Maintainer: Bryan O'Sullivan --- Stability: experimental --- Portability: portable --- --- Parsers for parsing dates and times. - -module Data.Aeson.Compat.Time - ( - run - , day - , localTime - , timeOfDay - , timeZone - , utcTime - , zonedTime - ) where - -import Control.Monad (when, void) -import Data.Attoparsec.Text as A -import Data.Bits ((.&.)) -import Data.Char (isDigit, ord) -import Data.Fixed (Pico) -import Data.Int (Int64) -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import Data.Time.Calendar (Day, fromGregorianValid) -import Data.Time.Clock (UTCTime(..)) -import qualified Data.Aeson.Types as Aeson -import qualified Data.Text as T -import qualified Data.Time.LocalTime as Local - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>), (<*>), (<*), (*>)) -#endif - ---- from Data.Aeson.Internal.Time -import Unsafe.Coerce (unsafeCoerce) - -toPico :: Integer -> Pico -toPico = unsafeCoerce - --- | Run an attoparsec parser as an aeson parser. -run :: Parser a -> Text -> Aeson.Parser a -run p t = case A.parseOnly (p <* endOfInput) t of - Left err -> fail $ "could not parse date: " ++ err - Right r -> return r - --- | Parse a date of the form @YYYY-MM-DD@. -day :: Parser Day -day = do - y <- decimal <* char '-' - m <- twoDigits <* char '-' - d <- twoDigits - maybe (fail "invalid date") return (fromGregorianValid y m d) - --- | Parse a two-digit integer (e.g. day of month, hour). -twoDigits :: Parser Int -twoDigits = do - a <- digit - b <- digit - let c2d c = ord c .&. 15 - return $! c2d a * 10 + c2d b - --- | Parse a time of the form @HH:MM[:SS[.SSS]]@. -timeOfDay :: Parser Local.TimeOfDay -timeOfDay = do - 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" - -data T = T {-# UNPACK #-} !Int {-# UNPACK #-} !Int64 - --- | Parse a count of seconds, with the integer part being two digits --- long. -seconds :: Parser Pico -seconds = do - real <- twoDigits - mc <- peekChar - case mc of - Just '.' -> do - t <- anyChar *> takeWhile1 isDigit - return $! parsePicos real t - _ -> return $! fromIntegral real - where - parsePicos a0 t = toPico (fromIntegral (t' * 10^n)) - where T n t' = T.foldl' step (T 12 (fromIntegral a0)) t - step ma@(T m a) c - | m <= 0 = ma - | otherwise = T (m-1) (10 * a + fromIntegral (ord c) .&. 15) - --- | Parse a time zone, and return 'Nothing' if the offset from UTC is --- zero. (This makes some speedups possible.) -timeZone :: Parser (Maybe Local.TimeZone) -timeZone = do - let maybeSkip c = do ch <- peekChar'; when (ch == c) (void anyChar) - maybeSkip ' ' - ch <- satisfy $ \c -> c == 'Z' || c == '+' || c == '-' - if ch == 'Z' - then return Nothing - else do - h <- twoDigits - mm <- peekChar - m <- case mm of - Just ':' -> anyChar *> twoDigits - Just d | isDigit d -> twoDigits - _ -> return 0 - let off | ch == '-' = negate off0 - | otherwise = off0 - off0 = h * 60 + m - case undefined of - _ | off == 0 -> - return Nothing - | off < -720 || off > 840 || m > 59 -> - fail "invalid time zone offset" - | otherwise -> - let !tz = Local.minutesToTimeZone off - in return (Just tz) - --- | 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 == ' ') - --- | Behaves as 'zonedTime', but converts any time zone offset into a --- UTC time. -utcTime :: Parser UTCTime -utcTime = do - lt@(Local.LocalTime d t) <- localTime - mtz <- timeZone - case mtz of - Nothing -> let !tt = Local.timeOfDayToTime t - in return (UTCTime d tt) - Just tz -> return $! Local.localTimeToUTC tz lt - --- | 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 --- time zone offset of the form @+0000@ or @-08:00@, where the first --- two digits are hours, the @:@ is optional and the second two digits --- (also optional) are minutes. -zonedTime :: Parser Local.ZonedTime -zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone) - -utc :: Local.TimeZone -utc = Local.TimeZone 0 False "" diff --git a/test/Orphans.hs b/test/Orphans.hs deleted file mode 100644 --- a/test/Orphans.hs +++ /dev/null @@ -1,62 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Orphans where - -import Prelude () -import Prelude.Compat - -import Test.Tasty.QuickCheck - -import Data.Orphans () -import Test.QuickCheck.Instances () - -#if !MIN_VERSION_quickcheck_instances(0,3,12) -import Data.Vector as V -#endif - -#if !(MIN_VERSION_QuickCheck(2,8,0) && MIN_VERSION_base(4,8,0)) && !(MIN_VERSION_QuickCheck(2,9,0)) -import Numeric.Natural (Natural) -#endif - -#if !MIN_VERSION_QuickCheck(2,9,0) -import Control.Applicative (Const (..)) -import Data.List.NonEmpty (NonEmpty (..)) -import Data.Version (Version (..)) -#endif - -import Data.Proxy (Proxy (..)) -import Data.Tagged (Tagged (..)) - -#if !MIN_VERSION_quickcheck_instances(0,3,12) -instance Arbitrary a => Arbitrary (Vector a) where - arbitrary = V.fromList <$> arbitrary - shrink = fmap V.fromList . shrink . V.toList -#endif - -#if !(MIN_VERSION_QuickCheck(2,8,0) && MIN_VERSION_base(4,8,0)) && !(MIN_VERSION_QuickCheck(2,9,0)) -instance Arbitrary Natural where - arbitrary = fmap (fromInteger . abs) arbitrary -#endif - -#if !MIN_VERSION_QuickCheck(2,9,0) -instance Arbitrary a => Arbitrary (NonEmpty a) where - arbitrary = do - x <- arbitrary - xs <- arbitrary - return (x :| xs) - -instance Arbitrary a => Arbitrary (Const a b) where - arbitrary = fmap Const arbitrary - -instance Arbitrary Version where - arbitrary = do - x <- fmap abs arbitrary - xs <- (fmap . fmap) abs arbitrary - return $ Version (x : xs) [] -#endif - -instance Arbitrary a => Arbitrary (Tagged t a) where - arbitrary = fmap Tagged arbitrary - -instance Arbitrary (Proxy a) where - arbitrary = return Proxy diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -7,7 +7,7 @@ import Control.Applicative (Const) import Data.List.NonEmpty (NonEmpty) -import Data.Proxy (Proxy) +import Data.Proxy (Proxy (..)) import Data.Tagged (Tagged) import Data.Text (Text) import Data.Time (Day, LocalTime, NominalDiffTime) @@ -23,7 +23,8 @@ import Data.Aeson.Compat -import Orphans () +instance Arbitrary (Proxy a) where + arbitrary = pure Proxy main :: IO () main = defaultMain $ testGroup "Tests"