aeson-extra 0.2.1.0 → 0.2.2.0
raw patch · 6 files changed
+294/−10 lines, 6 filesdep +timedep −tagged
Dependencies added: time
Dependencies removed: tagged
Files
- CHANGELOG.md +6/−1
- aeson-extra.cabal +7/−5
- src/Data/Aeson/Compat.hs +18/−2
- src/Data/Aeson/Extra.hs +59/−2
- src/Data/Aeson/Extra/Time.hs +159/−0
- test/Tests.hs +45/−0
CHANGELOG.md view
@@ -1,6 +1,11 @@+# 0.2.2.0 (2015-11-10)++- `U` and `Z` to parse `UTCTime` and `ZonedTime` compatibly+- Orphans `FromJSON` for `Day` and `LocalTime`+ # 0.2.1.0 (2015-10-05) GHC 7.6 Support -- No `Sym` or `SingObject` support+- No `SymTag` or `SingObject` support # 0.2.0.0 (2015-09-29) No ListLike
aeson-extra.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: aeson-extra-version: 0.2.1.0+version: 0.2.2.0 synopsis: Extra goodies for aeson description: The package motivation is twofold: .@@ -35,20 +35,22 @@ ghc-options: -Wall build-depends: base >=4.6 && <4.9- , aeson >=0.8 && <0.11+ , aeson >=0.7.0.6 && <0.11 , 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 , scientific >=0.3 && <0.4- , tagged >=0.7 && <0.9 , text >=1.2 && <1.3+ , time >=1.4.2 && <1.6 , unordered-containers >=0.2 && <0.3 , vector >=0.10 && <0.12 exposed-modules: Data.Aeson.Compat Data.Aeson.Extra+ other-modules:+ Data.Aeson.Extra.Time default-language: Haskell2010 test-suite aeson-extra-test@@ -59,15 +61,15 @@ ghc-options: -Wall build-depends: base >=4.6 && <4.9- , aeson >=0.8 && <0.11+ , aeson >=0.7.0.6 && <0.11 , 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 , scientific >=0.3 && <0.4- , tagged >=0.7 && <0.9 , text >=1.2 && <1.3+ , time >=1.4.2 && <1.6 , unordered-containers >=0.2 && <0.3 , vector >=0.10 && <0.12 , aeson-extra
src/Data/Aeson/Compat.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Aeson.Compat@@ -59,6 +60,11 @@ import Data.Text as T import Data.Typeable (Typeable) +#if !MIN_VERSION_aeson(0,10,0)+import Data.Time (Day, LocalTime)+import qualified Data.Aeson.Extra.Time as ExtraTime+#endif+ -- | Exception thrown by 'decode' - family of functions in this module. newtype AesonException = AesonException String deriving (Show, Typeable)@@ -70,7 +76,7 @@ eitherAesonExc (Right x) = return x -- | Like original 'Data.Aeson.decode' but in arbitrary 'MonadThrow'.--- +-- -- Parse a top-level JSON value, i.e. also strings, numbers etc. decode :: (FromJSON a, MonadThrow m) => L.ByteString -> m a decode = eitherAesonExc . eitherDecode@@ -114,7 +120,7 @@ (.:!) :: (FromJSON a) => Object -> Text -> Parser (Maybe a) obj .:! key = case H.lookup key obj of Nothing -> pure Nothing- Just v -> + Just v -> #if MIN_VERSION_aeson(0,10,0) modifyFailure addKeyName $ Just <$> parseJSON v -- <?> Key key where@@ -175,4 +181,14 @@ Error msg -> Left msg {-# INLINE eitherDecodeStrictWith #-} +#endif++#if !MIN_VERSION_aeson(0,10,0)+-- | /Since: aeson-extra-0.2.2.0/+instance FromJSON Day where+ parseJSON = withText "Day" (ExtraTime.run ExtraTime.day)++-- | /Since: aeson-extra-0.2.2.0/+instance FromJSON LocalTime where+ parseJSON = withText "LocalTime" (ExtraTime.run ExtraTime.localTime) #endif
src/Data/Aeson/Extra.hs view
@@ -37,6 +37,9 @@ CollapsedList(..), getCollapsedList, parseCollapsedList,+ -- * UTCTime+ U(..),+ Z(..), -- * Re-exports module Data.Aeson.Compat, ) where@@ -56,6 +59,7 @@ import qualified Data.Map as Map import Data.Text as T import qualified Data.Text.Lazy as TL+import Data.Time (UTCTime, ZonedTime) import qualified Data.Text.Read as T #if MIN_VERSION_base(4,7,0)@@ -63,6 +67,10 @@ import GHC.TypeLits #endif +#if !MIN_VERSION_aeson (0,10,0)+import qualified Data.Aeson.Extra.Time as ExtraTime+#endif+ -- | A wrapper type to parse arbitrary maps -- -- > λ > decode "{\"1\": 1, \"2\": 2}" :: Maybe (M (H.HashMap Int Int))@@ -135,7 +143,7 @@ -- > decode "\"foobar\"" :: Maybe (SymTag "barfoo") -- > Nothing ----- > /Available with: base >=4.7/+-- /Available with: base >=4.7/ data SymTag (s :: Symbol) = SymTag deriving (Eq, Ord, Show, Read, Enum, Bounded) @@ -159,7 +167,7 @@ -- > λ > encode (SingObject 42 :: SingObject "value" Int) -- > "{\"value\":42}" ----- > /Available with: base >=4.7/+-- /Available with: base >=4.7/ newtype SingObject (s ::Symbol) a = SingObject a deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable) @@ -248,4 +256,53 @@ addKeyName = (("failed to parse field " <> T.unpack key <> ": ") <>) #else Just v -> getCollapsedList <$> parseJSON v+#endif++-- | A type to parse 'UTCTime'+--+-- 'FromJSON' instance accepts for example:+--+-- @+-- 2015-09-07T08:16:40.807Z+-- 2015-09-07 11:16:40.807 +03:00+-- @+--+-- Latter format is accepted by @aeson@ staring from version @0.10.0.0@.+--+-- See <https://github.com/bos/aeson/blob/4667ef1029a373cf4510f7deca147c357c6d8947/Data/Aeson/Parser/Time.hs#L150>+--+-- /Since: aeson-extra-0.2.2.0/+newtype U = U { getU :: UTCTime }+ deriving (Eq, Ord, Show, Read)++instance ToJSON U where+ toJSON = toJSON . getU+#if MIN_VERSION_aeson (0,10,0)+ toEncoding = toEncoding . getU+#endif++instance FromJSON U where+#if MIN_VERSION_aeson (0,10,0)+ parseJSON = fmap U . parseJSON+#else+ parseJSON = withText "UTCTime" (fmap U . ExtraTime.run ExtraTime.utcTime)+#endif++-- | A type to parse 'ZonedTime'+--+-- /Since: aeson-extra-0.2.2.0/+newtype Z = Z { getZ :: ZonedTime }+ deriving (Show, Read)++instance ToJSON Z where+ toJSON = toJSON . getZ+#if MIN_VERSION_aeson (0,10,0)+ toEncoding = toEncoding . getZ+#endif++instance FromJSON Z where+#if MIN_VERSION_aeson (0,10,0)+ parseJSON = fmap Z . parseJSON+#else+ parseJSON = withText "ZonedTime" (fmap Z . ExtraTime.run ExtraTime.zonedTime) #endif
+ src/Data/Aeson/Extra/Time.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-}++-- |+-- Module: Data.Aeson.Extra.Time (Data.Aeson.Parser.Time)+-- Copyright: (c) 2015 Bryan O'Sullivan+-- License: Apache+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>+-- Stability: experimental+-- Portability: portable+--+-- Parsers for parsing dates and times.++module Data.Aeson.Extra.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 <* char ':'+ m <- twoDigits <* char ':'+ s <- 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@.+-- The space may be replaced with a @T@. The number of seconds 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:SS 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 ""
test/Tests.hs view
@@ -11,6 +11,9 @@ import Data.Aeson.Extra import qualified Data.HashMap.Lazy as H import Data.Map (Map)+import Data.Maybe (isJust)+import Data.String (fromString)+import Data.Time (zonedTimeToUTC) import Data.Vector (Vector) import Test.QuickCheck.Instances () import Test.Tasty@@ -32,6 +35,8 @@ , singObjectTests #endif , collapsedListTests+ , utctimeTests+ , zonedtimeTests ] ------------------------------------------------------------------------------@@ -145,3 +150,43 @@ ex2 = "{\"value\": 42 }" ex3 = "{\"value\": null }" t = testCase "-"++------------------------------------------------------------------------------+-- U & Z+------------------------------------------------------------------------------++utctimeTests :: TestTree+utctimeTests = testGroup "U" $+ [ testCase "base case" $ assertBool "base case" $ isJust simple+ ] ++ map t timeStrings+ where simple = decode "\"2015-09-07T08:16:40.807Z\"" :: Maybe U+ t str = testCase str+ . assertEqual str simple+ . decode+ . fromString+ $ "\"" ++ str ++ "\""++zonedtimeTests :: TestTree+zonedtimeTests = testGroup "Z" $+ [ testCase "base case" $ assertBool "base case" $ isJust simple+ ] ++ map t timeStrings+ where simple = decode "\"2015-09-07T08:16:40.807Z\"" :: Maybe Z+ t str = testCase str+ . assertEqual str (fmap z simple)+ . fmap z+ . decode+ . fromString+ $ "\"" ++ str ++ "\""+ z (Z z') = zonedTimeToUTC z'++timeStrings :: [String]+timeStrings =+ [ "2015-09-07T08:16:40.807Z"+ , "2015-09-07T11:16:40.807+0300"+ , "2015-09-07 08:16:40.807Z"+ , "2015-09-07 08:16:40.807 Z"+ , "2015-09-07 08:16:40.807 +0000"+ , "2015-09-07 08:16:40.807 +00:00"+ , "2015-09-07 11:16:40.807 +03:00"+ , "2015-09-07 05:16:40.807 -03:00"+ ]