aeson-extra-0.2.2.0/src/0000755000000000000000000000000012604535453013063 5ustar0000000000000000aeson-extra-0.2.2.0/src/Data/0000755000000000000000000000000012602470104013721 5ustar0000000000000000aeson-extra-0.2.2.0/src/Data/Aeson/0000755000000000000000000000000012620367446015004 5ustar0000000000000000aeson-extra-0.2.2.0/src/Data/Aeson/Extra/0000755000000000000000000000000012620367446016067 5ustar0000000000000000aeson-extra-0.2.2.0/test/0000755000000000000000000000000012620367446013256 5ustar0000000000000000aeson-extra-0.2.2.0/src/Data/Aeson/Compat.hs0000644000000000000000000001514312620367446016567 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Aeson.Compat -- Copyright : (C) 2015 Oleg Grenrus -- License : BSD3 -- Maintainer : Oleg Grenrus -- -- Compatibility notices -- -- * '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@ module Data.Aeson.Compat ( -- * Generic decoding functions decode, decode', decodeStrict, decodeStrict', AesonException(..), -- * Either decoding functions eitherDecode, eitherDecode', eitherDecodeStrict, eitherDecodeStrict', -- * Operators (.:?), (.:!), -- * Re-exports -- | Original 'Data.Aeson..:?' operator is not re-exported module Data.Aeson, ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif #if MIN_VERSION_aeson(0,10,0) import Data.Monoid #endif import Data.Aeson hiding ((.:?), decode, decode', decodeStrict, decodeStrict' #if !MIN_VERSION_aeson (0,9,0) , eitherDecode, eitherDecode', eitherDecodeStrict, eitherDecodeStrict' #endif ) #if !MIN_VERSION_aeson (0,9,0) import Data.Aeson.Parser (value, value') import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.ByteString.Char8 as A (skipSpace) import qualified Data.Attoparsec.Lazy as L #endif import Control.Monad.Catch import Data.Aeson.Types hiding ((.:?)) import Data.ByteString as B 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 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) instance Exception AesonException eitherAesonExc :: (MonadThrow m) => Either String a -> m a eitherAesonExc (Left err) = throwM (AesonException err) 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 -- | Like original 'Data.Aeson.decode'' but in arbitrary 'MonadThrow'. decode' :: (FromJSON a, MonadThrow m) => L.ByteString -> m a decode' = eitherAesonExc . eitherDecode' -- | Like original 'Data.Aeson.decodeStrict' but in arbitrary 'MonadThrow'. decodeStrict :: (FromJSON a, MonadThrow m) => B.ByteString -> m a decodeStrict = eitherAesonExc . eitherDecodeStrict -- | Like original 'Data.Aeson.decodeStrict'' but in arbitrary 'MonadThrow'. decodeStrict' :: (FromJSON a, MonadThrow m) => B.ByteString -> m a decodeStrict' = eitherAesonExc . eitherDecodeStrict' -- | Retrieve the value associated with the given key of an 'Object'. -- The result is 'Nothing' if the key is not present, or 'empty' if -- the value cannot be converted to the desired type. -- -- This accessor is most useful if the key and value can be absent -- from an object without affecting its validity. If the key and -- value are mandatory, use '.:' instead. -- -- This operator is consistent in 'aeson >=0.8 && <0.11' (.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a) obj .:? key = case H.lookup key obj of Nothing -> pure Nothing Just v -> #if MIN_VERSION_aeson(0,10,0) modifyFailure addKeyName $ parseJSON v -- Key key where addKeyName = (("failed to parse field " <> T.unpack key <> ": ") <>) #else parseJSON v #endif {-# INLINE (.:?) #-} -- | Like '.:?', but the resulting parser will fail, -- if the key is present but is 'Null'. (.:!) :: (FromJSON a) => Object -> Text -> Parser (Maybe a) obj .:! key = case H.lookup key obj of Nothing -> pure Nothing Just v -> #if MIN_VERSION_aeson(0,10,0) modifyFailure addKeyName $ Just <$> parseJSON v -- Key key where addKeyName = (("failed to parse field " <> T.unpack key <> ": ") <>) #else Just <$> parseJSON v #endif {-# INLINE (.:!) #-} #if !MIN_VERSION_aeson(0,9,0) -- From Parser.Internal -- | Parse a top-level JSON value followed by optional whitespace and -- end-of-input. See also: 'json'. jsonEOF :: A.Parser Value jsonEOF = value <* A.skipSpace <* A.endOfInput -- | Parse a top-level JSON value followed by optional whitespace and -- end-of-input. See also: 'json''. jsonEOF' :: A.Parser Value jsonEOF' = value' <* A.skipSpace <* A.endOfInput -- | Like 'decode' but returns an error message when decoding fails. eitherDecode :: (FromJSON a) => L.ByteString -> Either String a eitherDecode = eitherDecodeWith jsonEOF fromJSON {-# INLINE eitherDecode #-} -- | Like 'decodeStrict' but returns an error message when decoding fails. eitherDecodeStrict :: (FromJSON a) => B.ByteString -> Either String a eitherDecodeStrict = eitherDecodeStrictWith jsonEOF fromJSON {-# INLINE eitherDecodeStrict #-} -- | Like 'decode'' but returns an error message when decoding fails. eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a eitherDecode' = eitherDecodeWith jsonEOF' fromJSON {-# INLINE eitherDecode' #-} -- | Like 'decodeStrict'' but returns an error message when decoding fails. eitherDecodeStrict' :: (FromJSON a) => B.ByteString -> Either String a eitherDecodeStrict' = eitherDecodeStrictWith jsonEOF' fromJSON {-# INLINE eitherDecodeStrict' #-} eitherDecodeWith :: L.Parser Value -> (Value -> Result a) -> L.ByteString -> Either String a eitherDecodeWith p to s = case L.parse p s of L.Done _ v -> case to v of Success a -> Right a Error msg -> Left msg L.Fail _ _ msg -> Left msg {-# INLINE eitherDecodeWith #-} eitherDecodeStrictWith :: A.Parser Value -> (Value -> Result a) -> B.ByteString -> Either String a eitherDecodeStrictWith p to s = case either Error to (A.parseOnly p s) of Success a -> Right a 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 aeson-extra-0.2.2.0/src/Data/Aeson/Extra.hs0000644000000000000000000002314312620367446016426 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Aeson.Extra -- Copyright : (C) 2015 Oleg Grenrus -- License : BSD3 -- Maintainer : Oleg Grenrus -- -- More or less useful newtypes for writing 'FromJSON' & 'ToJSON' instances module Data.Aeson.Extra ( -- * Generic maps M(..), FromJSONKey(..), parseIntegralJSONKey, FromJSONMap(..), ToJSONKey(..), ToJSONMap(..), #if MIN_VERSION_base(4,7,0) -- * Symbol tag SymTag(..), -- * Singleton object SingObject(..), mkSingObject, getSingObject, #endif -- * CollapsedList CollapsedList(..), getCollapsedList, parseCollapsedList, -- * UTCTime U(..), Z(..), -- * Re-exports module Data.Aeson.Compat, ) where #if !MIN_VERSION_base(4,8,0) import Data.Foldable (Foldable) import Data.Traversable (Traversable, traverse) #endif import Control.Applicative import Data.Monoid import Data.Aeson.Compat import Data.Aeson.Types hiding ((.:?)) import qualified Data.Foldable as Foldable import qualified Data.HashMap.Strict as H import Data.Hashable (Hashable) 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) import Data.Proxy 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)) -- > Just (M {getMap = fromList [(1,1),(2,2)]}) newtype M a = M { getMap :: a } deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable) class FromJSONKey a where parseJSONKey :: Text -> Parser a instance FromJSONKey Text where parseJSONKey = pure instance FromJSONKey TL.Text where parseJSONKey = pure . TL.fromStrict instance FromJSONKey String where parseJSONKey = pure . T.unpack instance FromJSONKey Int where parseJSONKey = parseIntegralJSONKey instance FromJSONKey Integer where parseJSONKey = parseIntegralJSONKey parseIntegralJSONKey :: Integral a => Text -> Parser a parseIntegralJSONKey t = case (T.signed T.decimal) t of Right (v, left) | T.null left -> pure v | otherwise -> fail $ "Garbage left: " <> T.unpack left Left err -> fail err class FromJSONMap m k v | m -> k v where parseJSONMap :: H.HashMap Text Value -> Parser m instance (Eq k, Hashable k, FromJSONKey k, FromJSON v) => FromJSONMap (H.HashMap k v) k v where parseJSONMap = fmap H.fromList . traverse f . H.toList where f (k, v) = (,) <$> parseJSONKey k <*> parseJSON v instance (Ord k, FromJSONKey k, FromJSON v) => FromJSONMap (Map.Map k v) k v where parseJSONMap = fmap Map.fromList . traverse f . H.toList where f (k, v) = (,) <$> parseJSONKey k <*> parseJSON v instance (FromJSONMap m k v) => FromJSON (M m) where parseJSON v = M <$> withObject "Map" parseJSONMap v class ToJSONKey a where toJSONKey :: a -> Text instance ToJSONKey Text where toJSONKey = id instance ToJSONKey TL.Text where toJSONKey = TL.toStrict instance ToJSONKey String where toJSONKey = T.pack instance ToJSONKey Int where toJSONKey = T.pack . show instance ToJSONKey Integer where toJSONKey = T.pack . show class ToJSONMap m k v | m -> k v where toJSONMap :: m -> H.HashMap Text Value instance (ToJSONKey k, ToJSON v) => ToJSONMap (H.HashMap k v) k v where toJSONMap = H.fromList . fmap f . H.toList where f (k, v) = (toJSONKey k, toJSON v) instance (ToJSONKey k, ToJSON v) => ToJSONMap (Map.Map k v) k v where toJSONMap = H.fromList . fmap f . Map.toList where f (k, v) = (toJSONKey k, toJSON v) instance (ToJSONMap m k v) => ToJSON (M m) where toJSON (M m) = Object (toJSONMap m) #if MIN_VERSION_base(4,7,0) -- | Singleton string encoded and decoded as ifself. -- -- > λ> encode (SymTag :: SymTag "foobar") -- > "\"foobar\"" -- -- > decode "\"foobar\"" :: Maybe (SymTag "foobar") -- > Just SymTag -- -- > decode "\"foobar\"" :: Maybe (SymTag "barfoo") -- > Nothing -- -- /Available with: base >=4.7/ data SymTag (s :: Symbol) = SymTag deriving (Eq, Ord, Show, Read, Enum, Bounded) instance KnownSymbol s => FromJSON (SymTag s) where parseJSON (String t) | T.unpack t == symbolVal (Proxy :: Proxy s) = pure SymTag parseJSON v = typeMismatch ("SymTag " ++ show (symbolVal (Proxy :: Proxy s))) v instance KnownSymbol s => ToJSON (SymTag s) where #if MIN_VERSION_aeson (0,10,0) toEncoding _ = toEncoding (symbolVal (Proxy :: Proxy s)) #endif toJSON _ = toJSON (symbolVal (Proxy :: Proxy s)) -- | Singleton value object -- -- > λ > decode "{\"value\": 42 }" :: Maybe (SingObject "value" Int) -- > Just (SingObject 42) -- -- > λ > encode (SingObject 42 :: SingObject "value" Int) -- > "{\"value\":42}" -- -- /Available with: base >=4.7/ newtype SingObject (s ::Symbol) a = SingObject a deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable) mkSingObject :: Proxy s -> a -> SingObject s a mkSingObject _ = SingObject getSingObject :: Proxy s -> SingObject s a -> a getSingObject _ (SingObject x) = x instance (KnownSymbol s, FromJSON a) => FromJSON (SingObject s a) where parseJSON = withObject ("SingObject "<> show key) $ \obj -> SingObject <$> obj .: T.pack key where key = symbolVal (Proxy :: Proxy s) instance (KnownSymbol s, ToJSON a) => ToJSON (SingObject s a) where #if MIN_VERSION_aeson(0,10,0) toEncoding (SingObject x) = pairs (T.pack key .= x) where key = symbolVal (Proxy :: Proxy s) #endif toJSON (SingObject x) = object [T.pack key .= x] where key = symbolVal (Proxy :: Proxy s) #endif -- | Collapsed list, singleton is represented as the value itself in JSON encoding. -- -- > λ > decode "null" :: Maybe (CollapsedList [Int] Int) -- > Just (CollapsedList []) -- > λ > decode "42" :: Maybe (CollapsedList [Int] Int) -- > Just (CollapsedList [42]) -- > λ > decode "[1, 2, 3]" :: Maybe (CollapsedList [Int] Int) -- > Just (CollapsedList [1,2,3]) -- -- > λ > encode (CollapsedList ([] :: [Int])) -- > "null" -- > λ > encode (CollapsedList ([42] :: [Int])) -- > "42" -- > λ > encode (CollapsedList ([1, 2, 3] :: [Int])) -- > "[1,2,3]" -- -- Documentation rely on @f@ 'Alternative' instance behaving like lists'. newtype CollapsedList f a = CollapsedList (f a) deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable) getCollapsedList :: CollapsedList f a -> f a getCollapsedList (CollapsedList l) = l instance (FromJSON a, FromJSON (f a), Alternative f) => FromJSON (CollapsedList f a) where parseJSON Null = pure (CollapsedList Control.Applicative.empty) parseJSON v@(Array _) = CollapsedList <$> parseJSON v parseJSON v = CollapsedList . pure <$> parseJSON v instance (ToJSON a, ToJSON (f a), Foldable f) => ToJSON (CollapsedList f a) where #if MIN_VERSION_aeson (0,10,0) toEncoding (CollapsedList l) = case Foldable.toList l of [] -> toEncoding Null [x] -> toEncoding x _ -> toEncoding l #endif toJSON (CollapsedList l) = case Foldable.toList l of [] -> toJSON Null [x] -> toJSON x _ -> toJSON l -- | Parses possibly collapsed array value from the object's field. -- -- > λ > newtype V = V [Int] deriving (Show) -- > λ > instance FromJSON V where parseJSON = withObject "V" $ \obj -> V <$> parseCollapsedList obj "value" -- > λ > decode "{}" :: Maybe V -- > Just (V []) -- > λ > decode "{\"value\": null}" :: Maybe V -- > Just (V []) -- > λ > decode "{\"value\": 42}" :: Maybe V -- > Just (V [42]) -- > λ > decode "{\"value\": [1, 2, 3, 4]}" :: Maybe V -- > Just (V [1,2,3,4]) parseCollapsedList :: (FromJSON a, FromJSON (f a), Alternative f) => Object -> Text -> Parser (f a) parseCollapsedList obj key = case H.lookup key obj of Nothing -> pure Control.Applicative.empty #if MIN_VERSION_aeson(0,10,0) Just v -> modifyFailure addKeyName $ (getCollapsedList <$> parseJSON v) -- Key key where 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 -- -- /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 aeson-extra-0.2.2.0/src/Data/Aeson/Extra/Time.hs0000644000000000000000000001134612620367446017326 0ustar0000000000000000{-# 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 -- 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 "" aeson-extra-0.2.2.0/test/Tests.hs0000644000000000000000000001556112620367446014724 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} module Main (main) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif 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 import Test.Tasty.HUnit import Test.Tasty.QuickCheck #if MIN_VERSION_base(4,7,0) import Data.Proxy #endif import Orphans () main :: IO () main = defaultMain $ testGroup "Tests" [ dotColonMark , mTests #if MIN_VERSION_base(4,7,0) , symTests , singObjectTests #endif , collapsedListTests , utctimeTests , zonedtimeTests ] ------------------------------------------------------------------------------ -- M ------------------------------------------------------------------------------ mTests :: TestTree mTests = testGroup "M" [ testCase "decode" $ let lhs = decode "{\"1\": 1, \"2\": 2}" :: Maybe (M (H.HashMap Int Int)) rhs = Just result in lhs @?= rhs , testProperty "decode . encode" $ let prop :: Map Int Int -> Property prop m = let lhs = fmap getMap . decode . encode . M $ m rhs = Just m in lhs === rhs in prop ] where result = M $ H.fromList [(1,1),(2,2)] #if MIN_VERSION_base(4,7,0) ------------------------------------------------------------------------------ -- SymTag ------------------------------------------------------------------------------ symTests :: TestTree symTests = testGroup "SymTag" [ testCase "encode" $ encode (SymTag :: SymTag "foobar") @?= "\"foobar\"" , testCase "decode success" $ (decode "\"foobar\"" :: Maybe (SymTag "foobar")) @?= Just SymTag , testCase "decode failure" $ (decode "\"foobar\"" :: Maybe (SymTag "barfoo")) @?= Nothing ] ------------------------------------------------------------------------------ -- SingObject ------------------------------------------------------------------------------ -- > λ > decode "{\"value\": 42 }" :: Maybe (SingObject "value" Int) -- > Just (SingObject 42) singObjectTests :: TestTree singObjectTests = testGroup "SingObject" [ testCase "decode success" $ (decode "{\"value\": 42 }" :: Maybe (SingObject "value" Int)) @?= Just (SingObject 42) , testCase "decode failure" $ (decode "{\"value\": 42 }" :: Maybe (SingObject "key" Int)) @?= Nothing , testProperty "decode . encode" $ let prop :: Int -> Property prop n = let rhs = fmap (getSingObject p) . decode . encode . mkSingObject p $ n lhs = Just n in lhs === rhs p :: Proxy "value" p = Proxy in prop ] #endif ------------------------------------------------------------------------------ -- parseCollapsedList ------------------------------------------------------------------------------ newtype V = V [Int] deriving (Show, Eq) instance FromJSON V where parseJSON = withObject "V" $ \obj -> V <$> parseCollapsedList obj "value" collapsedListTests :: TestTree collapsedListTests = testGroup "collapsedList" [ testCase "empty" $ (decode "{}" :: Maybe V) @?= Just (V []) , testCase "null" $ (decode "{\"value\": null}" :: Maybe V) @?= Just (V []) , testCase "singleton" $ (decode "{\"value\": 42}" :: Maybe V) @?= Just (V [42]) , testCase "array" $ (decode "{\"value\": [1, 2, 3, 4]}" :: Maybe V) @?= Just (V [1,2,3,4]) , testProperty "decode . encode" $ let prop :: [Int] -> Property prop l = let rhs = fmap getCollapsedList . decode . encode . CollapsedList $ l lhs = Just l in lhs === rhs in prop , testProperty "Vector decode . encode" $ let prop :: Vector Int -> Property prop l = let rhs = fmap getCollapsedList . decode . encode . CollapsedList $ l lhs = Just l in lhs === rhs in prop ] ------------------------------------------------------------------------------ -- Comparison (.:?) and (.:!) ------------------------------------------------------------------------------ newtype T1 = T1 (Maybe Int) deriving (Eq, Show) newtype T2 = T2 (Maybe Int) deriving (Eq, Show) newtype T3 = T3 (Maybe Int) deriving (Eq, Show) instance FromJSON T1 where parseJSON = fmap T1 . withObject "T1" (.: "value") instance FromJSON T2 where parseJSON = fmap T2 . withObject "T2" (.:? "value") instance FromJSON T3 where parseJSON = fmap T3 . withObject "T3" (.:! "value") dotColonMark :: TestTree dotColonMark = testGroup "Operators" $ fmap t [ assertEqual ".: not-present" Nothing (decode ex1 :: Maybe T1) , assertEqual ".: 42" (Just (T1 (Just 42))) (decode ex2 :: Maybe T1) , assertEqual ".: null" (Just (T1 Nothing)) (decode ex3 :: Maybe T1) , assertEqual ".:? not-present" (Just (T2 (Nothing))) (decode ex1 :: Maybe T2) , assertEqual ".:? 42" (Just (T2 (Just 42))) (decode ex2 :: Maybe T2) , assertEqual ".:? null" (Just (T2 Nothing)) (decode ex3 :: Maybe T2) , assertEqual ".:! not-present" (Just (T3 (Nothing))) (decode ex1 :: Maybe T3) , assertEqual ".:! 42" (Just (T3 (Just 42))) (decode ex2 :: Maybe T3) , assertEqual ".:! null" Nothing (decode ex3 :: Maybe T3) ] where ex1 = "{}" 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" ] aeson-extra-0.2.2.0/test/Orphans.hs0000644000000000000000000000053612602546635015227 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Orphans where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import Data.Vector as V import Test.Tasty.QuickCheck instance Arbitrary a => Arbitrary (Vector a) where arbitrary = V.fromList <$> arbitrary shrink = fmap V.fromList . shrink . V.toList aeson-extra-0.2.2.0/LICENSE0000644000000000000000000000276212602421457013304 0ustar0000000000000000Copyright (c) 2015, Oleg Grenrus All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Oleg Grenrus nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. aeson-extra-0.2.2.0/Setup.hs0000644000000000000000000000005612602421457013725 0ustar0000000000000000import Distribution.Simple main = defaultMain aeson-extra-0.2.2.0/aeson-extra.cabal0000644000000000000000000000514212620367513015506 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.8.0. -- -- see: https://github.com/sol/hpack name: aeson-extra version: 0.2.2.0 synopsis: Extra goodies for aeson description: The package motivation is twofold: . * provide compatibility layer for @aeson@ . * provide extra combinators category: Web homepage: https://github.com/phadej/aeson-extra#readme bug-reports: https://github.com/phadej/aeson-extra/issues author: Oleg Grenrus maintainer: Oleg Grenrus license: BSD3 license-file: LICENSE tested-with: GHC==7.6.3, GHC==7.8.4, GHC==7.10.2 build-type: Simple cabal-version: >= 1.10 extra-source-files: CHANGELOG.md README.md source-repository head type: git location: https://github.com/phadej/aeson-extra library hs-source-dirs: src ghc-options: -Wall build-depends: base >=4.6 && <4.9 , 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 , 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 type: exitcode-stdio-1.0 main-is: Tests.hs hs-source-dirs: test ghc-options: -Wall build-depends: base >=4.6 && <4.9 , 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 , text >=1.2 && <1.3 , time >=1.4.2 && <1.6 , unordered-containers >=0.2 && <0.3 , vector >=0.10 && <0.12 , aeson-extra , tasty >=0.10 && <0.12 , tasty-hunit >=0.9 && <0.10 , tasty-quickcheck >=0.8 && <0.9 , quickcheck-instances >=0.3 && <0.4 other-modules: Orphans default-language: Haskell2010 aeson-extra-0.2.2.0/CHANGELOG.md0000644000000000000000000000052012620367446014105 0ustar0000000000000000# 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 `SymTag` or `SingObject` support # 0.2.0.0 (2015-09-29) No ListLike - Make `CollapsedList` use typeclasses in `base` # 0.1.0.0 (2015-09-29) Initial release aeson-extra-0.2.2.0/README.md0000644000000000000000000000061512602465675013563 0ustar0000000000000000# aeson-extra [![Build Status](https://travis-ci.org/phadej/aeson-extra.svg?branch=master)](https://travis-ci.org/phadej/aeson-extra) [![Hackage](https://img.shields.io/hackage/v/aeson-extra.svg)](http://hackage.haskell.org/package/aeson-extra) The package motivation is twofold: - provide compatibility layer for [`aeson`](http://hackage.haskell.org/package/aeson) - provide extra combinators